--- loncom/build/piml_parse.pl	2002/12/03 21:37:08	1.9
+++ loncom/build/piml_parse.pl	2002/12/03 22:36:32	1.10
@@ -1,14 +1,14 @@
 #!/usr/bin/perl
 
 # -------------------------------------------------------- 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.
 
 # --------------------------------------------------------- License Information
 # The LearningOnline Network with CAPA
 # piml_parse.pl - Linux Packaging Markup Language parser
 #
-# $Id: piml_parse.pl,v 1.9 2002/12/03 21:37:08 harris41 Exp $
+# $Id: piml_parse.pl,v 1.10 2002/12/03 22:36:32 harris41 Exp $
 #
 # Written by Scott Harrison, codeharrison@yahoo.com
 #
@@ -61,51 +61,56 @@
 # This is meant to parse files meeting the piml document type.
 # 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;
 
 my $usage=(<<END);
 **** ERROR ERROR ERROR ERROR ****
 Usage is for piml file to come in through standard input.
 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
 
 Only the 1st argument is mandatory for the program to run.
 
 Example:
 
-cat ../../doc/loncapafiles.piml |\\
-perl piml_parse.pl html development default /home/sherbert/loncapa /tmp/install
+cat ../../doc/sanitycheck.piml |\\
+perl piml_parse.pl development default /home/sherbert/loncapa
 END
 
 # ------------------------------------------------- Grab command line arguments
 
-my $mode;
-if (@ARGV==3) {
-    $mode = shift @ARGV;
-}
-else {
-    @ARGV=();shift @ARGV;
+# If number of arguments is incorrect, then give up and print usage message.
+unless (@ARGV == 3)
+  {
+    @ARGV=();shift(@ARGV);
     while(<>){} # throw away the input to avoid broken pipes
-    print $usage;
+    print($usage); # print usage message
     exit -1; # exit with error status
-}
+  }
 
 my $categorytype;
-if (@ARGV) {
-    $categorytype = shift @ARGV;
-}
+if (@ARGV)
+  {
+    $categorytype = shift(@ARGV);
+  }
 
 my $dist;
-if (@ARGV) {
-    $dist = shift @ARGV;
-}
+if (@ARGV)
+  {
+    $dist = shift(@ARGV);
+  }
 
 my $targetroot;
 my $targetrootarg;
-if (@ARGV) {
-    $targetroot = shift @ARGV;
-}
+if (@ARGV)
+  {
+    $targetroot = shift(@ARGV);
+  }
+
 $targetroot=~s/\/$//;
 $targetrootarg=$targetroot;
 
@@ -113,14 +118,15 @@ my $logcmd='| tee -a WARNINGS';
 
 my $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: STDINPUT | piml_parse.pl
 #             1st argument (category type) is: $categorytype
 #             2nd argument (distribution) is: $dist
 #             3rd argument (targetroot) is: described below
 END
-}
+  }
 
 # ---------------------------------------------------- Start first pass through
 my @parsecontents = <>;
@@ -140,24 +146,29 @@ $parser = HTML::TokeParser->new(\$parses
 $parser->xml_mode('1');
 my %hash;
 my $key;
-while ($token = $parser->get_token()) {
-    if ($token->[0] eq 'S') {
+while ($token = $parser->get_token())
+  {
+    if ($token->[0] eq 'S')
+      {
 	$hloc++;
 	$hierarchy[$hloc]++;
 	$key=$token->[1].join(',',@hierarchy[0..($hloc-1)]);
 	my $thisdist=' '.$token->[2]{'dist'}.' ';
-	if ($thisdist eq ' default ') {
+	if ($thisdist eq ' default ')
+          {
 	    $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
 	                   # there is a directly requested distribution match
-	}
-    }
-    if ($token->[0] eq 'E') {
+	  }
+      }
+    if ($token->[0] eq 'E')
+      {
 	$hloc--;
-    }
-}
+      }
+  }
 
 # --------------------------------------------------- Start second pass through
 undef $hloc;
@@ -283,7 +294,8 @@ undef($hloc);
 undef(@hierarchy);
 my $hloc;
 my @hierarchy2;
-while ($token = $parser->get_tag('piml')) {
+while ($token = $parser->get_tag('piml'))
+  {
     &format_piml(@{$token});
     $text = &trim($parser->get_text('/piml'));
     $token = $parser->get_tag('/piml');
@@ -292,7 +304,7 @@ while ($token = $parser->get_tag('piml')
     print($text);
     print("\n");
     print(&end());
-}
+  }
 exit(0);
 
 # ---------- Functions (most all just format contents of different markup tags)
@@ -320,6 +332,7 @@ sub format_piml {
 
 END
 }
+
 # --------------------------------------------------- Format targetroot section
 sub format_targetroot {
     my $text=&trim($parser->get_text('/targetroot'));
@@ -327,6 +340,7 @@ sub format_targetroot {
     $parser->get_tag('/targetroot');
     return('# TARGET INSTALL LOCATION is "'.$targetroot."\"\n");
 }
+
 # -------------------------------------------------- Format perl script section
 sub format_perlscript {
     my (@tokeninfo)=@_;
@@ -346,18 +360,21 @@ END
 	return($text);
     }
 }
+
 # --------------------------------------------------------------- Format TARGET
 sub format_TARGET {
     my (@tokeninfo)=@_;
     $parser->get_tag('/TARGET');
     return($target);
 }
+
 # --------------------------------------------------- Format categories section
 sub format_categories {
     my $text=&trim($parser->get_text('/categories'));
     $parser->get_tag('/categories');
     return('# CATEGORIES'."\n".$text);
 }
+
 # --------------------------------------------------- Format categories section
 sub format_category {
     my (@tokeninfo)=@_;
@@ -374,6 +391,7 @@ sub format_category {
     }
     return('');
 }
+
 # --------------------------------------------------- Format categories section
 sub format_abbreviation {
     my @tokeninfo=@_;
@@ -385,6 +403,7 @@ sub format_abbreviation {
     }
     return('');
 }
+
 # -------------------------------------------------------- Format chown section
 sub format_chown {
     my @tokeninfo=@_;
@@ -396,6 +415,7 @@ sub format_chown {
     }
     return('');
 }
+
 # -------------------------------------------------------- Format chmod section
 sub format_chmod {
     my @tokeninfo=@_;
@@ -407,6 +427,7 @@ sub format_chmod {
     }
     return('');
 }
+
 # ------------------------------------------------- Format categoryname section
 sub format_categoryname {
     my @tokeninfo=@_;
@@ -418,6 +439,7 @@ sub format_categoryname {
     }
     return('');
 }
+
 # -------------------------------------------------------- Format files section
 sub format_files {
     my $text=$parser->get_text('/files');
@@ -425,6 +447,7 @@ sub format_files {
     return("\n".'# There are '.$file_count.' files this script works on'.
 	"\n\n".$text);
 }
+
 # --------------------------------------------------------- Format file section
 sub format_file {
     my @tokeninfo=@_;
@@ -437,6 +460,7 @@ sub format_file {
     return("# File: $target\n".
 	"$text\n");
 }
+
 # ------------------------------------------------------- Format target section
 sub format_target {
     my @tokeninfo=@_;
@@ -448,6 +472,7 @@ sub format_target {
     }
     return('');
 }
+
 # --------------------------------------------------------- Format note section
 sub format_note {
     my @tokeninfo=@_;
@@ -473,6 +498,7 @@ sub format_note {
     }
     return('');
 }
+
 # ------------------------------------------------- Format dependencies section
 sub format_dependencies {
     my @tokeninfo=@_;
@@ -485,16 +511,19 @@ sub format_dependencies {
     }
     return('');
 }
+
 # ------------------------------------------------ Format specialnotice section
 sub format_specialnotices {
     $parser->get_tag('/specialnotices');
     return('');
 }
+
 # ------------------------------------------------ Format specialnotice section
 sub format_specialnotice {
     $parser->get_tag('/specialnotice');
     return('');
 }
+
 # ------------------------------------- Render less-than and greater-than signs
 sub htmlsafe {
     my $text=@_[0];
@@ -502,6 +531,7 @@ sub htmlsafe {
     $text =~ s/>/&gt;/g;
     return($text);
 }
+
 # --------------------------------------- remove starting and ending whitespace
 sub trim {
     my ($s)=@_; $s=~s/^\s*//; $s=~s/\s*$//; return($s);
@@ -513,7 +543,8 @@ sub trim {
 
 =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
 
@@ -528,7 +559,7 @@ Usage is for piml file to come in throug
 =item *
 
 2nd argument is the distribution
-(default,redhat6.2,debian2.2,redhat7.1,etc).
+(default,redhat6,debian2.2,redhat7,etc).
 
 =item *
 
@@ -541,7 +572,7 @@ Only the 1st argument is mandatory for t
 Example:
 
 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
 
@@ -572,7 +603,7 @@ Packaging/Administrative
 =head1 AUTHOR
 
  Scott Harrison
- codeharrison@yahoo.com
+ sharrison@users.sourceforge.net
 
 Please let me know how/if you are finding this script useful and
 any/all suggestions.  -Scott