--- loncom/build/piml_parse.pl 2002/02/05 01:49:39 1.5 +++ loncom/build/piml_parse.pl 2002/04/08 10:53:17 1.6 @@ -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.5 2002/02/05 01:49:39 harris41 Exp $ +# $Id: piml_parse.pl,v 1.6 2002/04/08 10:53:17 harris41 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 # ### @@ -58,7 +63,7 @@ use HTML::TokeParser; -my $usage=<; 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 +134,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'); @@ -244,7 +249,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'); @@ -274,21 +279,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) @@ -320,7 +325,7 @@ 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 { @@ -329,29 +334,29 @@ sub format_perlscript { my $text=$parser->get_text('/perlscript'); $parser->get_tag('/perlscript'); if ($mode eq 'bg') { - open OUT,">/tmp/piml$$.pl"; - print OUT $text; - close OUT; - return </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 { @@ -367,7 +372,7 @@ sub format_category { $categoryhash{$category_att_name}='-o '.$user.' -g '.$group. ' -m '.$chmod; } - return ''; + return(''); } # --------------------------------------------------- Format categories section sub format_abbreviation { @@ -378,7 +383,7 @@ sub format_abbreviation { $parser->get_tag('/abbreviation'); $abbreviation=$text; } - return ''; + return(''); } # -------------------------------------------------------- Format chown section sub format_chown { @@ -389,7 +394,7 @@ sub format_chown { $parser->get_tag('/chown'); $chown=$text; } - return ''; + return(''); } # -------------------------------------------------------- Format chmod section sub format_chmod { @@ -400,7 +405,7 @@ sub format_chmod { $parser->get_tag('/chmod'); $chmod=$text; } - return ''; + return(''); } # ------------------------------------------------- Format categoryname section sub format_categoryname { @@ -411,14 +416,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 { @@ -429,9 +434,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 { @@ -442,7 +446,7 @@ sub format_target { $parser->get_tag('/target'); $target=$targetrootarg.$text; } - return ''; + return(''); } # --------------------------------------------------------- Format note section sub format_note { @@ -467,8 +471,7 @@ sub format_note { if ($text) { $note=$text; } - return ''; - + return(''); } # ------------------------------------------------- Format dependencies section sub format_dependencies { @@ -480,32 +483,34 @@ 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. @@ -565,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