[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.7 and 1.11

version 1.7, 2002/04/08 12:51:03 version 1.11, 2005/10/05 18:37:03
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 275  $parser->{textify}={ Line 286  $parser->{textify}={
     filenames => \&format_filenames,      filenames => \&format_filenames,
     perlscript => \&format_perlscript,      perlscript => \&format_perlscript,
     TARGET => \&format_TARGET,      TARGET => \&format_TARGET,
       DIST => \&format_DIST,
     };      };
   
 my $text;  my $text;
Line 283  undef($hloc); Line 295  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 305  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 333  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 341  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 361  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 DIST
   sub format_DIST {
       my (@tokeninfo)=@_;
       $parser->get_tag('/DIST');
       return($dist);
   }
   
 # --------------------------------------------------- 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 399  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 411  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 423  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 435  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 447  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 455  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 468  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 480  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 506  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 519  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 539  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 513  sub trim { Line 551  sub trim {
   
 =head1 NAME  =head1 NAME
   
 piml_parse.pl - This is meant to parse piml files (Post Installation Markup Language)  piml_parse.pl - This is meant to parse files meeting the piml document type.
   See piml.dtd.  PIML=Post Installation Markup Language.
   
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
Line 528  Usage is for piml file to come in throug Line 567  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 541  Only the 1st argument is mandatory for t Line 580  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 572  Packaging/Administrative Line 611  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.7  
changed lines
  Added in v.1.11

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