--- loncom/build/piml_parse.pl 2002/01/29 10:43:02 1.1 +++ 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.1 2002/01/29 10:43:02 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 - Scott Harrison +# 1/28,1/29,1/30,1/31,2/5,4/8 - Scott Harrison # ### @@ -56,79 +61,77 @@ # 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 $sourceroot; my $targetrootarg; -my $sourcerootarg; -if (@ARGV) { - $targetroot = shift @ARGV; -} -$sourceroot=~s/\/$//; +if (@ARGV) + { + $targetroot = shift(@ARGV); + } + $targetroot=~s/\/$//; -$sourcerootarg=$sourceroot; $targetrootarg=$targetroot; 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 @@ -137,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; @@ -198,7 +206,7 @@ while ($token = $parser->get_token()) { $cleanstring.=$token->[4]; } if ($token->[4]=~/\/>$/) { - $hloc--; +# $hloc--; } } if ($token->[0] eq 'E') { @@ -224,43 +232,15 @@ my $category_att_type; my $chown; my $chmod; my $abbreviation; # space-free abbreviation; esp. for image names -my $rpm; -my $rpmSummary; -my $rpmName; -my $rpmVersion; -my $rpmRelease; -my $rpmVendor; -my $rpmBuildRoot; -my $rpmCopyright; -my $rpmGroup; -my $rpmSource; -my $rpmAutoReqProv; -my $rpmdescription; -my $rpmpre; -my $directories; -my $directory; -my $targetdirs; -my $targetdir; my $categoryname; my $description; my $files; -my $fileglobs; -my $links; my $file; -my $link; -my $fileglob; -my $sourcedir; -my $targets; my $target; -my $source; my $note; -my $build; -my $buildlink; my $commands; my $command; -my $status; my $dependencies; -my $dependency; my @links; my %categoryhash; my $dpathlength; @@ -271,10 +251,8 @@ my $link_count; my $fileglob_count; my $fileglobnames_count; my %categorycount; -# START TEMP WAY -#my %bytecount; # TEMP WAY TO COUNT INFORMATION -#my %linecount; # TEMP WAY TO COUNT INFORMATION -# END TEMP WAY + +my $mode; my @buildall; my @buildinfo; @@ -282,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'); @@ -293,131 +271,48 @@ $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, - rpm => \&format_rpm, - rpmSummary => \&format_rpmSummary, - rpmName => \&format_rpmName, - rpmVersion => \&format_rpmVersion, - rpmRelease => \&format_rpmRelease, - rpmVendor => \&format_rpmVendor, - rpmBuildRoot => \&format_rpmBuildRoot, - rpmCopyright => \&format_rpmCopyright, - rpmGroup => \&format_rpmGroup, - rpmSource => \&format_rpmSource, - rpmAutoReqProv => \&format_rpmAutoReqProv, - rpmdescription => \&format_rpmdescription, - rpmpre => \&format_rpmpre, - rpmRequires => \&format_rpmRequires, - directories => \&format_directories, - directory => \&format_directory, categoryname => \&format_categoryname, - description => \&format_description, files => \&format_files, file => \&format_file, - fileglob => \&format_fileglob, - links => \&format_links, - link => \&format_link, - linkto => \&format_linkto, - source => \&format_source, target => \&format_target, note => \&format_note, build => \&format_build, - status => \&format_status, dependencies => \&format_dependencies, - buildlink => \&format_buildlink, - glob => \&format_glob, - sourcedir => \&format_sourcedir, 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"; -# $text=~s/\s*\n\s*\n\s*/\n/g; - 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) # ------------------------ Final output at end of markup parsing and formatting sub end { - if ($mode eq 'html') { - # START TEMP WAY -# my $totallinecount; -# my $totalbytecount; -# map {$totallinecount+=$linecount{$_}; -# $totalbytecount+=$bytecount{$_}} -# @categorynamelist; - # END TEMP WAY - 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"; - -# START TEMP WAY -# join("\n",(map {"". -# "$_$categorycount{$_}$linecount{$_}$bytecount{$_}"} -# @categorynamelist)). -# "
 
". -# "Total Lines of Code: $totallinecount". -# "
 
". -# "Total Bytes: $totalbytecount". -# END TEMP WAY - } - if ($mode eq 'install') { - return ''; - } + } # ----------------------- Take in string to parse and the separation expression @@ -431,149 +326,63 @@ sub extract_array { sub format_piml { my (@tokeninfo)=@_; my $date=`date`; chop $date; - if ($mode eq 'html') { - $piml=< - -PIML Description Page -(dist=$dist, categorytype=$categorytype, $date) - - -END - $piml .= "
PIML Description Page (dist=$dist, ". - "categorytype=$categorytype, $date)". - ""; - $piml .=< -
  • About this file
    • -
  • File Type Ownership and Permissions -Descriptions
    • -
  • Software Package Description
    • -
  • Directory Structure
    • -
  • Files
    • -
  • Summary of Source Repository
    • - -END - $piml .=< 
    -About this file -

    -This file is generated dynamically by piml_parse.pl as -part of a development compilation process.

    -

    PIML written by Scott Harrison (harris41\@msu.edu). -

    -END - } - elsif ($mode eq 'text') { - $piml = "PIML Description Page (dist=$dist, $date)"; - $piml .=<get_text('/targetroot')); $text=$targetroot if $targetroot; $parser->get_tag('/targetroot'); - if ($mode eq 'html') { - return $targetroot="\n
    TARGETROOT: $text"; - } - elsif ($mode eq 'install' or $mode eq 'build' or - $mode eq 'configinstall') { - return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n"; - } - else { - return ''; - } + return('# TARGET INSTALL LOCATION is "'.$targetroot."\"\n"); } -# --------------------------------------------------- Format sourceroot section -sub format_sourceroot { - my $text=&trim($parser->get_text('/sourceroot')); - $text=$sourceroot if $sourceroot; - $parser->get_tag('/sourceroot'); - if ($mode eq 'html') { - return $sourceroot="\n
    SOURCEROOT: $text"; - } - elsif ($mode eq 'install' or $mode eq 'build' or - $mode eq 'configinstall') { - return '# SOURCE CODE LOCATION IS "'.$sourceroot."\"\n";; + +# -------------------------------------------------- Format perl script section +sub format_perlscript { + my (@tokeninfo)=@_; + $mode=$tokeninfo[2]->{'mode'}; + 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(<get_tag('/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'); - if ($mode eq 'html') { - 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 ''; - } + return('# CATEGORIES'."\n".$text); } + # --------------------------------------------------- Format categories section sub format_category { my (@tokeninfo)=@_; @@ -583,30 +392,14 @@ sub format_category { $parser->get_text('/category'); $parser->get_tag('/category'); $fab{$category_att_name}=$abbreviation; - if ($mode eq 'html') { - 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) { - my ($user,$group)=split(/\:/,$chown); - $categoryhash{$category_att_name}='-o '.$user.' -g '.$group. - ' -m '.$chmod; - } - return ''; + if ($category_att_type eq $categorytype) { + my ($user,$group)=split(/\:/,$chown); + $categoryhash{$category_att_name}='-o '.$user.' -g '.$group. + ' -m '.$chmod; } + return(''); } + # --------------------------------------------------- Format categories section sub format_abbreviation { my @tokeninfo=@_; @@ -616,8 +409,9 @@ sub format_abbreviation { $parser->get_tag('/abbreviation'); $abbreviation=$text; } - return ''; + return(''); } + # -------------------------------------------------------- Format chown section sub format_chown { my @tokeninfo=@_; @@ -627,8 +421,9 @@ sub format_chown { $parser->get_tag('/chown'); $chown=$text; } - return ''; + return(''); } + # -------------------------------------------------------- Format chmod section sub format_chmod { my @tokeninfo=@_; @@ -638,360 +433,9 @@ sub format_chmod { $parser->get_tag('/chmod'); $chmod=$text; } - return ''; + return(''); } -# ---------------------------------------------------------- Format rpm section -sub format_rpm { - my $text=&trim($parser->get_text('/rpm')); - $parser->get_tag('/rpm'); - if ($mode eq 'html') { - 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="\nSummary : $text"; - } - elsif ($mode eq 'text') { - return $rpmSummary="\nSummary : $text"; - } - elsif ($mode eq 'make_rpm') { - return <$text -END - } - else { - return ''; - } -} -# ------------------------------------------------------ Format rpmName section -sub format_rpmName { - my $text=&trim($parser->get_text('/rpmName')); - $parser->get_tag('/rpmName'); - if ($mode eq 'html') { - return $rpmName="\nName : $text"; - } - elsif ($mode eq 'text') { - return $rpmName="\nName : $text"; - } - elsif ($mode eq 'make_rpm') { - return <$text -END - } - else { - return ''; - } -} -# --------------------------------------------------- Format rpmVersion section -sub format_rpmVersion { - my $text=$parser->get_text('/rpmVersion'); - $parser->get_tag('/rpmVersion'); - if ($mode eq 'html') { - return $rpmVersion="\nVersion : $text"; - } - elsif ($mode eq 'text') { - return $rpmVersion="\nVersion : $text"; - } - else { - return ''; - } -} -# --------------------------------------------------- Format rpmRelease section -sub format_rpmRelease { - my $text=$parser->get_text('/rpmRelease'); - $parser->get_tag('/rpmRelease'); - if ($mode eq 'html') { - return $rpmRelease="\nRelease : $text"; - } - elsif ($mode eq 'text') { - return $rpmRelease="\nRelease : $text"; - } - else { - return ''; - } -} -# ---------------------------------------------------- Format rpmVendor section -sub format_rpmVendor { - my $text=$parser->get_text('/rpmVendor'); - $parser->get_tag('/rpmVendor'); - if ($mode eq 'html') { - return $rpmVendor="\nVendor : $text"; - } - elsif ($mode eq 'text') { - return $rpmVendor="\nVendor : $text"; - } - elsif ($mode eq 'make_rpm') { - return <$text -END - } - else { - return ''; - } -} -# ------------------------------------------------- Format rpmBuildRoot section -sub format_rpmBuildRoot { - my $text=$parser->get_text('/rpmBuildRoot'); - $parser->get_tag('/rpmBuildRoot'); - if ($mode eq 'html') { - return $rpmBuildRoot="\nBuild Root : $text"; - } - elsif ($mode eq 'text') { - return $rpmBuildRoot="\nBuild Root : $text"; - } - else { - return ''; - } -} -# ------------------------------------------------- Format rpmCopyright section -sub format_rpmCopyright { - my $text=$parser->get_text('/rpmCopyright'); - $parser->get_tag('/rpmCopyright'); - if ($mode eq 'html') { - return $rpmCopyright="\nLicense : $text"; - } - elsif ($mode eq 'text') { - return $rpmCopyright="\nLicense : $text"; - } - elsif ($mode eq 'make_rpm') { - return <$text -END - } - else { - return ''; - } -} -# ----------------------------------------------------- Format rpmGroup section -sub format_rpmGroup { - my $text=$parser->get_text('/rpmGroup'); - $parser->get_tag('/rpmGroup'); - if ($mode eq 'html') { - return $rpmGroup="\nGroup : $text"; - } - elsif ($mode eq 'text') { - return $rpmGroup="\nGroup : $text"; - } - elsif ($mode eq 'make_rpm') { - return <Utilities/System -END - } - else { - return ''; - } -} -# ---------------------------------------------------- Format rpmSource section -sub format_rpmSource { - my $text=$parser->get_text('/rpmSource'); - $parser->get_tag('/rpmSource'); - if ($mode eq 'html') { - return $rpmSource="\nSource : $text"; - } - elsif ($mode eq 'text') { - return $rpmSource="\nSource : $text"; - } - else { - return ''; - } -} -# ----------------------------------------------- Format rpmAutoReqProv section -sub format_rpmAutoReqProv { - my $text=$parser->get_text('/rpmAutoReqProv'); - $parser->get_tag('/rpmAutoReqProv'); - if ($mode eq 'html') { - return $rpmAutoReqProv="\nAutoReqProv : $text"; - } - elsif ($mode eq 'text') { - return $rpmAutoReqProv="\nAutoReqProv : $text"; - } - elsif ($mode eq 'make_rpm') { - return <$text -END - } - else { - return ''; - } -} -# ----------------------------------------------- Format rpmdescription section -sub format_rpmdescription { - my $text=$parser->get_text('/rpmdescription'); - $parser->get_tag('/rpmdescription'); - if ($mode eq 'html') { - $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 ''; - } -} -# ------------------------------------------------------- Format rpmpre section -sub format_rpmpre { - my $text=$parser->get_text('/rpmpre'); - $parser->get_tag('/rpmpre'); - if ($mode eq 'html') { -# 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') { - $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 ''; - } -} -# ---------------------------------------------------- Format directory section -sub format_directory { - my (@tokeninfo)=@_; - $targetdir='';$categoryname='';$description=''; - $parser->get_text('/directory'); - $parser->get_tag('/directory'); - $directory_count++; - $categorycount{$categoryname}++; - if ($mode eq 'html') { - 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 ''; - } -} -# ---------------------------------------------------- Format targetdir section -sub format_targetdir { - my @tokeninfo=@_; - $targetdir=''; - my $text=&trim($parser->get_text('/targetdir')); - if ($text) { - $parser->get_tag('/targetdir'); - $targetdir=$text; - } - return ''; -} # ------------------------------------------------- Format categoryname section sub format_categoryname { my @tokeninfo=@_; @@ -1001,437 +445,30 @@ sub format_categoryname { $parser->get_tag('/categoryname'); $categoryname=$text; } - return ''; -} -# -------------------------------------------------- Format description section -sub format_description { - my @tokeninfo=@_; - $description=''; - my $text=&htmlsafe(&trim($parser->get_text('/description'))); - if ($text) { - $parser->get_tag('/description'); - $description=$text; - } - return ''; + return(''); } + # -------------------------------------------------------- Format files section sub format_files { my $text=$parser->get_text('/files'); $parser->get_tag('/files'); - if (1==1) { - return '# Files'."\n".$text; - } - elsif ($mode eq 'html') { - 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. - "\n".'links:'."\n".join('',@links); - } - elsif ($mode eq 'configinstall') { - return "\n".'configfiles: '. - join(' ',@configall). - "\n\n".$text. - "\n\nalwaysrun:\n\n"; - } - elsif ($mode eq 'build') { - my $binfo; - my $tword; - my $command2; - my @deps; - foreach my $bi (@buildinfo) { - my ($target,$source,$command,$trigger,@deps)=split(/\;/,$bi); - $tword=''; $tword=' alwaysrun' if $trigger eq 'always run'; - 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; - foreach my $dep (@deps) { - unless ($olddep) { - $olddep=$deps[$#deps]; - } - $depstring.="\telif !(test -r $command/$dep);\\\n"; - $depstring.="\t\tthen echo ". - "\"**** WARNING **** missing the file: ". - "$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'$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 -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.\"$logcmd;\\\n". - $depstring. - "\telse \\\n\t\t$command2\n\tfi\n\n"; - $binfo.="${source}___DEPS:\n".$depstring2."\t\tECODE=0;\n\n"; - } - return 'all: '.join(' ',@buildall)."\n\n". - $text. - $binfo."\n". - "alwaysrun:\n\n"; - } - elsif ($mode eq 'rpm_file_list') { - return $text; - } - else { - return ''; - } + return("\n".'# There are '.$file_count.' files this script works on'. + "\n\n".$text); } -# ---------------------------------------------------- Format fileglobs section -sub format_fileglobs { -} -# -------------------------------------------------------- Format links section -# deprecated.. currently 's are included in -sub format_links { - my $text=$parser->get_text('/links'); - $parser->get_tag('/links'); - if ($mode eq 'html') { - return $links="\n
    BEGIN LINKS\n$text\n
    END LINKS\n"; - } - elsif ($mode eq 'install') { - return "\n".'links:'."\n\t".$text; - } - else { - return ''; - } -} # --------------------------------------------------------- Format file section sub format_file { my @tokeninfo=@_; $file=''; $source=''; $target=''; $categoryname=''; $description=''; $note=''; $build=''; $status=''; $dependencies=''; my $text=&trim($parser->get_text('/file')); - my $buildtest; $file_count++; $categorycount{$categoryname}++; - # START TEMP WAY -# if (-T "$sourcerootarg/$source") { -# $linecount{$categoryname}+=`wc -l $sourcerootarg/$source`; -# } -# my $bytesize=(-s "$sourcerootarg/$source"); -# $bytecount{$categoryname}+=$bytesize; - # END TEMP WAY -# if ($source) { - $parser->get_tag('/file'); - if (1==1) { - return "File: $target\n". - "$dependencies\n"; - } - elsif ($mode eq 'html') { - 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) { - my $bi=$sourceroot.'/'.$source.';'.$build.';'. - $dependencies; - my ($source2,$command,$trigger,@deps)=split(/\;/,$bi); - $tword=''; $tword=' alwaysrun' if $trigger eq 'always run'; - $command=~s/\/([^\/]*)$//; - $command2="cd $command; sh ./$1;\\"; - my $depstring; - foreach my $dep (@deps) { - $depstring.=<get_text('/link')); - if ($linkto) { - $parser->get_tag('/link'); - if ($mode eq 'html') { - 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. - "\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 ''; - } - } - return ''; -} -# ----------------------------------------------------- Format fileglob section -sub format_fileglob { - my @tokeninfo=@_; - $fileglob=''; $glob=''; $sourcedir=''; - $targetdir=''; $categoryname=''; $description=''; - $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; - # START TEMP WAY -# for my $f (split(/\;/,$filenames2)) { -# if (-T "$sourcerootarg/$sourcedir/$f") { -# $linecount{$categoryname}+=`wc -l $sourcerootarg/$sourcedir/$f`; -# open OUT,">>/tmp/junk123"; -# print OUT "$linecount{$categoryname} $categoryname $sourcerootarg/$sourcedir/$f\n"; -# close OUT; -# } -# my $bytesize=(-s "$sourcerootarg/$sourcedir/$f"); -# $bytecount{$categoryname}+=$bytesize; -# } - # END TEMP WAY - if ($sourcedir) { - $parser->get_tag('/fileglob'); - if ($mode eq 'html') { - 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.$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 ''; - } - } - return ''; -} -# ---------------------------------------------------- Format sourcedir section -sub format_sourcedir { - my @tokeninfo=@_; - $sourcedir=''; - my $text=&trim($parser->get_text('/sourcedir')); - if ($text) { - $parser->get_tag('/sourcedir'); - $sourcedir=$text; - } - return ''; + $parser->get_tag('/file'); + return("# File: $target\n". + "$text\n"); } + # ------------------------------------------------------- Format target section sub format_target { my @tokeninfo=@_; @@ -1439,26 +476,15 @@ sub format_target { my $text=&trim($parser->get_text('/target')); if ($text) { $parser->get_tag('/target'); - $target=$text; + $target=$targetrootarg.$text; } - return ''; -} -# ------------------------------------------------------- Format source section -sub format_source { - my @tokeninfo=@_; - $source=''; - my $text=&trim($parser->get_text('/source')); - if ($text) { - $parser->get_tag('/source'); - $source=$text; - } - return ''; + return(''); } + # --------------------------------------------------------- Format note section sub format_note { my @tokeninfo=@_; $note=''; -# my $text=&trim($parser->get_text('/note')); my $aref; my $text; while ($aref=$parser->get_token()) { @@ -1476,45 +502,11 @@ sub format_note { } } if ($text) { -# $parser->get_tag('/note'); $note=$text; } - return ''; - -} -# -------------------------------------------------------- Format build section -sub format_build { - my @tokeninfo=@_; - $build=''; - my $text=&trim($parser->get_text('/build')); - if ($text) { - $parser->get_tag('/build'); - $build=$sourceroot.'/'.$text.';'.$tokeninfo[2]{'trigger'}; - } - return ''; -} -# -------------------------------------------------------- Format build section -sub format_buildlink { - my @tokeninfo=@_; - $buildlink=''; - my $text=&trim($parser->get_text('/buildlink')); - if ($text) { - $parser->get_tag('/buildlink'); - $buildlink=$sourceroot.'/'.$text; - } - return ''; -} -# ------------------------------------------------------- Format status section -sub format_status { - my @tokeninfo=@_; - $status=''; - my $text=&trim($parser->get_text('/status')); - if ($text) { - $parser->get_tag('/status'); - $status=$text; - } - return ''; + return(''); } + # ------------------------------------------------- Format dependencies section sub format_dependencies { my @tokeninfo=@_; @@ -1525,67 +517,42 @@ sub format_dependencies { $dependencies=join(';', (map {s/^\s*//;s/\s$//;$_} split(/\;/,$text))); } - return ''; -} -# --------------------------------------------------------- Format glob section -sub format_glob { - my @tokeninfo=@_; - $glob=''; - my $text=&trim($parser->get_text('/glob')); - if ($text) { - $parser->get_tag('/glob'); - $glob=$text; - } - return ''; -} -# ---------------------------------------------------- Format filenames section -sub format_filenames { - my @tokeninfo=@_; - my $text=&trim($parser->get_text('/filenames')); - if ($text) { - $parser->get_tag('/filenames'); - $filenames=$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 ''; -} -# ------------------------------------------------------- Format linkto section -sub format_linkto { - my @tokeninfo=@_; - my $text=&trim($parser->get_text('/linkto')); - if ($text) { - $parser->get_tag('/linkto'); - $linkto=$text; - } - 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=Linux Packaging Markup Language. +See piml.dtd. PIML=Post Installation Markup Language. =head1 SYNOPSIS @@ -1593,26 +560,18 @@ Usage is for piml file to come in throug =over 4 -=item * - -1st argument is the mode of parsing. - =item * -2nd argument is the category permissions to use (runtime or development) +1st argument is the category permissions to use (runtime or development) =item * -3rd argument is the distribution -(default,redhat6.2,debian2.2,redhat7.1,etc). +2nd argument is the distribution +(default,redhat6,debian2.2,redhat7,etc). =item * -4th argument is to manually specify a sourceroot. - -=item * - -5th argument is to manually specify a targetroot. +3rd argument is to manually specify a targetroot. =back @@ -1621,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 @@ -1649,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