--- loncom/build/lpml_parse.pl 2001/06/24 23:00:32 1.3 +++ loncom/build/lpml_parse.pl 2001/09/08 17:45:09 1.5 @@ -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,7 +177,7 @@ while ($token = $parser->get_token()) { } } $cleanstring=&trim($cleanstring); - +$cleanstring=~s/\s*\n\s*//g; # ---------------------------------------------------- Start final pass through # storage variables @@ -181,6 +224,8 @@ my $command; my $status; my $dependencies; my $dependency; +my @links; +my %categoryhash; # Make new parser with distribution specific input undef $parser; @@ -217,6 +262,7 @@ $parser->{textify}={ files => \&format_files, file => \&format_file, fileglob => \&format_fileglob, + links => \&format_links, link => \&format_link, linkto => \&format_linkto, source => \&format_source, @@ -242,7 +288,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(); @@ -253,6 +299,9 @@ sub end { if ($mode eq 'html') { return "THE END\n"; } + if ($mode eq 'install') { + return ''; + } } # ----------------------- Take in string to parse and the separation expression @@ -269,6 +318,15 @@ sub format_lpml { if ($mode eq 'html') { $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; + } + else { + return ''; + } } # --------------------------------------------------- Format targetroot section sub format_targetroot { @@ -278,6 +336,9 @@ sub format_targetroot { if ($mode eq 'html') { return $targetroot="\nTARGETROOT: $text"; } + elsif ($mode eq 'install') { + return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n"; + } else { return ''; } @@ -290,6 +351,9 @@ sub format_sourceroot { if ($mode eq 'html') { return $sourceroot="\nSOURCEROOT: $text"; } + elsif ($mode eq 'install') { + return '# SOURCE CODE LOCATION IS "'.$sourceroot."\"\n";; + } else { return ''; } @@ -318,6 +382,11 @@ sub format_category { "$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 ''; } } @@ -488,11 +557,14 @@ 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"; } + elsif ($mode eq 'install') { + return "\n".'directories:'."\n".$text; + } else { return ''; } @@ -506,6 +578,10 @@ sub format_directory { if ($mode eq 'html') { return $directory="\nDIRECTORY $targetdir $categoryname $description"; } + elsif ($mode eq 'install') { + return "\t".'install '.$categoryhash{$categoryname}.' -d /'. + $targetroot.$targetdir."\n"; + } else { return ''; } @@ -545,11 +621,15 @@ 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"; } + elsif ($mode eq 'install') { + return "\n".'files:'."\n".$text. + "\n".'links:'."\n".join('',@links); + } else { return ''; } @@ -559,8 +639,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="\nBEGIN LINKS\n$text\nEND LINKS\n"; + } + elsif ($mode eq 'install') { + return "\n".'links:'."\n\t".$text; + } + else { + return ''; + } } # --------------------------------------------------------- Format file section sub format_file { @@ -576,6 +667,16 @@ sub format_file { "$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"; + } else { return ''; } @@ -596,6 +697,14 @@ sub format_link { "$build $status $dependencies" . "\nEND LINK"; } + elsif ($mode eq 'install') { + my @targets=split(/\;/,$target); + foreach my $tgt (@targets) { + push @links,"\t".'ln -fs /'.$linkto.' /'.$targetroot.$tgt. + "\n"; + } + return ''; + } else { return ''; } @@ -618,6 +727,12 @@ sub format_fileglob { "$build $status $dependencies $filenames" . "\nEND FILEGLOB"; } + elsif ($mode eq 'install') { + return "\t".'install '. + $categoryhash{$categoryname}.' '. + $sourceroot.'/'.$sourcedir.$glob.' '. + $targetroot.'/'.$targetdir.'.'."\n"; + } else { return ''; } @@ -716,7 +831,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 +841,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');