--- loncom/build/lpml_parse.pl 2001/11/07 16:59:51 1.17 +++ loncom/build/lpml_parse.pl 2002/04/08 10:56:16 1.43 @@ -1,12 +1,50 @@ #!/usr/bin/perl -# Scott Harrison +# -------------------------------------------------------- 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 +# lpml_parse.pl - Linux Packaging Markup Language parser +# +# $Id: lpml_parse.pl,v 1.43 2002/04/08 10:56:16 harris41 Exp $ +# +# Written by Scott Harrison, codeharrison@yahoo.com +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# # YEAR=2001 # May 2001 # 06/19/2001,06/20,06/24 - Scott Harrison # 9/5/2001,9/6,9/7,9/8 - Scott Harrison # 9/17,9/18 - Scott Harrison -# 11/4 - Scott Harrison +# 11/4,11/5,11/6,11/7,11/16,11/17 - Scott Harrison +# 12/2,12/3,12/4,12/5,12/6,12/13,12/19,12/29 - Scott Harrison +# YEAR=2002 +# 1/8,1/9,1/29,1/31,2/5,3/21,4/8 - Scott Harrison +# +### ############################################################################### ## ## @@ -25,7 +63,8 @@ # # I am using a multiple pass-through approach to parsing # the lpml file. This saves memory and makes sure the server -# will never be overloaded. +# will never be overloaded. At some point, I expect the +# first two steps will be implemented with my XFML # # This is meant to parse files meeting the lpml document type. # See lpml.dtd. LPML=Linux Packaging Markup Language. @@ -46,12 +85,12 @@ Only the 1st argument is mandatory for t Example: cat ../../doc/loncapafiles.lpml |\\ -perl lpml_parse.pl html default /home/sherbert/loncapa /tmp/install +perl lpml_parse.pl html development default /home/sherbert/loncapa /tmp/install END # ------------------------------------------------- Grab command line arguments -my $mode; +my $mode=''; if (@ARGV==5) { $mode = shift @ARGV; } @@ -62,18 +101,20 @@ else { exit -1; # exit with error status } -my $categorytype; +my $categorytype=''; if (@ARGV) { $categorytype = shift @ARGV; } -my $dist; +my $dist=''; if (@ARGV) { $dist = shift @ARGV; } -my $targetroot; -my $sourceroot; +my $targetroot=''; +my $sourceroot=''; +my $targetrootarg=''; +my $sourcerootarg=''; if (@ARGV) { $sourceroot = shift @ARGV; } @@ -82,6 +123,10 @@ if (@ARGV) { } $sourceroot=~s/\/$//; $targetroot=~s/\/$//; +$sourcerootarg=$sourceroot; +$targetrootarg=$targetroot; + +my $logcmd='| tee -a WARNINGS'; my $invocation; # --------------------------------------------------- Record program invocation @@ -91,15 +136,15 @@ if ($mode eq 'install' or $mode eq 'conf # 1st argument (mode) is: $mode # 2nd argument (category type) is: $categorytype # 3rd argument (distribution) is: $dist -# 4th argument (targetroot) is: described below -# 5th argument (sourceroot) is: described below +# 4th argument (sourceroot) is: described below +# 5th argument (targetroot) is: described below 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 @@ -113,7 +158,7 @@ $parser = HTML::TokeParser->new(\$parses die('can\'t create TokeParser object'); $parser->xml_mode('1'); my %hash; -my $key; +my $key=''; while ($token = $parser->get_token()) { if ($token->[0] eq 'S') { $hloc++; @@ -134,9 +179,9 @@ while ($token = $parser->get_token()) { } # --------------------------------------------------- Start second pass through -undef $hloc; -undef @hierarchy; -undef $parser; +undef($hloc); +undef(@hierarchy); +undef($parser); $hierarchy[0]=0; $parser = HTML::TokeParser->new(\$parsestring) or die('can\'t create TokeParser object'); @@ -169,7 +214,7 @@ while ($token = $parser->get_token()) { $cleanstring.=$token->[4]; } if ($token->[4]=~/\/>$/) { - $hloc--; +# $hloc--; } } if ($token->[0] eq 'E') { @@ -188,11 +233,13 @@ $cleanstring=~s/\>\s*\n\s*\\new(\$cleans $parser->xml_mode('1'); # Define handling methods for mode-dependent text rendering + $parser->{textify}={ + specialnotices => \&format_specialnotices, + specialnotice => \&format_specialnotice, targetroot => \&format_targetroot, sourceroot => \&format_sourceroot, categories => \&format_categories, category => \&format_category, + abbreviation => \&format_abbreviation, targetdir => \&format_targetdir, chown => \&format_chown, chmod => \&format_chmod, @@ -266,6 +325,7 @@ $parser->{textify}={ rpmAutoReqProv => \&format_rpmAutoReqProv, rpmdescription => \&format_rpmdescription, rpmpre => \&format_rpmpre, + rpmRequires => \&format_rpmRequires, directories => \&format_directories, directory => \&format_directory, categoryname => \&format_categoryname, @@ -312,7 +372,43 @@ exit; # ------------------------ Final output at end of markup parsing and formatting sub end { if ($mode eq 'html') { - return "
THE END\n"; + return "
 
". + "Summary of Source Repository". + "". + "
 
". + "". + "". + "". + "". + "". + "". + "". + "". + "". + "". + "". + "". + "". + "". + "". + "". + "". + "". + "". + "
Files, Directories, and Symbolic Links
Files (not referenced by globs)$file_count
Files (referenced by globs)$fileglobnames_count
Total Files".($fileglobnames_count+$file_count)."
File globs".$fileglob_count."
Directories".$directory_count."
Symbolic links".$link_count."
". + "". + "". + "". + "". + "". + join("\n",(map {"". + "". + ""} + @categorynamelist)). + "
File Category Count
IconNameNumber of OccurrencesNumber of Incorrect Counts
$_$categorycount{$_}
". + "\n"; + } if ($mode eq 'install') { return ''; @@ -331,7 +427,57 @@ sub format_lpml { my (@tokeninfo)=@_; my $date=`date`; chop $date; if ($mode eq 'html') { - $lpml = "
LPML BEGINNING: $date"; + $lpml=< + +LPML Description Page +(dist=$dist, categorytype=$categorytype, $date) + + +END + $lpml .= "
LPML Description Page (dist=$dist, ". + "categorytype=$categorytype, $date)". + ""; + $lpml .=< +
  • About this file
    • +
  • File Type Ownership and Permissions +Descriptions
    • +
  • Software Package Description
    • +
  • Directory Structure
    • +
  • Files
    • +
  • Summary of Source Repository
    • + +END + $lpml .=< 
    +About this file +

    +This file is generated dynamically by lpml_parse.pl as +part of a development compilation process.

    +

    LPML written by Scott Harrison (harris41\@msu.edu). +

    +END + } + elsif ($mode eq 'text') { + $lpml = "LPML Description Page (dist=$dist, $date)"; + $lpml .=<get_text('/categories')); $parser->get_tag('/categories'); if ($mode eq 'html') { - return $categories="\n
    BEGIN CATEGORIES\n$text\n". - "
    END CATEGORIES\n"; + return $categories="\n
     
    ". + "\n    ". + "\nFile Type Ownership and Permissions". + " Descriptions". + "\n

    This table shows what permissions and ownership settings ". + "correspond to each category.

    ". + "\n\n". + "". + "". + "". + "". + "". + "\n$text\n". + "
    IconCategory NamePermissions ". + "($categorytype)
    \n"; + } + elsif ($mode eq 'text') { + return $categories="\n". + "\nFile Type Ownership and Permissions". + " Descriptions". + "\n$text". + "\n"; } else { return ''; @@ -408,12 +574,24 @@ sub format_category { my (@tokeninfo)=@_; $category_att_name=$tokeninfo[2]->{'name'}; $category_att_type=$tokeninfo[2]->{'type'}; - $chmod='';$chown=''; + $abbreviation=''; $chmod='';$chown=''; $parser->get_text('/category'); $parser->get_tag('/category'); + $fab{$category_att_name}=$abbreviation; if ($mode eq 'html') { - return $category="\n
    CATEGORY $category_att_name ". - "$category_att_type $chmod $chown"; + if ($category_att_type eq $categorytype) { + push @categorynamelist,$category_att_name; + $categoryhash{$category_att_name}="$chmod $chown"; + return $category="". + "\n". + "${category_att_name}\n". + "$chmod $chown\n". + "". + "\n"; +# return $category="\n
    CATEGORY $category_att_name ". +# "$category_att_type $chmod $chown"; + } } else { if ($category_att_type eq $categorytype) { @@ -424,6 +602,17 @@ sub format_category { return ''; } } +# --------------------------------------------------- Format categories section +sub format_abbreviation { + my @tokeninfo=@_; + $abbreviation=''; + my $text=&trim($parser->get_text('/abbreviation')); + if ($text) { + $parser->get_tag('/abbreviation'); + $abbreviation=$text; + } + return ''; +} # -------------------------------------------------------- Format chown section sub format_chown { my @tokeninfo=@_; @@ -451,7 +640,27 @@ sub format_rpm { my $text=&trim($parser->get_text('/rpm')); $parser->get_tag('/rpm'); if ($mode eq 'html') { - return $rpm="\n
    BEGIN RPM\n$text\n
    END RPM"; + return $rpm=< 
    +     +Software Package Description +

    + + +
    +$text
+
    +END + } + elsif ($mode eq 'make_rpm') { + return $text; + } + elsif ($mode eq 'text') { + return $rpm=<get_text('/rpmSummary')); $parser->get_tag('/rpmSummary'); if ($mode eq 'html') { - return $rpmSummary="\n
    RPMSUMMARY $text"; + return $rpmSummary="\nSummary : $text"; + } + elsif ($mode eq 'text') { + return $rpmSummary="\nSummary : $text"; + } + elsif ($mode eq 'make_rpm') { + return <$text +END } else { return ''; @@ -473,7 +690,15 @@ sub format_rpmName { my $text=&trim($parser->get_text('/rpmName')); $parser->get_tag('/rpmName'); if ($mode eq 'html') { - return $rpmName="\n
    RPMNAME $text"; + return $rpmName="\nName : $text"; + } + elsif ($mode eq 'text') { + return $rpmName="\nName : $text"; + } + elsif ($mode eq 'make_rpm') { + return <$text +END } else { return ''; @@ -484,7 +709,10 @@ sub format_rpmVersion { my $text=$parser->get_text('/rpmVersion'); $parser->get_tag('/rpmVersion'); if ($mode eq 'html') { - return $rpmVersion="\n
    RPMVERSION $text"; + return $rpmVersion="\nVersion : $text"; + } + elsif ($mode eq 'text') { + return $rpmVersion="\nVersion : $text"; } else { return ''; @@ -495,7 +723,10 @@ sub format_rpmRelease { my $text=$parser->get_text('/rpmRelease'); $parser->get_tag('/rpmRelease'); if ($mode eq 'html') { - return $rpmRelease="\n
    RPMRELEASE $text"; + return $rpmRelease="\nRelease : $text"; + } + elsif ($mode eq 'text') { + return $rpmRelease="\nRelease : $text"; } else { return ''; @@ -506,7 +737,15 @@ sub format_rpmVendor { my $text=$parser->get_text('/rpmVendor'); $parser->get_tag('/rpmVendor'); if ($mode eq 'html') { - return $rpmVendor="\n
    RPMVENDOR $text"; + return $rpmVendor="\nVendor : $text"; + } + elsif ($mode eq 'text') { + return $rpmVendor="\nVendor : $text"; + } + elsif ($mode eq 'make_rpm') { + return <$text +END } else { return ''; @@ -517,7 +756,10 @@ sub format_rpmBuildRoot { my $text=$parser->get_text('/rpmBuildRoot'); $parser->get_tag('/rpmBuildRoot'); if ($mode eq 'html') { - return $rpmBuildRoot="\n
    RPMBUILDROOT $text"; + return $rpmBuildRoot="\nBuild Root : $text"; + } + elsif ($mode eq 'text') { + return $rpmBuildRoot="\nBuild Root : $text"; } else { return ''; @@ -528,7 +770,15 @@ sub format_rpmCopyright { my $text=$parser->get_text('/rpmCopyright'); $parser->get_tag('/rpmCopyright'); if ($mode eq 'html') { - return $rpmCopyright="\n
    RPMCOPYRIGHT $text"; + return $rpmCopyright="\nLicense : $text"; + } + elsif ($mode eq 'text') { + return $rpmCopyright="\nLicense : $text"; + } + elsif ($mode eq 'make_rpm') { + return <$text +END } else { return ''; @@ -539,7 +789,15 @@ sub format_rpmGroup { my $text=$parser->get_text('/rpmGroup'); $parser->get_tag('/rpmGroup'); if ($mode eq 'html') { - return $rpmGroup="\n
    RPMGROUP $text"; + return $rpmGroup="\nGroup : $text"; + } + elsif ($mode eq 'text') { + return $rpmGroup="\nGroup : $text"; + } + elsif ($mode eq 'make_rpm') { + return <Utilities/System +END } else { return ''; @@ -550,7 +808,10 @@ sub format_rpmSource { my $text=$parser->get_text('/rpmSource'); $parser->get_tag('/rpmSource'); if ($mode eq 'html') { - return $rpmSource="\n
    RPMSOURCE $text"; + return $rpmSource="\nSource : $text"; + } + elsif ($mode eq 'text') { + return $rpmSource="\nSource : $text"; } else { return ''; @@ -561,7 +822,15 @@ sub format_rpmAutoReqProv { my $text=$parser->get_text('/rpmAutoReqProv'); $parser->get_tag('/rpmAutoReqProv'); if ($mode eq 'html') { - return $rpmAutoReqProv="\n
    RPMAUTOREQPROV $text"; + return $rpmAutoReqProv="\nAutoReqProv : $text"; + } + elsif ($mode eq 'text') { + return $rpmAutoReqProv="\nAutoReqProv : $text"; + } + elsif ($mode eq 'make_rpm') { + return <$text +END } else { return ''; @@ -572,7 +841,21 @@ sub format_rpmdescription { my $text=$parser->get_text('/rpmdescription'); $parser->get_tag('/rpmdescription'); if ($mode eq 'html') { - return $rpmdescription="\n
    RPMDESCRIPTION $text"; + $text=~s/\n//g; + $text=~s/\\n/\n/g; + return $rpmdescription="\nDescription : $text"; + } + elsif ($mode eq 'text') { + $text=~s/\n//g; + $text=~s/\\n/\n/g; + return $rpmdescription="\nDescription : $text"; + } + elsif ($mode eq 'make_rpm') { + $text=~s/\n//g; + $text=~s/\\n/\n/g; + return <$text +END } else { return ''; @@ -583,23 +866,73 @@ sub format_rpmpre { my $text=$parser->get_text('/rpmpre'); $parser->get_tag('/rpmpre'); if ($mode eq 'html') { - return $rpmpre="\n
    RPMPRE $text"; +# return $rpmpre="\n
    RPMPRE $text"; + return ''; + } + elsif ($mode eq 'make_rpm') { + return <$text +END } else { return ''; } } +# -------------------------------------------------- Format requires section +sub format_rpmRequires { + my @tokeninfo=@_; + my $aref; + my $text; + if ($mode eq 'make_rpm') { + while ($aref=$parser->get_token()) { + if ($aref->[0] eq 'E' && $aref->[1] eq 'rpmRequires') { + last; + } + elsif ($aref->[0] eq 'S') { + $text.=$aref->[4]; + } + elsif ($aref->[0] eq 'E') { + $text.=$aref->[2]; + } + else { + $text.=$aref->[1]; + } + } + } + else { + $parser->get_tag('/rpmRequires'); + return ''; + } + return ''.$text.''; +} # -------------------------------------------------- Format directories section sub format_directories { my $text=$parser->get_text('/directories'); $parser->get_tag('/directories'); if ($mode eq 'html') { - return $directories="\n
    BEGIN DIRECTORIES\n$text\n
    ". - "END DIRECTORIES\n"; + $text=~s/\[\{\{\{\{\{DPATHLENGTH\}\}\}\}\}\]/$dpathlength/g; + return $directories="\n
     
    ". + "    ". + "Directory Structure". + "\n
     
    ". + "\n". + "". + "\n". + "\n". + "\n". + "\n$text\n
    CategoryStatusExpected Permissions & OwnershipTarget Directory ". + "Path

    "."\n"; + } + elsif ($mode eq 'text') { + return $directories="\nDirectory Structure\n$text\n". + "\n"; } elsif ($mode eq 'install') { return "\n".'directories:'."\n".$text; - } + } + elsif ($mode eq 'rpm_file_list') { + return $text; + } else { return ''; } @@ -610,14 +943,37 @@ sub format_directory { $targetdir='';$categoryname='';$description=''; $parser->get_text('/directory'); $parser->get_tag('/directory'); + $directory_count++; + $categorycount{$categoryname}++; if ($mode eq 'html') { - return $directory="\n
    DIRECTORY $targetdir $categoryname ". + my @a; + @a=($targetdir=~/\//g); + my $d=scalar(@a)+1; + $dpathlength=$d if $d>$dpathlength; + my $thtml=$targetdir; + $thtml=~s/\//\<\/td\>\/g; + my ($chmod,$chown)=split(/\s/,$categoryhash{$categoryname}); + return $directory="\n". + "$categoryname". + "". + " ". + "$chmod
    $chown". + "$thtml". + "". + "$description"; + } + if ($mode eq 'text') { + return $directory="\nDIRECTORY $targetdir $categoryname ". "$description"; } elsif ($mode eq 'install') { return "\t".'install '.$categoryhash{$categoryname}.' -d '. $targetroot.'/'.$targetdir."\n"; } + elsif ($mode eq 'rpm_file_list') { + return $targetroot.'/'.$targetdir."\n"; + } else { return ''; } @@ -660,7 +1016,24 @@ sub format_files { my $text=$parser->get_text('/files'); $parser->get_tag('/files'); if ($mode eq 'html') { - return $directories="\n
    BEGIN FILES\n$text\n
    END FILES\n"; + return $directories="\n
     
    ". + "    ". + "Files
     
    ". + "

    All source and target locations are relative to the ". + "sourceroot and targetroot values at the beginning of this ". + "document.

    ". + "\n". + "". + "". + "". + "$text
    StatusCategoryName/LocationDescriptionNotes
    \n". + "\n"; + } + elsif ($mode eq 'text') { + return $directories="\n". + "File and Directory Structure". + "\n$text\n". + "\n"; } elsif ($mode eq 'install') { return "\n".'files:'."\n".$text. @@ -680,8 +1053,14 @@ sub format_files { foreach my $bi (@buildinfo) { my ($target,$source,$command,$trigger,@deps)=split(/\;/,$bi); $tword=''; $tword=' alwaysrun' if $trigger eq 'always run'; - $command=~s/\/([^\/]*)$//; - $command2="cd $command; sh ./$1;\\"; + if ($command!~/\s/) { + $command=~s/\/([^\/]*)$//; + $command2="cd $command; sh ./$1;\\"; + } + else { + $command=~s/(.*?\/)([^\/]+\s+.*)$/$1/; + $command2="cd $command; sh ./$2;\\"; + } my $depstring; my $depstring2="\t\t\@echo '';\\\n"; my $olddep; @@ -692,22 +1071,22 @@ sub format_files { $depstring.="\telif !(test -r $command/$dep);\\\n"; $depstring.="\t\tthen echo ". "\"**** WARNING **** missing the file: ". - "$command/$dep\";\\\n"; + "$command/$dep\"$logcmd;\\\n"; $depstring.="\t\ttest -e $source || test -e $target || echo ". "'**** ERROR **** neither source=$source nor target=". - "$target exist and they cannot be built';\\\n"; + "$target exist and they cannot be built'$logcmd;\\\n"; $depstring.="\t\tmake -f Makefile.build ${source}___DEPS;\\\n"; if ($olddep) { $depstring2.="\t\tECODE=0;\\\n"; $depstring2.="\t\t! test -e $source && test -r $command/$olddep &&". - " { perl filecompare.pl -B $command/$olddep $target || ECODE=\$\$?; } && { [ \$\$ECODE != \"2\" ] || echo \"**** WARNING **** dependency $command/$olddep is newer than target file $target; SOMETHING MAY BE WRONG\"; };\\\n"; + " { perl filecompare.pl -b2 $command/$olddep $target || ECODE=\$\$?; } && { [ \$\$ECODE != \"2\" ] || echo \"**** WARNING **** dependency $command/$olddep is newer than target file $target; SOMETHING MAY BE WRONG\"$logcmd; };\\\n"; } $olddep=$dep; } $binfo.="$source: $tword\n". "\t\@if !(echo \"\");\\\n\t\tthen echo ". "\"**** WARNING **** Strange shell. ". - "Check your path settings.\";\\\n". + "Check your path settings.\"$logcmd;\\\n". $depstring. "\telse \\\n\t\t$command2\n\tfi\n\n"; $binfo.="${source}___DEPS:\n".$depstring2."\t\tECODE=0;\n\n"; @@ -717,6 +1096,9 @@ sub format_files { $binfo."\n". "alwaysrun:\n\n"; } + elsif ($mode eq 'rpm_file_list') { + return $text; + } else { return ''; } @@ -747,13 +1129,29 @@ sub format_file { $note=''; $build=''; $status=''; $dependencies=''; my $text=&trim($parser->get_text('/file')); my $buildtest; + $file_count++; + $categorycount{$categoryname}++; if ($source) { $parser->get_tag('/file'); if ($mode eq 'html') { - return ($file="\n
    BEGIN FILE\n". - "$source $target $categoryname $description $note " . - "$build $status $dependencies" . - "\nEND FILE"); + return ($file="\n". + "". + " ". + "". + "$categoryname
    ". + $categoryhash{$categoryname}."". + "SOURCE: $source
    TARGET: $target". + "$description". + "$note". + ""); +# return ($file="\n
    BEGIN FILE\n". +# "$source $target $categoryname $description $note " . +# "$build $status $dependencies" . +# "\nEND FILE"); } elsif ($mode eq 'install' && $categoryname ne 'conf') { if ($build) { @@ -767,17 +1165,17 @@ sub format_file { foreach my $dep (@deps) { $depstring.=<get_text('/link')); if ($linkto) { $parser->get_tag('/link'); if ($mode eq 'html') { - return $link="\n
    BEGIN LINK\n". - "$linkto $target $categoryname $description $note " . - "$build $status $dependencies" . - "\nEND LINK"; + my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target); + $link_count+=scalar(@targets); + foreach my $tgt (@targets) { + $categorycount{$categoryname}++; + push @links,("\n". + "". + " ". + "". + "$categoryname". + "LINKTO: $linkto
    TARGET: $tgt". + "$description". + "$note". + ""); +# push @links,"\t".'ln -fs /'.$linkto.' /'.$targetroot.$tgt. +# "\n"; + } + return join('',@links); +# return ($link="\n". +# "". +# " ". +# "$categoryname". +# "LINKTO: $linkto
    TARGET: $target". +# "$description". +# "$note". +# ""); +# return $link="\nBEGIN LINK\n". +# "$linkto $target $categoryname $description $note " . +# "$build $status $dependencies" . +# "\nEND LINK"; } elsif ($mode eq 'install') { my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target); foreach my $tgt (@targets) { - push @links,"\t".'ln -fs /'.$linkto.' /'.$targetroot.$tgt. + push @links,"\t".'ln -fs /'.$linkto.' '.$targetroot.'/'.$tgt. "\n"; } +# return join('',@links); return ''; } + elsif ($mode eq 'rpm_file_list') { + my @linklocs; + my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target); + foreach my $tgt (@targets) { + push @linklocs,''.$targetroot.'/'.$tgt."\n"; + } + return join('',@linklocs); + } else { return ''; } @@ -874,20 +1337,56 @@ sub format_fileglob { $note=''; $build=''; $status=''; $dependencies=''; $filenames=''; my $text=&trim($parser->get_text('/fileglob')); + my $filenames2=$filenames;$filenames2=~s/\s//g; + $fileglob_count++; + my @semi=($filenames2=~/(\;)/g); + $fileglobnames_count+=scalar(@semi)+1; + $categorycount{$categoryname}+=scalar(@semi)+1; if ($sourcedir) { $parser->get_tag('/fileglob'); if ($mode eq 'html') { - return $fileglob="\n
    BEGIN FILEGLOB\n". - "$glob sourcedir $targetdir $categoryname $description $note ". - "$build $status $dependencies $filenames" . - "\nEND FILEGLOB"; + return $fileglob="\n". + " ". + ""."". + "$categoryname
    ". + "".$categoryhash{$categoryname}."". + "SOURCEDIR: $sourcedir
    ". + "TARGETDIR: $targetdir
    ". + "GLOB: $glob
    ". + "FILENAMES: $filenames". + "". + "$description". + "$note". + ""; +# return $fileglob="\nBEGIN FILEGLOB\n". +# "$glob sourcedir $targetdir $categoryname $description $note ". +# "$build $status $dependencies $filenames" . +# "\nEND FILEGLOB"; } elsif ($mode eq 'install') { + my $eglob=$glob; + if ($glob eq '*') { + $eglob='[^C][^V][^S]'.$glob; + } return "\t".'install '. $categoryhash{$categoryname}.' '. - $sourceroot.'/'.$sourcedir.'[^C][^V][^S]'.$glob.' '. + $sourceroot.'/'.$sourcedir.$eglob.' '. $targetroot.'/'.$targetdir.'.'."\n"; } + elsif ($mode eq 'rpm_file_list') { + my $eglob=$glob; + if ($glob eq '*') { + $eglob='[^C][^V][^S]'.$glob; + } + my $targetdir2=$targetdir;$targetdir2=~s/\/$//; + my @gfiles=map {s/^.*\///;"$targetroot/$targetdir2/$_\n"} + glob("$sourceroot/$sourcedir/$eglob"); + return join('',@gfiles); + } else { return ''; } @@ -931,9 +1430,25 @@ sub format_source { sub format_note { my @tokeninfo=@_; $note=''; - my $text=&trim($parser->get_text('/note')); +# my $text=&trim($parser->get_text('/note')); + my $aref; + my $text; + while ($aref=$parser->get_token()) { + if ($aref->[0] eq 'E' && $aref->[1] eq 'note') { + last; + } + elsif ($aref->[0] eq 'S') { + $text.=$aref->[4]; + } + elsif ($aref->[0] eq 'E') { + $text.=$aref->[2]; + } + else { + $text.=$aref->[1]; + } + } if ($text) { - $parser->get_tag('/note'); +# $parser->get_tag('/note'); $note=$text; } return ''; @@ -947,6 +1462,7 @@ sub format_build { if ($text) { $parser->get_tag('/build'); $build=$sourceroot.'/'.$text.';'.$tokeninfo[2]{'trigger'}; + $build=~s/([^\\])\\\s+/$1/g; # allow for lines split onto new lines } return ''; } @@ -1005,6 +1521,16 @@ sub format_filenames { } return ''; } +# ----------------------------------------------- Format specialnotices section +sub format_specialnotices { + $parser->get_tag('/specialnotices'); + return ''; +} +# ------------------------------------------------ Format specialnotice section +sub format_specialnotice { + $parser->get_tag('/specialnotice'); + return ''; +} # ------------------------------------------------------- Format linkto section sub format_linkto { my @tokeninfo=@_; @@ -1028,3 +1554,82 @@ sub trim { } # ----------------------------------- POD (plain old documentation, CPAN style) + +=pod + +=head1 NAME + +lpml_parse.pl - This is meant to parse files meeting the lpml document type. +See lpml.dtd. LPML=Linux Packaging Markup Language. + +=head1 SYNOPSIS + +Usage is for lpml file to come in through standard input. + +=over 4 + +=item * + +1st argument is the mode of parsing. + +=item * + +2nd argument is the category permissions to use (runtime or development) + +=item * + +3rd argument is the distribution +(default,redhat6.2,debian2.2,redhat7.1,etc). + +=item * + +4th argument is to manually specify a sourceroot. + +=item * + +5th argument is to manually specify a targetroot. + +=back + +Only the 1st argument is mandatory for the program to run. + +Example: + +cat ../../doc/loncapafiles.lpml |\\ +perl lpml_parse.pl html default /home/sherbert/loncapa /tmp/install + +=head1 DESCRIPTION + +I am using a multiple pass-through approach to parsing +the lpml file. This saves memory and makes sure the server +will never be overloaded. + +=head1 README + +I am using a multiple pass-through approach to parsing +the lpml file. This saves memory and makes sure the server +will never be overloaded. + +=head1 PREREQUISITES + +HTML::TokeParser + +=head1 COREQUISITES + +=head1 OSNAMES + +linux + +=head1 SCRIPT CATEGORIES + +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