--- loncom/build/piml_parse.pl 2002/02/05 01:29:22 1.4 +++ loncom/build/piml_parse.pl 2005/10/05 18:37:03 1.11 @@ -1,11 +1,16 @@ #!/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 # piml_parse.pl - Linux Packaging Markup Language parser # -# $Id: piml_parse.pl,v 1.4 2002/02/05 01:29:22 harris41 Exp $ +# $Id: piml_parse.pl,v 1.11 2005/10/05 18:37:03 albertel Exp $ # -# Written by Scott Harrison, harris41@msu.edu +# Written by Scott Harrison, codeharrison@yahoo.com # # Copyright Michigan State University Board of Trustees # @@ -30,7 +35,7 @@ # http://www.lon-capa.org/ # # 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 # ### @@ -56,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=<){} # 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; @@ -108,19 +118,20 @@ 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=(<; my $parsestring = join('',@parsecontents); -my $outstring; +my $outstring=''; # Need to make a pass through and figure out what defaults are # overrided. Top-down overriding strategy (leaves don't know @@ -129,30 +140,35 @@ my $outstring; my @hierarchy; $hierarchy[0]=0; my $hloc=0; -my $token; +my $token=''; $parser = HTML::TokeParser->new(\$parsestring) or die('can\'t create TokeParser object'); $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; @@ -244,7 +260,7 @@ my @buildinfo; my @configall; # Make new parser with distribution specific input -undef $parser; +undef($parser); $parser = HTML::TokeParser->new(\$cleanstring) or die('can\'t create TokeParser object'); $parser->xml_mode('1'); @@ -270,25 +286,27 @@ $parser->{textify}={ filenames => \&format_filenames, perlscript => \&format_perlscript, TARGET => \&format_TARGET, + DIST => \&format_DIST, }; my $text; my $token; -undef $hloc; -undef @hierarchy; +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'); - print $piml; - print "\n"; - print $text; - print "\n"; - print &end(); -} -exit; + print($piml); + print("\n"); + print($text); + print("\n"); + print(&end()); + } +exit(0); # ---------- Functions (most all just format contents of different markup tags) @@ -315,33 +333,56 @@ sub format_piml { END } + # --------------------------------------------------- Format targetroot section sub format_targetroot { my $text=&trim($parser->get_text('/targetroot')); $text=$targetroot if $targetroot; $parser->get_tag('/targetroot'); - return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n"; + return('# TARGET INSTALL LOCATION is "'.$targetroot."\"\n"); } + # -------------------------------------------------- Format perl script section sub format_perlscript { my (@tokeninfo)=@_; - $mode=$tokeninfo->[2]{'mode'}; + $mode=$tokeninfo[2]->{'mode'}; my $text=$parser->get_text('/perlscript'); $parser->get_tag('/perlscript'); - return $text; + if ($mode eq 'bg') { + open(OUT,">/tmp/piml$$.pl"); + print(OUT $text); + close(OUT); + return(<get_tag('/TARGET'); - return $target; + return($target); } + +# ----------------------------------------------------------------- Format DIST +sub format_DIST { + my (@tokeninfo)=@_; + $parser->get_tag('/DIST'); + return($dist); +} + # --------------------------------------------------- Format categories section sub format_categories { my $text=&trim($parser->get_text('/categories')); $parser->get_tag('/categories'); - return '# CATEGORIES'."\n".$text; + return('# CATEGORIES'."\n".$text); } + # --------------------------------------------------- Format categories section sub format_category { my (@tokeninfo)=@_; @@ -356,8 +397,9 @@ sub format_category { $categoryhash{$category_att_name}='-o '.$user.' -g '.$group. ' -m '.$chmod; } - return ''; + return(''); } + # --------------------------------------------------- Format categories section sub format_abbreviation { my @tokeninfo=@_; @@ -367,8 +409,9 @@ sub format_abbreviation { $parser->get_tag('/abbreviation'); $abbreviation=$text; } - return ''; + return(''); } + # -------------------------------------------------------- Format chown section sub format_chown { my @tokeninfo=@_; @@ -378,8 +421,9 @@ sub format_chown { $parser->get_tag('/chown'); $chown=$text; } - return ''; + return(''); } + # -------------------------------------------------------- Format chmod section sub format_chmod { my @tokeninfo=@_; @@ -389,8 +433,9 @@ sub format_chmod { $parser->get_tag('/chmod'); $chmod=$text; } - return ''; + return(''); } + # ------------------------------------------------- Format categoryname section sub format_categoryname { my @tokeninfo=@_; @@ -400,15 +445,17 @@ sub format_categoryname { $parser->get_tag('/categoryname'); $categoryname=$text; } - return ''; + return(''); } + # -------------------------------------------------------- Format files section sub format_files { my $text=$parser->get_text('/files'); $parser->get_tag('/files'); - return "\n".'# There are '.$file_count.' files this script works on'. - "\n\n".$text; + return("\n".'# There are '.$file_count.' files this script works on'. + "\n\n".$text); } + # --------------------------------------------------------- Format file section sub format_file { my @tokeninfo=@_; @@ -418,10 +465,10 @@ sub format_file { $file_count++; $categorycount{$categoryname}++; $parser->get_tag('/file'); - return "# File: $target\n". - "$text\n"; - return ''; + return("# File: $target\n". + "$text\n"); } + # ------------------------------------------------------- Format target section sub format_target { my @tokeninfo=@_; @@ -431,8 +478,9 @@ sub format_target { $parser->get_tag('/target'); $target=$targetrootarg.$text; } - return ''; + return(''); } + # --------------------------------------------------------- Format note section sub format_note { my @tokeninfo=@_; @@ -456,9 +504,9 @@ sub format_note { if ($text) { $note=$text; } - return ''; - + return(''); } + # ------------------------------------------------- Format dependencies section sub format_dependencies { my @tokeninfo=@_; @@ -469,32 +517,38 @@ sub format_dependencies { $dependencies=join(';', (map {s/^\s*//;s/\s$//;$_} split(/\;/,$text))); } - return ''; + return(''); } + # ------------------------------------------------ Format specialnotice section sub format_specialnotices { $parser->get_tag('/specialnotices'); - return ''; + return(''); } + # ------------------------------------------------ Format specialnotice section sub format_specialnotice { $parser->get_tag('/specialnotice'); - return ''; + return(''); } + # ------------------------------------- Render less-than and greater-than signs sub htmlsafe { my $text=@_[0]; $text =~ s//>/g; - return $text; + return($text); } + # --------------------------------------- remove starting and ending whitespace 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 + =head1 NAME piml_parse.pl - This is meant to parse files meeting the piml document type. @@ -513,7 +567,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 * @@ -526,7 +580,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 @@ -554,4 +608,12 @@ linux 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