Diff for /loncom/build/piml_parse.pl between versions 1.4 and 1.8

version 1.4, 2002/02/05 01:29:22 version 1.8, 2002/11/26 15:25:21
Line 1 Line 1
 #!/usr/bin/perl  #!/usr/bin/perl
   
   # -------------------------------------------------------- Documentation notice
   # Run "perldoc ./lpml_parse.pl" in order to best view the software
   # documentation internalized in this program.
   
   # --------------------------------------------------------- License Information
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # piml_parse.pl - Linux Packaging Markup Language parser  # piml_parse.pl - Linux Packaging Markup Language parser
 #  #
 # $Id$  # $Id$
 #  #
 # Written by Scott Harrison, harris41@msu.edu  # Written by Scott Harrison, codeharrison@yahoo.com
 #  #
 # Copyright Michigan State University Board of Trustees  # Copyright Michigan State University Board of Trustees
 #  #
Line 30 Line 35
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # YEAR=2002  # YEAR=2002
 # 1/28,1/29,1/30,1/31 - Scott Harrison  # 1/28,1/29,1/30,1/31,2/5,4/8 - Scott Harrison
 #  #
 ###  ###
   
Line 58 Line 63
   
 use HTML::TokeParser;  use HTML::TokeParser;
   
 my $usage=<<END;  my $usage=(<<END);
 **** ERROR ERROR ERROR ERROR ****  **** ERROR ERROR ERROR ERROR ****
 Usage is for piml file to come in through standard input.  Usage is for piml file to come in through standard input.
 1st argument is the category permissions to use (runtime or development)  1st is install, configinstall, or build
 2nd argument is the distribution (default,redhat6.2,debian2.2,redhat7.1,etc).  2st argument is the category permissions to use (runtime or development)
 3rd argument is to manually specify a targetroot  3nd argument is the distribution (default,redhat6.2,debian2.2,redhat7.1,etc).
   4rd argument is to manually specify a targetroot
   
 Only the 1st argument is mandatory for the program to run.  The first 3 arguments are required for the program to run.
   
 Example:  Example:
   
Line 76  END Line 82  END
 # ------------------------------------------------- Grab command line arguments  # ------------------------------------------------- Grab command line arguments
   
 my $mode;  my $mode;
 if (@ARGV==3) {  if (@ARGV>=3) {
     $mode = shift @ARGV;      $mode = shift @ARGV;
 }  }
 else {  else {
Line 120  END Line 126  END
 # ---------------------------------------------------- Start first pass through  # ---------------------------------------------------- Start first pass through
 my @parsecontents = <>;  my @parsecontents = <>;
 my $parsestring = join('',@parsecontents);  my $parsestring = join('',@parsecontents);
 my $outstring;  my $outstring='';
   
 # Need to make a pass through and figure out what defaults are  # Need to make a pass through and figure out what defaults are
 # overrided.  Top-down overriding strategy (leaves don't know  # overrided.  Top-down overriding strategy (leaves don't know
Line 129  my $outstring; Line 135  my $outstring;
 my @hierarchy;  my @hierarchy;
 $hierarchy[0]=0;  $hierarchy[0]=0;
 my $hloc=0;  my $hloc=0;
 my $token;  my $token='';
 $parser = HTML::TokeParser->new(\$parsestring) or  $parser = HTML::TokeParser->new(\$parsestring) or
     die('can\'t create TokeParser object');      die('can\'t create TokeParser object');
 $parser->xml_mode('1');  $parser->xml_mode('1');
Line 244  my @buildinfo; Line 250  my @buildinfo;
 my @configall;  my @configall;
   
 # Make new parser with distribution specific input  # Make new parser with distribution specific input
 undef $parser;  undef($parser);
 $parser = HTML::TokeParser->new(\$cleanstring) or  $parser = HTML::TokeParser->new(\$cleanstring) or
     die('can\'t create TokeParser object');      die('can\'t create TokeParser object');
 $parser->xml_mode('1');  $parser->xml_mode('1');
Line 274  $parser->{textify}={ Line 280  $parser->{textify}={
   
 my $text;  my $text;
 my $token;  my $token;
 undef $hloc;  undef($hloc);
 undef @hierarchy;  undef(@hierarchy);
 my $hloc;  my $hloc;
 my @hierarchy2;  my @hierarchy2;
 while ($token = $parser->get_tag('piml')) {  while ($token = $parser->get_tag('piml')) {
     &format_piml(@{$token});      &format_piml(@{$token});
     $text = &trim($parser->get_text('/piml'));      $text = &trim($parser->get_text('/piml'));
     $token = $parser->get_tag('/piml');      $token = $parser->get_tag('/piml');
     print $piml;       print($piml); 
     print "\n";      print("\n");
     print $text;      print($text);
     print "\n";      print("\n");
     print &end();      print(&end());
 }  }
 exit;  exit(0);
   
 # ---------- Functions (most all just format contents of different markup tags)  # ---------- Functions (most all just format contents of different markup tags)
   
Line 320  sub format_targetroot { Line 326  sub format_targetroot {
     my $text=&trim($parser->get_text('/targetroot'));      my $text=&trim($parser->get_text('/targetroot'));
     $text=$targetroot if $targetroot;      $text=$targetroot if $targetroot;
     $parser->get_tag('/targetroot');      $parser->get_tag('/targetroot');
     return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n";      return('# TARGET INSTALL LOCATION is "'.$targetroot."\"\n");
 }  }
 # -------------------------------------------------- Format perl script section  # -------------------------------------------------- Format perl script section
 sub format_perlscript {  sub format_perlscript {
     my (@tokeninfo)=@_;      my (@tokeninfo)=@_;
     $mode=$tokeninfo->[2]{'mode'};      $mode=$tokeninfo[2]->{'mode'};
     my $text=$parser->get_text('/perlscript');      my $text=$parser->get_text('/perlscript');
     $parser->get_tag('/perlscript');      $parser->get_tag('/perlscript');
     return $text;      if ($mode eq 'bg') {
    open(OUT,">/tmp/piml$$.pl");
    print(OUT $text);
    close(OUT);
    return(<<END);
    # launch background process for $target
    system("perl /tmp/piml$$.pl &");
   END
       }
       else {
    return($text);
       }
 }  }
 # --------------------------------------------------------------- Format TARGET  # --------------------------------------------------------------- Format TARGET
 sub format_TARGET {  sub format_TARGET {
     my (@tokeninfo)=@_;      my (@tokeninfo)=@_;
     $parser->get_tag('/TARGET');      $parser->get_tag('/TARGET');
     return $target;      return($target);
 }  }
 # --------------------------------------------------- Format categories section  # --------------------------------------------------- Format categories section
 sub format_categories {  sub format_categories {
     my $text=&trim($parser->get_text('/categories'));      my $text=&trim($parser->get_text('/categories'));
     $parser->get_tag('/categories');      $parser->get_tag('/categories');
     return '# CATEGORIES'."\n".$text;      return('# CATEGORIES'."\n".$text);
 }  }
 # --------------------------------------------------- Format categories section  # --------------------------------------------------- Format categories section
 sub format_category {  sub format_category {
Line 356  sub format_category { Line 373  sub format_category {
  $categoryhash{$category_att_name}='-o '.$user.' -g '.$group.   $categoryhash{$category_att_name}='-o '.$user.' -g '.$group.
     ' -m '.$chmod;      ' -m '.$chmod;
     }      }
     return '';      return('');
 }  }
 # --------------------------------------------------- Format categories section  # --------------------------------------------------- Format categories section
 sub format_abbreviation {  sub format_abbreviation {
Line 367  sub format_abbreviation { Line 384  sub format_abbreviation {
  $parser->get_tag('/abbreviation');   $parser->get_tag('/abbreviation');
  $abbreviation=$text;   $abbreviation=$text;
     }      }
     return '';      return('');
 }  }
 # -------------------------------------------------------- Format chown section  # -------------------------------------------------------- Format chown section
 sub format_chown {  sub format_chown {
Line 378  sub format_chown { Line 395  sub format_chown {
  $parser->get_tag('/chown');   $parser->get_tag('/chown');
  $chown=$text;   $chown=$text;
     }      }
     return '';      return('');
 }  }
 # -------------------------------------------------------- Format chmod section  # -------------------------------------------------------- Format chmod section
 sub format_chmod {  sub format_chmod {
Line 389  sub format_chmod { Line 406  sub format_chmod {
  $parser->get_tag('/chmod');   $parser->get_tag('/chmod');
  $chmod=$text;   $chmod=$text;
     }      }
     return '';      return('');
 }  }
 # ------------------------------------------------- Format categoryname section  # ------------------------------------------------- Format categoryname section
 sub format_categoryname {  sub format_categoryname {
Line 400  sub format_categoryname { Line 417  sub format_categoryname {
  $parser->get_tag('/categoryname');   $parser->get_tag('/categoryname');
  $categoryname=$text;   $categoryname=$text;
     }      }
     return '';      return('');
 }  }
 # -------------------------------------------------------- Format files section  # -------------------------------------------------------- Format files section
 sub format_files {  sub format_files {
     my $text=$parser->get_text('/files');      my $text=$parser->get_text('/files');
     $parser->get_tag('/files');      $parser->get_tag('/files');
     return "\n".'# There are '.$file_count.' files this script works on'.      return("\n".'# There are '.$file_count.' files this script works on'.
  "\n\n".$text;   "\n\n".$text);
 }  }
 # --------------------------------------------------------- Format file section  # --------------------------------------------------------- Format file section
 sub format_file {  sub format_file {
Line 418  sub format_file { Line 435  sub format_file {
     $file_count++;      $file_count++;
     $categorycount{$categoryname}++;      $categorycount{$categoryname}++;
     $parser->get_tag('/file');      $parser->get_tag('/file');
     return "# File: $target\n".      return("# File: $target\n".
  "$text\n";   "$text\n");
     return '';  
 }  }
 # ------------------------------------------------------- Format target section  # ------------------------------------------------------- Format target section
 sub format_target {  sub format_target {
Line 431  sub format_target { Line 447  sub format_target {
  $parser->get_tag('/target');   $parser->get_tag('/target');
  $target=$targetrootarg.$text;   $target=$targetrootarg.$text;
     }      }
     return '';      return('');
 }  }
 # --------------------------------------------------------- Format note section  # --------------------------------------------------------- Format note section
 sub format_note {  sub format_note {
Line 456  sub format_note { Line 472  sub format_note {
     if ($text) {      if ($text) {
  $note=$text;   $note=$text;
     }      }
     return '';      return('');
   
 }  }
 # ------------------------------------------------- Format dependencies section  # ------------------------------------------------- Format dependencies section
 sub format_dependencies {  sub format_dependencies {
Line 469  sub format_dependencies { Line 484  sub format_dependencies {
  $dependencies=join(';',   $dependencies=join(';',
       (map {s/^\s*//;s/\s$//;$_} split(/\;/,$text)));        (map {s/^\s*//;s/\s$//;$_} split(/\;/,$text)));
     }      }
     return '';      return('');
 }  }
 # ------------------------------------------------ Format specialnotice section  # ------------------------------------------------ Format specialnotice section
 sub format_specialnotices {  sub format_specialnotices {
     $parser->get_tag('/specialnotices');      $parser->get_tag('/specialnotices');
     return '';      return('');
 }  }
 # ------------------------------------------------ Format specialnotice section  # ------------------------------------------------ Format specialnotice section
 sub format_specialnotice {  sub format_specialnotice {
     $parser->get_tag('/specialnotice');      $parser->get_tag('/specialnotice');
     return '';      return('');
 }  }
 # ------------------------------------- Render less-than and greater-than signs  # ------------------------------------- Render less-than and greater-than signs
 sub htmlsafe {  sub htmlsafe {
     my $text=@_[0];      my $text=@_[0];
     $text =~ s/</&lt;/g;      $text =~ s/</&lt;/g;
     $text =~ s/>/&gt;/g;      $text =~ s/>/&gt;/g;
     return $text;      return($text);
 }  }
 # --------------------------------------- remove starting and ending whitespace  # --------------------------------------- remove starting and ending whitespace
 sub trim {  sub trim {
     my ($s)=@_; $s=~s/^\s*//; $s=~s/\s*$//; return $s;      my ($s)=@_; $s=~s/^\s*//; $s=~s/\s*$//; return($s);
 }   }
   
 # ----------------------------------- POD (plain old documentation, CPAN style)  # ----------------------------------- POD (plain old documentation, CPAN style)
   
   =pod
   
 =head1 NAME  =head1 NAME
   
 piml_parse.pl - This is meant to parse files meeting the piml document type.  piml_parse.pl - This is meant to parse piml files (Post Installation Markup Language)
 See piml.dtd.  PIML=Post Installation Markup Language.  
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
Line 554  linux Line 570  linux
   
 Packaging/Administrative  Packaging/Administrative
   
   =head1 AUTHOR
   
    Scott Harrison
    codeharrison@yahoo.com
   
   Please let me know how/if you are finding this script useful and
   any/all suggestions.  -Scott
   
 =cut  =cut

Removed from v.1.4  
changed lines
  Added in v.1.8


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>