--- loncom/build/lpml_parse.pl 2001/06/24 23:00:32 1.3 +++ loncom/build/lpml_parse.pl 2001/09/17 20:44:38 1.11 @@ -1,12 +1,30 @@ #!/usr/bin/perl # Scott Harrison +# YEAR=2001 # May 2001 # 06/19/2001,06/20,06/24 - Scott Harrison +# 9/5/2001,9/6,9/7,9/8 - Scott Harrison +############################################################################### +## ## +## ORGANIZATION OF THIS PERL SCRIPT ## +## 1. Notes ## +## 2. Get command line arguments ## +## 3. First pass through (grab distribution-specific information) ## +## 4. Second pass through (parse out what is not necessary) ## +## 5. Third pass through (translate markup according to specified mode) ## +## ## +############################################################################### + +# ----------------------------------------------------------------------- Notes +# # 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. +# +# This is meant to parse files meeting the lpml document type. +# See lpml.dtd. LPML=Linux Packaging Markup Language. use HTML::TokeParser; @@ -14,9 +32,10 @@ my $usage=<){} # throw away the input to avoid broken pipes print $usage; exit -1; # exit with error status } +my $categorytype; +if (@ARGV) { + $categorytype = shift @ARGV; +} + my $dist; if (@ARGV) { $dist = shift @ARGV; @@ -46,10 +71,25 @@ if (@ARGV) { my $targetroot; my $sourceroot; if (@ARGV) { - $targetroot = shift @ARGV; + $sourceroot = shift @ARGV; } if (@ARGV) { - $sourceroot = shift @ARGV; + $targetroot = shift @ARGV; +} +$sourceroot=~s/\/$//; +$targetroot=~s/\/$//; + +my $invocation; +# --------------------------------------------------- Record program invocation +if ($mode eq 'install') { + $invocation=(<get_token()) { $hierarchy[$hloc]++; $key=$token->[1].join(',',@hierarchy[0..($hloc-1)]); my $thisdist=' '.$token->[2]{'dist'}.' '; + # This conditional clause is set up to ignore two sets + # of invalid conditions before accepting entry into + # the cleanstring. if ($hash{$key}==2 and !($thisdist eq ' ' or $thisdist =~/\s$dist\s/)) { if ($token->[4]!~/\/>$/) { @@ -134,6 +177,7 @@ while ($token = $parser->get_token()) { } } $cleanstring=&trim($cleanstring); +$cleanstring=~s/\>\s*\n\s*\\{textify}={ files => \&format_files, file => \&format_file, fileglob => \&format_fileglob, + links => \&format_links, link => \&format_link, linkto => \&format_linkto, source => \&format_source, @@ -242,7 +291,7 @@ while ($token = $parser->get_tag('lpml') $token = $parser->get_tag('/lpml'); print $lpml; print "\n"; - $text=~s/\s*\n\s*\n\s*/\n/g; +# $text=~s/\s*\n\s*\n\s*/\n/g; print $text; print "\n"; print &end(); @@ -251,7 +300,10 @@ exit; sub end { if ($mode eq 'html') { - return "THE END\n"; + return "
THE END\n"; + } + if ($mode eq 'install') { + return ''; } } @@ -267,7 +319,22 @@ sub format_lpml { my (@tokeninfo)=@_; my $date=`date`; chop $date; if ($mode eq 'html') { - $lpml = "LPML BEGINNING: $date"; + $lpml = "
LPML BEGINNING: $date"; + } + elsif ($mode eq 'install') { + print '# LPML install targets. Linux Packaging Markup Language,'; + print ' by Scott Harrison 2001'."\n"; + print '# This file was automatically generated on '.`date`; + print "\n".$invocation; + } + elsif ($mode eq 'build') { + $lpml = "# Dynamic Makefile generated by LON-CAPA build process\n"; + $lpml .= '# This file was automatically generated on '.`date`; + $lpml .= "\n"; + $lpml .= "SHELL=\"/bin/sh\"\n\n"; + } + else { + return ''; } } # --------------------------------------------------- Format targetroot section @@ -276,7 +343,13 @@ sub format_targetroot { $text=$targetroot if $targetroot; $parser->get_tag('/targetroot'); if ($mode eq 'html') { - return $targetroot="\nTARGETROOT: $text"; + return $targetroot="\n
TARGETROOT: $text"; + } + elsif ($mode eq 'install') { + return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n"; + } + elsif ($mode eq 'build') { + return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n"; } else { return ''; @@ -288,7 +361,13 @@ sub format_sourceroot { $text=$sourceroot if $sourceroot; $parser->get_tag('/sourceroot'); if ($mode eq 'html') { - return $sourceroot="\nSOURCEROOT: $text"; + return $sourceroot="\n
SOURCEROOT: $text"; + } + elsif ($mode eq 'install') { + return '# SOURCE CODE LOCATION IS "'.$sourceroot."\"\n";; + } + elsif ($mode eq 'build') { + return '# SOURCE CODE LOCATION IS "'.$sourceroot."\"\n";; } else { return ''; @@ -299,7 +378,8 @@ sub format_categories { my $text=&trim($parser->get_text('/categories')); $parser->get_tag('/categories'); if ($mode eq 'html') { - return $categories="\nBEGIN CATEGORIES\n$text\nEND CATEGORIES\n"; + return $categories="\n
BEGIN CATEGORIES\n$text\n". + "
END CATEGORIES\n"; } else { return ''; @@ -314,10 +394,15 @@ sub format_category { $parser->get_text('/category'); $parser->get_tag('/category'); if ($mode eq 'html') { - return $category="\nCATEGORY $category_att_name $category_att_type ". - "$chmod $chown"; + 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 ''; } } @@ -348,7 +433,7 @@ sub format_rpm { my $text=&trim($parser->get_text('/rpm')); $parser->get_tag('/rpm'); if ($mode eq 'html') { - return $rpm="\nBEGIN RPM\n$text\nEND RPM"; + return $rpm="\n
BEGIN RPM\n$text\n
END RPM"; } else { return ''; @@ -359,7 +444,7 @@ sub format_rpmSummary { my $text=&trim($parser->get_text('/rpmSummary')); $parser->get_tag('/rpmSummary'); if ($mode eq 'html') { - return $rpmSummary="\nRPMSUMMARY $text"; + return $rpmSummary="\n
RPMSUMMARY $text"; } else { return ''; @@ -370,7 +455,7 @@ sub format_rpmName { my $text=&trim($parser->get_text('/rpmName')); $parser->get_tag('/rpmName'); if ($mode eq 'html') { - return $rpmName="\nRPMNAME $text"; + return $rpmName="\n
RPMNAME $text"; } else { return ''; @@ -381,7 +466,7 @@ sub format_rpmVersion { my $text=$parser->get_text('/rpmVersion'); $parser->get_tag('/rpmVersion'); if ($mode eq 'html') { - return $rpmVersion="\nRPMVERSION $text"; + return $rpmVersion="\n
RPMVERSION $text"; } else { return ''; @@ -392,7 +477,7 @@ sub format_rpmRelease { my $text=$parser->get_text('/rpmRelease'); $parser->get_tag('/rpmRelease'); if ($mode eq 'html') { - return $rpmRelease="\nRPMRELEASE $text"; + return $rpmRelease="\n
RPMRELEASE $text"; } else { return ''; @@ -403,7 +488,7 @@ sub format_rpmVendor { my $text=$parser->get_text('/rpmVendor'); $parser->get_tag('/rpmVendor'); if ($mode eq 'html') { - return $rpmVendor="\nRPMVENDOR $text"; + return $rpmVendor="\n
RPMVENDOR $text"; } else { return ''; @@ -414,7 +499,7 @@ sub format_rpmBuildRoot { my $text=$parser->get_text('/rpmBuildRoot'); $parser->get_tag('/rpmBuildRoot'); if ($mode eq 'html') { - return $rpmBuildRoot="\nRPMBUILDROOT $text"; + return $rpmBuildRoot="\n
RPMBUILDROOT $text"; } else { return ''; @@ -425,7 +510,7 @@ sub format_rpmCopyright { my $text=$parser->get_text('/rpmCopyright'); $parser->get_tag('/rpmCopyright'); if ($mode eq 'html') { - return $rpmCopyright="\nRPMCOPYRIGHT $text"; + return $rpmCopyright="\n
RPMCOPYRIGHT $text"; } else { return ''; @@ -436,7 +521,7 @@ sub format_rpmGroup { my $text=$parser->get_text('/rpmGroup'); $parser->get_tag('/rpmGroup'); if ($mode eq 'html') { - return $rpmGroup="\nRPMGROUP $text"; + return $rpmGroup="\n
RPMGROUP $text"; } else { return ''; @@ -447,7 +532,7 @@ sub format_rpmSource { my $text=$parser->get_text('/rpmSource'); $parser->get_tag('/rpmSource'); if ($mode eq 'html') { - return $rpmSource="\nRPMSOURCE $text"; + return $rpmSource="\n
RPMSOURCE $text"; } else { return ''; @@ -458,7 +543,7 @@ sub format_rpmAutoReqProv { my $text=$parser->get_text('/rpmAutoReqProv'); $parser->get_tag('/rpmAutoReqProv'); if ($mode eq 'html') { - return $rpmAutoReqProv="\nRPMAUTOREQPROV $text"; + return $rpmAutoReqProv="\n
RPMAUTOREQPROV $text"; } else { return ''; @@ -469,7 +554,7 @@ sub format_rpmdescription { my $text=$parser->get_text('/rpmdescription'); $parser->get_tag('/rpmdescription'); if ($mode eq 'html') { - return $rpmdescription="\nRPMDESCRIPTION $text"; + return $rpmdescription="\n
RPMDESCRIPTION $text"; } else { return ''; @@ -480,7 +565,7 @@ sub format_rpmpre { my $text=$parser->get_text('/rpmpre'); $parser->get_tag('/rpmpre'); if ($mode eq 'html') { - return $rpmpre="\nRPMPRE $text"; + return $rpmpre="\n
RPMPRE $text"; } else { return ''; @@ -488,11 +573,15 @@ sub format_rpmpre { } # -------------------------------------------------- Format directories section sub format_directories { - my $text=&trim($parser->get_text('/directories')); + my $text=$parser->get_text('/directories'); $parser->get_tag('/directories'); if ($mode eq 'html') { - return $directories="\nBEGIN DIRECTORIES\n$text\nEND DIRECTORIES\n"; + return $directories="\n
BEGIN DIRECTORIES\n$text\n
". + "END DIRECTORIES\n"; } + elsif ($mode eq 'install') { + return "\n".'directories:'."\n".$text; + } else { return ''; } @@ -504,7 +593,12 @@ sub format_directory { $parser->get_text('/directory'); $parser->get_tag('/directory'); if ($mode eq 'html') { - return $directory="\nDIRECTORY $targetdir $categoryname $description"; + return $directory="\n
DIRECTORY $targetdir $categoryname ". + "$description"; + } + elsif ($mode eq 'install') { + return "\t".'install '.$categoryhash{$categoryname}.' -d '. + $targetroot.'/'.$targetdir."\n"; } else { return ''; @@ -536,7 +630,7 @@ sub format_categoryname { sub format_description { my @tokeninfo=@_; $description=''; - my $text=&trim($parser->get_text('/description')); + my $text=&htmlsafe(&trim($parser->get_text('/description'))); if ($text) { $parser->get_tag('/description'); $description=$text; @@ -545,10 +639,43 @@ sub format_description { } # -------------------------------------------------------- Format files section sub format_files { - my $text=&trim($parser->get_text('/files')); + my $text=$parser->get_text('/files'); $parser->get_tag('/files'); if ($mode eq 'html') { - return $directories="\nBEGIN FILES\n$text\nEND FILES\n"; + return $directories="\n
BEGIN FILES\n$text\n
END FILES\n"; + } + elsif ($mode eq 'install') { + return "\n".'files:'."\n".$text. + "\n".'links:'."\n".join('',@links); + } + elsif ($mode eq 'build') { + my $binfo; + my $tword; + my $command2; + my @deps; + foreach my $bi (@buildinfo) { + my ($source,$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.="\telif !(test -r $command/$dep);\\\n"; + $depstring.="\t\tthen echo ". + "\"**** LON-CAPA WARNING **** missing the file: ". + "$command/$dep\";\\\n"; + } + $binfo.="$source: $tword\n". + "\t\@if !(echo \"\");\\\n\t\tthen echo ". + "\"**** LON-CAPA WARNING **** Strange shell. ". + "Check your path settings.\";\\\n". + $depstring. + "\telse \\\n\t\t$command2\n\tfi\n\n"; + } + return 'all: '.join(' ',@buildall)."\n\n". + $text. + $binfo."\n". + "alwaysrun:\n\n"; } else { return ''; @@ -559,8 +686,19 @@ 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 { @@ -571,11 +709,27 @@ sub format_file { if ($source) { $parser->get_tag('/file'); if ($mode eq 'html') { - return ($file="\nBEGIN FILE\n". + return ($file="\n
BEGIN FILE\n". "$source $target $categoryname $description $note " . "$build $status $dependencies" . "\nEND FILE"); } + elsif ($mode eq 'install' && $categoryname ne 'conf') { + return "\t".'@test -e '.$sourceroot.'/'.$source. + ' && install '. + $categoryhash{$categoryname}.' '. + $sourceroot.'/'.$source.' '. + $targetroot.'/'.$target. + ' || echo "**** LON-CAPA WARNING '. + '**** CVS source file does not exist: '.$sourceroot.'/'. + $source.'"'."\n"; + } + elsif ($mode eq 'build' && $build) { + push @buildall,$sourceroot.'/'.$source; + push @buildinfo,$sourceroot.'/'.$source.';'.$build.';'. + $dependencies; +# return '# need to build '.$source."; + } else { return ''; } @@ -591,11 +745,19 @@ sub format_link { if ($linkto) { $parser->get_tag('/link'); if ($mode eq 'html') { - return $link="\nBEGIN LINK\n". + return $link="\n
BEGIN 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 ''; + } else { return ''; } @@ -613,11 +775,17 @@ sub format_fileglob { if ($sourcedir) { $parser->get_tag('/fileglob'); if ($mode eq 'html') { - return $fileglob="\nBEGIN FILEGLOB\n". + return $fileglob="\n
BEGIN FILEGLOB\n". "$glob sourcedir $targetdir $categoryname $description $note ". "$build $status $dependencies $filenames" . "\nEND FILEGLOB"; } + elsif ($mode eq 'install') { + return "\t".'install '. + $categoryhash{$categoryname}.' '. + $sourceroot.'/'.$sourcedir.'[^CVS]'.$glob.' '. + $targetroot.'/'.$targetdir.'.'."\n"; + } else { return ''; } @@ -676,7 +844,7 @@ sub format_build { my $text=&trim($parser->get_text('/build')); if ($text) { $parser->get_tag('/build'); - $build=$text; + $build=$sourceroot.'/'.$text.';'.$tokeninfo[2]{'trigger'}; } return ''; } @@ -698,7 +866,8 @@ sub format_dependencies { my $text=&trim($parser->get_text('/dependencies')); if ($text) { $parser->get_tag('/dependencies'); - $dependencies=$text; + $dependencies=join(';', + (map {s/^\s*//;s/\s$//;$_} split(/\;/,$text))); } return ''; } @@ -716,7 +885,6 @@ sub format_glob { # ---------------------------------------------------- Format filenames section sub format_filenames { my @tokeninfo=@_; - $glob=''; my $text=&trim($parser->get_text('/filenames')); if ($text) { $parser->get_tag('/filenames'); @@ -727,7 +895,6 @@ sub format_filenames { # ------------------------------------------------------- Format linkto section sub format_linkto { my @tokeninfo=@_; - $glob=''; my $text=&trim($parser->get_text('/linkto')); if ($text) { $parser->get_tag('/linkto'); @@ -735,6 +902,13 @@ sub format_linkto { } return ''; } +# ------------------------------------- Render less-than and greater-than signs +sub htmlsafe { + my $text=@_[0]; + $text =~ s//>/g; + return $text; +} # --------------------------------------- remove starting and ending whitespace sub trim { my ($s)=@_; $s=~s/^\s*//; $s=~s/\s*$//; return $s;