[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.6 and 1.10

version 1.6, 2002/04/08 10:53:17 version 1.10, 2002/12/03 22:36:32
Line 1 Line 1
 #!/usr/bin/perl  #!/usr/bin/perl
   
 # -------------------------------------------------------- Documentation notice  # -------------------------------------------------------- Documentation notice
 # Run "perldoc ./lpml_parse.pl" in order to best view the software  # Run "perldoc ./piml_parse.pl" in order to best view the software
 # documentation internalized in this program.  # documentation internalized in this program.
   
 # --------------------------------------------------------- License Information  # --------------------------------------------------------- License Information
Line 61 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==3) {  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 113  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 = <>;
Line 140  $parser = HTML::TokeParser->new(\$parses Line 146  $parser = HTML::TokeParser->new(\$parses
 $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 283  undef($hloc); Line 294  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');
Line 292  while ($token = $parser->get_tag('piml') Line 304  while ($token = $parser->get_tag('piml')
     print($text);      print($text);
     print("\n");      print("\n");
     print(&end());      print(&end());
 }    }
 exit(0);  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_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'));
Line 327  sub format_targetroot { Line 340  sub format_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)=@_;
Line 346  END Line 360  END
  return($text);   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 374  sub format_category { Line 391  sub format_category {
     }      }
     return('');      return('');
 }  }
   
 # --------------------------------------------------- Format categories section  # --------------------------------------------------- Format categories section
 sub format_abbreviation {  sub format_abbreviation {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 385  sub format_abbreviation { Line 403  sub format_abbreviation {
     }      }
     return('');      return('');
 }  }
   
 # -------------------------------------------------------- Format chown section  # -------------------------------------------------------- Format chown section
 sub format_chown {  sub format_chown {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 396  sub format_chown { Line 415  sub format_chown {
     }      }
     return('');      return('');
 }  }
   
 # -------------------------------------------------------- Format chmod section  # -------------------------------------------------------- Format chmod section
 sub format_chmod {  sub format_chmod {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 407  sub format_chmod { Line 427  sub format_chmod {
     }      }
     return('');      return('');
 }  }
   
 # ------------------------------------------------- Format categoryname section  # ------------------------------------------------- Format categoryname section
 sub format_categoryname {  sub format_categoryname {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 418  sub format_categoryname { Line 439  sub format_categoryname {
     }      }
     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');
Line 425  sub format_files { Line 447  sub format_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 437  sub format_file { Line 460  sub format_file {
     return("# File: $target\n".      return("# File: $target\n".
  "$text\n");   "$text\n");
 }  }
   
 # ------------------------------------------------------- Format target section  # ------------------------------------------------------- Format target section
 sub format_target {  sub format_target {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 448  sub format_target { Line 472  sub format_target {
     }      }
     return('');      return('');
 }  }
   
 # --------------------------------------------------------- Format note section  # --------------------------------------------------------- Format note section
 sub format_note {  sub format_note {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 473  sub format_note { Line 498  sub format_note {
     }      }
     return('');      return('');
 }  }
   
 # ------------------------------------------------- Format dependencies section  # ------------------------------------------------- Format dependencies section
 sub format_dependencies {  sub format_dependencies {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 485  sub format_dependencies { Line 511  sub format_dependencies {
     }      }
     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];
Line 502  sub htmlsafe { Line 531  sub htmlsafe {
     $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);
Line 529  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 542  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 573  Packaging/Administrative Line 603  Packaging/Administrative
 =head1 AUTHOR  =head1 AUTHOR
   
  Scott Harrison   Scott Harrison
  codeharrison@yahoo.com   sharrison@users.sourceforge.net
   
 Please let me know how/if you are finding this script useful and  Please let me know how/if you are finding this script useful and
 any/all suggestions.  -Scott  any/all suggestions.  -Scott
Removed from v.1.6  
changed lines
  Added in v.1.10

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