--- loncom/build/piml_parse.pl 2002/01/31 17:32:25 1.2 +++ loncom/build/piml_parse.pl 2002/11/26 15:25:21 1.8 @@ -1,11 +1,16 @@ #!/usr/bin/perl +# -------------------------------------------------------- Documentation notice +# Run "perldoc ./lpml_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.2 2002/01/31 17:32:25 harris41 Exp $ +# $Id: piml_parse.pl,v 1.8 2002/11/26 15:25:21 matthew 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 - Scott Harrison +# 1/28,1/29,1/30,1/31,2/5,4/8 - Scott Harrison # ### @@ -58,14 +63,15 @@ use HTML::TokeParser; -my $usage=<=3) { $mode = shift @ARGV; } else { @@ -120,7 +126,7 @@ END # ---------------------------------------------------- Start first pass through my @parsecontents = <>; 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,7 +135,7 @@ 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'); @@ -190,7 +196,7 @@ while ($token = $parser->get_token()) { $cleanstring.=$token->[4]; } if ($token->[4]=~/\/>$/) { - $hloc--; +# $hloc--; } } if ($token->[0] eq 'E') { @@ -236,13 +242,15 @@ my $fileglob_count; my $fileglobnames_count; my %categorycount; +my $mode; + my @buildall; 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'); @@ -272,21 +280,21 @@ $parser->{textify}={ my $text; my $token; -undef $hloc; -undef @hierarchy; +undef($hloc); +undef(@hierarchy); my $hloc; my @hierarchy2; 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(); + print($piml); + print("\n"); + print($text); + print("\n"); + print(&end()); } -exit; +exit(0); # ---------- Functions (most all just format contents of different markup tags) @@ -318,26 +326,38 @@ 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'}; 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 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 { @@ -353,7 +373,7 @@ sub format_category { $categoryhash{$category_att_name}='-o '.$user.' -g '.$group. ' -m '.$chmod; } - return ''; + return(''); } # --------------------------------------------------- Format categories section sub format_abbreviation { @@ -364,7 +384,7 @@ sub format_abbreviation { $parser->get_tag('/abbreviation'); $abbreviation=$text; } - return ''; + return(''); } # -------------------------------------------------------- Format chown section sub format_chown { @@ -375,7 +395,7 @@ sub format_chown { $parser->get_tag('/chown'); $chown=$text; } - return ''; + return(''); } # -------------------------------------------------------- Format chmod section sub format_chmod { @@ -386,7 +406,7 @@ sub format_chmod { $parser->get_tag('/chmod'); $chmod=$text; } - return ''; + return(''); } # ------------------------------------------------- Format categoryname section sub format_categoryname { @@ -397,14 +417,14 @@ 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 { @@ -415,9 +435,8 @@ 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 { @@ -428,7 +447,7 @@ sub format_target { $parser->get_tag('/target'); $target=$targetrootarg.$text; } - return ''; + return(''); } # --------------------------------------------------------- Format note section sub format_note { @@ -453,8 +472,7 @@ sub format_note { if ($text) { $note=$text; } - return ''; - + return(''); } # ------------------------------------------------- Format dependencies section sub format_dependencies { @@ -466,36 +484,37 @@ 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. -See piml.dtd. PIML=Post Installation Markup Language. +piml_parse.pl - This is meant to parse piml files (Post Installation Markup Language) =head1 SYNOPSIS @@ -551,4 +570,12 @@ linux Packaging/Administrative +=head1 AUTHOR + + Scott Harrison + codeharrison@yahoo.com + +Please let me know how/if you are finding this script useful and +any/all suggestions. -Scott + =cut