[BACK]Return to piml_parse.pl CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / build

Diff for /loncom/build/piml_parse.pl between versions 1.2 and 1.10

version 1.2, 2002/01/31 17:32:25 version 1.10, 2002/12/03 22:36:32
Line 1 Line 1
 #!/usr/bin/perl  #!/usr/bin/perl
   
   # -------------------------------------------------------- Documentation notice
   # Run "perldoc ./piml_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 - Scott Harrison  # 1/28,1/29,1/30,1/31,2/5,4/8 - Scott Harrison
 #  #
 ###  ###
   
Line 56 Line 61
 # This is meant to parse files meeting the piml document type.  # This is meant to parse files meeting the piml document type.
 # See piml.dtd.  PIML=Post Installation Markup Language.  # See piml.dtd.  PIML=Post Installation Markup Language.
   
   # To reduce system dependencies, I'm using a lightweight
   # parser.  At some point, I need to get serious with a
   # better xml parsing engine and stylesheet usage.
 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 argument is the category permissions to use (runtime or development)
 2nd argument is the distribution (default,redhat6.2,debian2.2,redhat7.1,etc).  2nd argument is the distribution (default,redhat6,debian2.2,redhat7,etc).
 3rd argument is to manually specify a targetroot  3rd argument is to manually specify a targetroot
   
 Only the 1st argument is mandatory for the program to run.  Only the 1st argument is mandatory for the program to run.
   
 Example:  Example:
   
 cat ../../doc/loncapafiles.piml |\\  cat ../../doc/sanitycheck.piml |\\
 perl piml_parse.pl html development default /home/sherbert/loncapa /tmp/install  perl piml_parse.pl development default /home/sherbert/loncapa
 END  END
   
 # ------------------------------------------------- Grab command line arguments  # ------------------------------------------------- Grab command line arguments
   
 my $mode;  # If number of arguments is incorrect, then give up and print usage message.
 if (@ARGV==4) {  unless (@ARGV == 3)
     $mode = shift @ARGV;    {
 }      @ARGV=();shift(@ARGV);
 else {  
     @ARGV=();shift @ARGV;  
     while(<>){} # throw away the input to avoid broken pipes      while(<>){} # throw away the input to avoid broken pipes
     print $usage;      print($usage); # print usage message
     exit -1; # exit with error status      exit -1; # exit with error status
 }    }
   
 my $categorytype;  my $categorytype;
 if (@ARGV) {  if (@ARGV)
     $categorytype = shift @ARGV;    {
 }      $categorytype = shift(@ARGV);
     }
   
 my $dist;  my $dist;
 if (@ARGV) {  if (@ARGV)
     $dist = shift @ARGV;    {
 }      $dist = shift(@ARGV);
     }
   
 my $targetroot;  my $targetroot;
 my $targetrootarg;  my $targetrootarg;
 if (@ARGV) {  if (@ARGV)
     $targetroot = shift @ARGV;    {
 }      $targetroot = shift(@ARGV);
     }
   
 $targetroot=~s/\/$//;  $targetroot=~s/\/$//;
 $targetrootarg=$targetroot;  $targetrootarg=$targetroot;
   
Line 108  my $logcmd='| tee -a WARNINGS'; Line 118  my $logcmd='| tee -a WARNINGS';
   
 my $invocation;  my $invocation;
 # --------------------------------------------------- Record program invocation  # --------------------------------------------------- Record program invocation
 if ($mode eq 'install' or $mode eq 'configinstall' or $mode eq 'build') {  if ($mode eq 'install' or $mode eq 'configinstall' or $mode eq 'build')
     {
     $invocation=(<<END);      $invocation=(<<END);
 # Invocation: STDINPUT | piml_parse.pl  # Invocation: STDINPUT | piml_parse.pl
 #             1st argument (category type) is: $categorytype  #             1st argument (category type) is: $categorytype
 #             2nd argument (distribution) is: $dist  #             2nd argument (distribution) is: $dist
 #             3rd argument (targetroot) is: described below  #             3rd argument (targetroot) is: described below
 END  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 140  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');
 my %hash;  my %hash;
 my $key;  my $key;
 while ($token = $parser->get_token()) {  while ($token = $parser->get_token())
     if ($token->[0] eq 'S') {    {
       if ($token->[0] eq 'S')
         {
  $hloc++;   $hloc++;
  $hierarchy[$hloc]++;   $hierarchy[$hloc]++;
  $key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);   $key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);
  my $thisdist=' '.$token->[2]{'dist'}.' ';   my $thisdist=' '.$token->[2]{'dist'}.' ';
  if ($thisdist eq ' default ') {   if ($thisdist eq ' default ')
             {
     $hash{$key}=1; # there is a default setting for this key      $hash{$key}=1; # there is a default setting for this key
  }    }
  elsif ($dist && $hash{$key}==1 && $thisdist=~/\s$dist\s/) {   elsif ($dist && $hash{$key}==1 && $thisdist=~/\s$dist\s/)
             {
     $hash{$key}=2; # disregard default setting for this key if      $hash{$key}=2; # disregard default setting for this key if
                    # there is a directly requested distribution match                     # there is a directly requested distribution match
  }    }
     }        }
     if ($token->[0] eq 'E') {      if ($token->[0] eq 'E')
         {
  $hloc--;   $hloc--;
     }        }
 }    }
   
 # --------------------------------------------------- Start second pass through  # --------------------------------------------------- Start second pass through
 undef $hloc;  undef $hloc;
Line 190  while ($token = $parser->get_token()) { Line 206  while ($token = $parser->get_token()) {
     $cleanstring.=$token->[4];      $cleanstring.=$token->[4];
  }   }
  if ($token->[4]=~/\/>$/) {   if ($token->[4]=~/\/>$/) {
     $hloc--;  #    $hloc--;
  }   }
     }      }
     if ($token->[0] eq 'E') {      if ($token->[0] eq 'E') {
Line 236  my $fileglob_count; Line 252  my $fileglob_count;
 my $fileglobnames_count;  my $fileglobnames_count;
 my %categorycount;  my %categorycount;
   
   my $mode;
   
 my @buildall;  my @buildall;
 my @buildinfo;  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 272  $parser->{textify}={ Line 290  $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 313  sub format_piml { Line 332  sub format_piml {
   
 END  END
 }  }
   
 # --------------------------------------------------- Format targetroot section  # --------------------------------------------------- Format targetroot section
 sub format_targetroot {  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'};
     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 {
     my (@tokeninfo)=@_;      my (@tokeninfo)=@_;
Line 353  sub format_category { Line 389  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 {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 364  sub format_abbreviation { Line 401  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 {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 375  sub format_chown { Line 413  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 {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 386  sub format_chmod { Line 425  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 {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 397  sub format_categoryname { Line 437  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 {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 415  sub format_file { Line 457  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 {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 428  sub format_target { Line 470  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 {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 453  sub format_note { Line 496  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 {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 466  sub format_dependencies { Line 509  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 files meeting the piml document type.
Line 510  Usage is for piml file to come in throug Line 559  Usage is for piml file to come in throug
 =item *  =item *
   
 2nd argument is the distribution  2nd argument is the distribution
 (default,redhat6.2,debian2.2,redhat7.1,etc).  (default,redhat6,debian2.2,redhat7,etc).
   
 =item *  =item *
   
Line 523  Only the 1st argument is mandatory for t Line 572  Only the 1st argument is mandatory for t
 Example:  Example:
   
 cat ../../doc/loncapafiles.piml |\\  cat ../../doc/loncapafiles.piml |\\
 perl piml_parse.pl html default /home/sherbert/loncapa /tmp/install  perl piml_parse.pl development default /home/sherbert/loncapa
   
 =head1 DESCRIPTION  =head1 DESCRIPTION
   
Line 551  linux Line 600  linux
   
 Packaging/Administrative  Packaging/Administrative
   
   =head1 AUTHOR
   
    Scott Harrison
    sharrison@users.sourceforge.net
   
   Please let me know how/if you are finding this script useful and
   any/all suggestions.  -Scott
   
 =cut  =cut
Removed from v.1.2  
changed lines
  Added in v.1.10

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