version 1.7, 2001/09/08 22:47:38
|
version 1.62, 2020/10/07 19:55:39
|
Line 1
|
Line 1
|
#!/usr/bin/perl |
#!/usr/bin/perl |
|
|
# Scott Harrison |
# -------------------------------------------------------- Documentation notice |
|
# Run "perldoc ./lpml_parse.pl" in order to best view the software |
|
# documentation internalized in this program. |
|
|
|
# --------------------------------------------------------- Distribution notice |
|
# This script is distributed with the LPML software project available at |
|
# http://lpml.sourceforge.net |
|
|
|
# --------------------------------------------------------- License Information |
|
# The LearningOnline Network with CAPA |
|
# lpml_parse.pl - Linux Packaging Markup Language parser |
|
# |
|
# $Id$ |
|
# |
|
# 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 |
# YEAR=2001 |
# May 2001 |
# May 2001 |
# 06/19/2001,06/20,06/24 - Scott Harrison |
# 06/19/2001,06/20,06/24 - Scott Harrison |
# 9/5/2001,9/6,9/7,9/8 - Scott Harrison |
# 9/5/2001,9/6,9/7,9/8 - Scott Harrison |
|
# 9/17,9/18 - 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,4/12 - Scott Harrison |
|
# 4/21,4/26,5/19,5/23,10/13 - Scott Harrison |
|
# |
|
### |
|
|
############################################################################### |
############################################################################### |
## ## |
## ## |
Line 14
|
Line 59
|
## 3. First pass through (grab distribution-specific information) ## |
## 3. First pass through (grab distribution-specific information) ## |
## 4. Second pass through (parse out what is not necessary) ## |
## 4. Second pass through (parse out what is not necessary) ## |
## 5. Third pass through (translate markup according to specified mode) ## |
## 5. Third pass through (translate markup according to specified mode) ## |
|
## 6. Functions (most all just format contents of different markup tags) ## |
|
## 7. POD (plain old documentation, CPAN style) ## |
## ## |
## ## |
############################################################################### |
############################################################################### |
|
|
Line 31 use HTML::TokeParser;
|
Line 78 use HTML::TokeParser;
|
my $usage=<<END; |
my $usage=<<END; |
**** ERROR ERROR ERROR ERROR **** |
**** ERROR ERROR ERROR ERROR **** |
Usage is for lpml file to come in through standard input. |
Usage is for lpml file to come in through standard input. |
1st argument is the mode of parsing. |
1st argument is the mode of parsing: |
2nd argument is the category permissions to use (runtime or development) |
install,configinstall,build,rpm,dpkg,htmldoc,textdoc,status |
3rd argument is the distribution (default,redhat6.2,debian2.2,redhat7.1,etc). |
2nd argument is the category permissions to use: |
|
typical choices: runtime,development |
|
3rd argument is the distribution: |
|
typical choices: default,redhat6.2,debian2.2,redhat7 |
4th argument is to manually specify a sourceroot. |
4th argument is to manually specify a sourceroot. |
5th argument is to manually specify a targetroot. |
5th argument is to manually specify a targetroot. |
|
6th argument is to manually specify a shell. |
|
|
Only the 1st argument is mandatory for the program to run. |
Only the 1st argument is mandatory for the program to run. |
|
|
Example: |
Example: |
|
|
cat ../../doc/loncapafiles.lpml |\\ |
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 |
|
|
|
For more information, type "perldoc lpml_parse.pl". |
END |
END |
|
|
# ------------------------------------------------- Grab command line arguments |
# ------------------------------------------------- Grab command line arguments |
|
|
my $mode; |
my $mode=''; |
if (@ARGV==5) { |
if (@ARGV == 6 || @ARGV == 5) { |
$mode = shift @ARGV; |
$mode = shift @ARGV; |
} |
} |
else { |
else { |
Line 58 else {
|
Line 111 else {
|
exit -1; # exit with error status |
exit -1; # exit with error status |
} |
} |
|
|
my $categorytype; |
my $categorytype=''; |
if (@ARGV) { |
if (@ARGV) { |
$categorytype = shift @ARGV; |
$categorytype = shift @ARGV; |
} |
} |
|
|
my $dist; |
my $dist=''; |
if (@ARGV) { |
if (@ARGV) { |
$dist = shift @ARGV; |
$dist = shift @ARGV; |
} |
} |
|
|
my $targetroot; |
my $targetroot=''; |
my $sourceroot; |
my $sourceroot=''; |
|
my $targetrootarg=''; |
|
my $sourcerootarg=''; |
if (@ARGV) { |
if (@ARGV) { |
$sourceroot = shift @ARGV; |
$sourceroot = shift @ARGV; |
} |
} |
if (@ARGV) { |
if (@ARGV) { |
$targetroot = shift @ARGV; |
$targetroot = shift @ARGV; |
} |
} |
$sourceroot=~s/\/$//; |
$sourceroot=~s/\/$//; # remove trailing directory slash |
$targetroot=~s/\/$//; |
$targetroot=~s/\/$//; # remove trailing directory slash |
|
$sourcerootarg=$sourceroot; |
|
$targetrootarg=$targetroot; |
|
|
|
my $shell = 'sh'; |
|
if (@ARGV) { |
|
$shell = shift @ARGV; |
|
} |
|
|
my $invocation; |
my $logcmd='| tee -a WARNINGS'; |
|
|
|
my $invocation; # Record how the program was invoked |
# --------------------------------------------------- Record program invocation |
# --------------------------------------------------- Record program invocation |
if ($mode eq 'install') { |
if ($mode eq 'install' or $mode eq 'configinstall' or $mode eq 'build') { |
$invocation=(<<END); |
$invocation=(<<END); |
# Invocation: STDINPUT | lpml_parse.pl |
# Invocation: STDINPUT | lpml_parse.pl |
# 1st argument (mode) is: $mode |
# 1st argument (mode) is: $mode |
# 2nd argument (category type) is: $categorytype |
# 2nd argument (category type) is: $categorytype |
# 3rd argument (distribution) is: $dist |
# 3rd argument (distribution) is: $dist |
# 4th argument (targetroot) is: described below |
# 4th argument (sourceroot) is: described below |
# 5th argument (sourceroot) is: described below |
# 5th argument (targetroot) is: described below |
|
# 6th argument (shell) is: $shell |
END |
END |
} |
} |
|
|
# ---------------------------------------------------- Start first pass through |
# -------------------------- Start first pass through (just gather information) |
my @parsecontents = <>; |
my @parsecontents=<>; |
my $parsestring = join('',@parsecontents); |
my $parsestring=join('',@parsecontents); |
my $outstring; |
|
|
|
# Need to make a pass through and figure out what defaults are |
# Need to make a pass through and figure out what defaults are |
# overrided. Top-down overriding strategy (leaves don't know |
# overrided. Top-down overriding strategy (tree leaves don't know |
# about distant leaves). |
# about distant tree leaves). |
|
|
my @hierarchy; |
my @hierarchy; |
$hierarchy[0]=0; |
$hierarchy[0]=0; |
Line 108 my $token;
|
Line 172 my $token;
|
$parser = HTML::TokeParser->new(\$parsestring) or |
$parser = HTML::TokeParser->new(\$parsestring) or |
die('can\'t create TokeParser object'); |
die('can\'t create TokeParser object'); |
$parser->xml_mode('1'); |
$parser->xml_mode('1'); |
my %hash; |
my %setting; |
my $key; |
|
while ($token = $parser->get_token()) { |
# Values for the %setting hash |
|
my $defaultset=1; # a default setting exists for a key |
|
my $distset=2; # a distribution setting exists for a key |
|
# (overrides default setting) |
|
|
|
my $key=''; # this is a unique key identifier (the token name with its |
|
# coordinates inside the hierarchy) |
|
while ($token = $parser->get_token()) { # navigate through $parsestring |
if ($token->[0] eq 'S') { |
if ($token->[0] eq 'S') { |
$hloc++; |
$hloc++; |
$hierarchy[$hloc]++; |
$hierarchy[$hloc]++; |
$key=$token->[1].join(',',@hierarchy[0..($hloc-1)]); |
$key=$token->[1].join(',',@hierarchy[0..($hloc-1)]); |
my $thisdist=' '.$token->[2]{'dist'}.' '; |
my $thisdist=' '.$token->[2]{'dist'}.' '; |
if ($thisdist eq ' default ') { |
if ($thisdist eq ' default ') { |
$hash{$key}=1; # there is a default setting for this key |
$setting{$key}=$defaultset; |
} |
} |
elsif ($dist && $hash{$key}==1 && $thisdist=~/\s$dist\s/) { |
elsif (length($dist)>0 && |
$hash{$key}=2; # disregard default setting for this key if |
$setting{$key}==$defaultset && |
# there is a directly requested distribution match |
$thisdist=~/\s$dist\s/) { |
|
$setting{$key}=$distset; |
|
# disregard default setting for this key if |
|
# there is a directly requested distribution match |
|
# (in other words, there must first be a default |
|
# setting for a key in order for it to be overridden) |
} |
} |
} |
} |
if ($token->[0] eq 'E') { |
if ($token->[0] eq 'E') { |
Line 129 while ($token = $parser->get_token()) {
|
Line 205 while ($token = $parser->get_token()) {
|
} |
} |
} |
} |
|
|
# --------------------------------------------------- Start second pass through |
# - Start second pass through (clean up the string to allow for easy rendering) |
undef $hloc; |
|
undef @hierarchy; |
# The string is cleaned up so that there is no white-space surrounding any |
undef $parser; |
# XML tag. White-space inside text 'T' elements is preserved. |
$hierarchy[0]=0; |
|
|
# Clear up memory |
|
undef($hloc); |
|
undef(@hierarchy); |
|
undef($parser); |
|
$hierarchy[0]=0; # initialize hierarchy |
$parser = HTML::TokeParser->new(\$parsestring) or |
$parser = HTML::TokeParser->new(\$parsestring) or |
die('can\'t create TokeParser object'); |
die('can\'t create TokeParser object'); |
$parser->xml_mode('1'); |
$parser->xml_mode('1'); |
my $cleanstring; |
my $cleanstring; # contains the output of the second step |
while ($token = $parser->get_token()) { |
while ($token = $parser->get_token()) { # navigate through $parsestring |
if ($token->[0] eq 'S') { |
if ($token->[0] eq 'S') { # a start tag |
$hloc++; |
$hloc++; |
$hierarchy[$hloc]++; |
$hierarchy[$hloc]++; |
$key=$token->[1].join(',',@hierarchy[0..($hloc-1)]); |
$key=$token->[1].join(',',@hierarchy[0..($hloc-1)]); |
my $thisdist=' '.$token->[2]{'dist'}.' '; |
|
|
# Surround tagdist (the dist attribute of an XML tag) |
|
# with white-space to allow for uniform searching a few |
|
# lines below here. |
|
my $tagdist=' '.$token->[2]{'dist'}.' '; |
|
|
# This conditional clause is set up to ignore two sets |
# This conditional clause is set up to ignore two sets |
# of invalid conditions before accepting entry into |
# of invalid conditions before accepting entry into |
# the cleanstring. |
# $cleanstring. |
if ($hash{$key}==2 and |
|
!($thisdist eq ' ' or $thisdist =~/\s$dist\s/)) { |
# Condition #1: Ignore this part of the string if the tag |
|
# has a superior distribution-specific setting and the tag |
|
# being evaluated has a dist setting something other than |
|
# blank or $dist. |
|
if ($setting{$key}==$distset and |
|
!($tagdist eq ' ' or $tagdist =~/\s$dist\s/)) { |
if ($token->[4]!~/\/>$/) { |
if ($token->[4]!~/\/>$/) { |
$parser->get_tag('/'.$token->[1]); |
$parser->get_tag('/'.$token->[1]); |
$hloc--; |
$hloc--; |
} |
} |
} |
} |
elsif ($thisdist ne ' ' and $thisdist!~/\s$dist\s/ and |
# Condition #2: Ignore this part of the string if the tag has |
!($thisdist eq ' default ' and $hash{$key}!=2)) { |
# is not blank and does not equal dist and |
|
# either does not equal default or it has a prior $dist-specific |
|
# setting. |
|
elsif ($tagdist ne ' ' and $tagdist!~/\s$dist\s/ and |
|
!($tagdist eq ' default ' and $setting{$key}!=$distset)) { |
if ($token->[4]!~/\/>$/) { |
if ($token->[4]!~/\/>$/) { |
$parser->get_tag('/'.$token->[1]); |
$parser->get_tag('/'.$token->[1]); |
$hloc--; |
$hloc--; |
} |
} |
} |
} |
|
# In other words, output to $cleanstring if the tag is dist=default |
|
# or if the tag is set to dist=$dist for the first time. And, always |
|
# output when dist='' is not present. |
else { |
else { |
$cleanstring.=$token->[4]; |
$cleanstring.=$token->[4]; |
} |
} |
if ($token->[4]=~/\/>$/) { |
|
$hloc--; |
|
} |
|
} |
} |
if ($token->[0] eq 'E') { |
# Note: this loop DOES work with <tag /> style markup as well as |
|
# <tag></tag> style markup since I always check for $token->[4] ending |
|
# with "/>". |
|
if ($token->[0] eq 'E') { # an end tag |
$cleanstring.=$token->[2]; |
$cleanstring.=$token->[2]; |
$hloc--; |
$hloc--; |
} |
} |
if ($token->[0] eq 'T') { |
if ($token->[0] eq 'T') { # text contents inside tags |
$cleanstring.=$token->[1]; |
$cleanstring.=$token->[1]; |
} |
} |
} |
} |
$cleanstring=&trim($cleanstring); |
$cleanstring=&trim($cleanstring); |
$cleanstring=~s/\s*\n\s*//g; |
$cleanstring=~s/\>\s*\n\s*\</\>\</g; |
# ---------------------------------------------------- Start final pass through |
|
|
# -------------------------------------------- Start final (third) pass through |
|
|
# storage variables |
# storage variables |
my $lpml; |
my $lpml; |
my $categories; |
my $categories; |
|
my @categorynamelist; |
my $category; |
my $category; |
my $category_att_name; |
my $category_att_name; |
my $category_att_type; |
my $category_att_type; |
my $chown; |
my $chown; |
my $chmod; |
my $chmod; |
|
my $abbreviation; # space-free abbreviation; esp. for image names |
my $rpm; |
my $rpm; |
my $rpmSummary; |
my $rpmSummary; |
my $rpmName; |
my $rpmName; |
Line 205 my $directories;
|
Line 306 my $directories;
|
my $directory; |
my $directory; |
my $targetdirs; |
my $targetdirs; |
my $targetdir; |
my $targetdir; |
|
my $protectionlevel; |
my $categoryname; |
my $categoryname; |
my $description; |
my $description; |
my $files; |
my $files; |
Line 218 my $targets;
|
Line 320 my $targets;
|
my $target; |
my $target; |
my $source; |
my $source; |
my $note; |
my $note; |
|
my $installscript; |
my $build; |
my $build; |
|
my $buildlink; |
my $commands; |
my $commands; |
my $command; |
my $command; |
my $status; |
my $status; |
Line 226 my $dependencies;
|
Line 330 my $dependencies;
|
my $dependency; |
my $dependency; |
my @links; |
my @links; |
my %categoryhash; |
my %categoryhash; |
|
my $dpathlength; |
|
my %fab; # file category abbreviation |
|
my $directory_count; |
|
my $file_count; |
|
my $link_count; |
|
my $fileglob_count; |
|
my $fileglobnames_count; |
|
my %categorycount; |
|
|
|
my @buildall; |
|
my @buildinfo; |
|
|
|
my @configall; |
|
|
# Make new parser with distribution specific input |
# Make new parser with distribution specific input |
undef $parser; |
undef $parser; |
Line 234 $parser = HTML::TokeParser->new(\$cleans
|
Line 351 $parser = HTML::TokeParser->new(\$cleans
|
$parser->xml_mode('1'); |
$parser->xml_mode('1'); |
|
|
# Define handling methods for mode-dependent text rendering |
# Define handling methods for mode-dependent text rendering |
|
|
$parser->{textify}={ |
$parser->{textify}={ |
|
specialnotices => \&format_specialnotices, |
|
specialnotice => \&format_specialnotice, |
targetroot => \&format_targetroot, |
targetroot => \&format_targetroot, |
sourceroot => \&format_sourceroot, |
sourceroot => \&format_sourceroot, |
categories => \&format_categories, |
categories => \&format_categories, |
category => \&format_category, |
category => \&format_category, |
|
abbreviation => \&format_abbreviation, |
targetdir => \&format_targetdir, |
targetdir => \&format_targetdir, |
|
protectionlevel => \&format_protectionlevel, |
chown => \&format_chown, |
chown => \&format_chown, |
chmod => \&format_chmod, |
chmod => \&format_chmod, |
rpm => \&format_rpm, |
rpm => \&format_rpm, |
Line 255 $parser->{textify}={
|
Line 377 $parser->{textify}={
|
rpmAutoReqProv => \&format_rpmAutoReqProv, |
rpmAutoReqProv => \&format_rpmAutoReqProv, |
rpmdescription => \&format_rpmdescription, |
rpmdescription => \&format_rpmdescription, |
rpmpre => \&format_rpmpre, |
rpmpre => \&format_rpmpre, |
|
rpmRequires => \&format_rpmRequires, |
directories => \&format_directories, |
directories => \&format_directories, |
directory => \&format_directory, |
directory => \&format_directory, |
categoryname => \&format_categoryname, |
categoryname => \&format_categoryname, |
Line 269 $parser->{textify}={
|
Line 392 $parser->{textify}={
|
target => \&format_target, |
target => \&format_target, |
note => \&format_note, |
note => \&format_note, |
build => \&format_build, |
build => \&format_build, |
|
installscript => \&format_installscript, |
status => \&format_status, |
status => \&format_status, |
dependencies => \&format_dependencies, |
dependencies => \&format_dependencies, |
|
privatedependencies => \&format_privatedependencies, |
|
buildlink => \&format_buildlink, |
glob => \&format_glob, |
glob => \&format_glob, |
sourcedir => \&format_sourcedir, |
sourcedir => \&format_sourcedir, |
filenames => \&format_filenames, |
filenames => \&format_filenames, |
Line 295 while ($token = $parser->get_tag('lpml')
|
Line 421 while ($token = $parser->get_tag('lpml')
|
} |
} |
exit; |
exit; |
|
|
|
# ---------- Functions (most all just format contents of different markup tags) |
|
|
|
# ------------------------ Final output at end of markup parsing and formatting |
sub end { |
sub end { |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return "THE END\n"; |
return "<br /> <br />". |
|
"<a name='summary' /><font size='+2'>Summary of Source Repository". |
|
"</font>". |
|
"<br /> <br />". |
|
"<table border='1' cellpadding='5'>". |
|
"<caption>Files, Directories, and Symbolic Links</caption>". |
|
"<tr><td>Files (not referenced by globs)</td><td>$file_count</td>". |
|
"</tr>". |
|
"<tr><td>Files (referenced by globs)</td>". |
|
"<td>$fileglobnames_count</td>". |
|
"</tr>". |
|
"<tr><td>Total Files</td>". |
|
"<td>".($fileglobnames_count+$file_count)."</td>". |
|
"</tr>". |
|
"<tr><td>File globs</td>". |
|
"<td>".$fileglob_count."</td>". |
|
"</tr>". |
|
"<tr><td>Directories</td>". |
|
"<td>".$directory_count."</td>". |
|
"</tr>". |
|
"<tr><td>Symbolic links</td>". |
|
"<td>".$link_count."</td>". |
|
"</tr>". |
|
"</table>". |
|
"<table border='1' cellpadding='5'>". |
|
"<caption>File Category Count</caption>". |
|
"<tr><th>Icon</th><th>Name</th><th>Number of Occurrences</th>". |
|
"<th>Number of Incorrect Counts</th>". |
|
"</tr>". |
|
join("\n",(map {"<tr><td><img src='$fab{$_}.gif' ". |
|
"alt='$_ icon' /></td>". |
|
"<td>$_</td><td>$categorycount{$_}</td>". |
|
"<td><!-- POSTEVALINLINE $_ --></td></tr>"} |
|
@categorynamelist)). |
|
"</table>". |
|
"</body></html>\n"; |
|
|
} |
} |
if ($mode eq 'install') { |
if ($mode eq 'install') { |
return ''; |
return ''; |
Line 316 sub format_lpml {
|
Line 481 sub format_lpml {
|
my (@tokeninfo)=@_; |
my (@tokeninfo)=@_; |
my $date=`date`; chop $date; |
my $date=`date`; chop $date; |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
$lpml = "LPML BEGINNING: $date"; |
$lpml=<<END; |
|
<html> |
|
<head> |
|
<title>LPML Description Page |
|
(dist=$dist, categorytype=$categorytype, $date)</title> |
|
</head> |
|
<body> |
|
END |
|
$lpml .= "<br /><font size='+2'>LPML Description Page (dist=$dist, ". |
|
"categorytype=$categorytype, $date)". |
|
"</font>"; |
|
$lpml .=<<END; |
|
<ul> |
|
<li><a href='#about'>About this file</a></li> |
|
<li><a href='#ownperms'>File Type Ownership and Permissions |
|
Descriptions</a></li> |
|
<li><a href='#package'>Software Package Description</a></li> |
|
<li><a href='#directories'>Directory Structure</a></li> |
|
<li><a href='#files'>Files</a></li> |
|
<li><a href='#summary'>Summary of Source Repository</a></li> |
|
</ul> |
|
END |
|
$lpml .=<<END; |
|
<br /> <br /><a name='about' /> |
|
<font size='+2'>About this file</font> |
|
<p> |
|
This file is generated dynamically by <tt>lpml_parse.pl</tt> as |
|
part of a development compilation process.</p> |
|
<p>LPML written by Scott Harrison (harris41\@msu.edu). |
|
</p> |
|
END |
|
} |
|
elsif ($mode eq 'text') { |
|
$lpml = "LPML Description Page (dist=$dist, $date)"; |
|
$lpml .=<<END; |
|
|
|
* About this file |
|
* Software Package Description |
|
* Directory Structure |
|
* File Type Ownership and Permissions |
|
* Files |
|
END |
|
$lpml .=<<END; |
|
|
|
About this file |
|
|
|
This file is generated dynamically by lpml_parse.pl as |
|
part of a development compilation process. Author: Scott |
|
Harrison (harris41\@msu.edu). |
|
|
|
END |
} |
} |
elsif ($mode eq 'install') { |
elsif ($mode eq 'install') { |
print '# LPML install targets. Linux Packaging Markup Language,'; |
print '# LPML install targets. Linux Packaging Markup Language,'; |
print ' by Scott Harrison 2001'."\n"; |
print ' by Scott Harrison 2001'."\n"; |
print '# This file was automatically generated on '.`date`; |
print '# This file was automatically generated on '.`date`; |
print "\n".$invocation; |
print "\n".$invocation; |
|
$lpml .= "\n"; |
|
} |
|
elsif ($mode eq 'configinstall') { |
|
print '# LPML configuration file targets (configinstall).'."\n"; |
|
print '# Linux Packaging Markup Language,'; |
|
print ' by Scott Harrison 2001'."\n"; |
|
print '# This file was automatically generated on '.`date`; |
|
print "\n".$invocation; |
|
$lpml .= "\n"; |
|
} |
|
elsif ($mode eq 'build') { |
|
$lpml = "# LPML build targets. Linux Packaging Markup Language,"; |
|
$lpml .= ' by Scott Harrison 2001'."\n"; |
|
$lpml .= '# This file was automatically generated on '.`date`; |
|
$lpml .= "\n".$invocation; |
|
$lpml .= "\n"; |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 334 sub format_targetroot {
|
Line 565 sub format_targetroot {
|
$text=$targetroot if $targetroot; |
$text=$targetroot if $targetroot; |
$parser->get_tag('/targetroot'); |
$parser->get_tag('/targetroot'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $targetroot="\nTARGETROOT: $text"; |
return $targetroot="\n<br />TARGETROOT: $text"; |
} |
} |
elsif ($mode eq 'install') { |
elsif ($mode eq 'install' or $mode eq 'build' or |
|
$mode eq 'configinstall') { |
return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n"; |
return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n"; |
} |
} |
else { |
else { |
Line 349 sub format_sourceroot {
|
Line 581 sub format_sourceroot {
|
$text=$sourceroot if $sourceroot; |
$text=$sourceroot if $sourceroot; |
$parser->get_tag('/sourceroot'); |
$parser->get_tag('/sourceroot'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $sourceroot="\nSOURCEROOT: $text"; |
return $sourceroot="\n<br />SOURCEROOT: $text"; |
} |
} |
elsif ($mode eq 'install') { |
elsif ($mode eq 'install' or $mode eq 'build' or |
|
$mode eq 'configinstall') { |
return '# SOURCE CODE LOCATION IS "'.$sourceroot."\"\n";; |
return '# SOURCE CODE LOCATION IS "'.$sourceroot."\"\n";; |
} |
} |
else { |
else { |
Line 363 sub format_categories {
|
Line 596 sub format_categories {
|
my $text=&trim($parser->get_text('/categories')); |
my $text=&trim($parser->get_text('/categories')); |
$parser->get_tag('/categories'); |
$parser->get_tag('/categories'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $categories="\nBEGIN CATEGORIES\n$text\nEND CATEGORIES\n"; |
return $categories="\n<br /> <br />". |
|
"\n<a name='ownperms'>". |
|
"\n<font size='+2'>File Type Ownership and Permissions". |
|
" Descriptions</font>". |
|
"\n<p>This table shows what permissions and ownership settings ". |
|
"correspond to each category.</p>". |
|
"\n<table border='1' cellpadding='5' width='60%'>\n". |
|
"<tr>". |
|
"<th align='left' bgcolor='#ffffff'>Icon</th>". |
|
"<th align='left' bgcolor='#ffffff'>Category Name</th>". |
|
"<th align='left' bgcolor='#ffffff'>Permissions ". |
|
"($categorytype)</th>". |
|
"</tr>". |
|
"\n$text\n". |
|
"</table>\n"; |
|
} |
|
elsif ($mode eq 'text') { |
|
return $categories="\n". |
|
"\nFile Type Ownership and Permissions". |
|
" Descriptions". |
|
"\n$text". |
|
"\n"; |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 374 sub format_category {
|
Line 628 sub format_category {
|
my (@tokeninfo)=@_; |
my (@tokeninfo)=@_; |
$category_att_name=$tokeninfo[2]->{'name'}; |
$category_att_name=$tokeninfo[2]->{'name'}; |
$category_att_type=$tokeninfo[2]->{'type'}; |
$category_att_type=$tokeninfo[2]->{'type'}; |
$chmod='';$chown=''; |
$abbreviation=''; $chmod='';$chown=''; |
$parser->get_text('/category'); |
$parser->get_text('/category'); |
$parser->get_tag('/category'); |
$parser->get_tag('/category'); |
|
$fab{$category_att_name}=$abbreviation; |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $category="\nCATEGORY $category_att_name $category_att_type ". |
if ($category_att_type eq $categorytype) { |
"$chmod $chown"; |
push @categorynamelist,$category_att_name; |
|
$categoryhash{$category_att_name}="$chmod $chown"; |
|
return $category="<tr>". |
|
"<td><img src='$abbreviation.gif' ". |
|
"alt='${category_att_name}' /></td>\n". |
|
"<td>${category_att_name}</td>\n". |
|
"<td>$chmod $chown</td>\n". |
|
"</tr>". |
|
"\n"; |
|
# return $category="\n<br />CATEGORY $category_att_name ". |
|
# "$category_att_type $chmod $chown"; |
|
} |
} |
} |
else { |
else { |
if ($category_att_type eq $categorytype) { |
if ($category_att_type eq $categorytype) { |
my ($user,$group)=split(/\:/,$chown); |
my ($user,$group)=split(/\:/,$chown); |
$categoryhash{$category_att_name}='-o '.$user.' -g '.$group. |
$categoryhash{$category_att_name}='-o '.$user.' -g '.$group. |
' -m '.$chmod; |
' -m '.$chmod; |
|
$categoryhash{"chmod.".$category_att_name}=$chmod; |
|
$categoryhash{"chown.".$category_att_name}=$chown; |
} |
} |
return ''; |
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 |
# -------------------------------------------------------- Format chown section |
sub format_chown { |
sub format_chown { |
my @tokeninfo=@_; |
my @tokeninfo=@_; |
Line 417 sub format_rpm {
|
Line 696 sub format_rpm {
|
my $text=&trim($parser->get_text('/rpm')); |
my $text=&trim($parser->get_text('/rpm')); |
$parser->get_tag('/rpm'); |
$parser->get_tag('/rpm'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $rpm="\nBEGIN RPM\n$text\nEND RPM"; |
return $rpm=<<END; |
|
<br /> <br /> |
|
<a name='package' /> |
|
<font size='+2'>Software Package Description</font> |
|
<p> |
|
<table bgcolor='#ffffff' border='0' cellpadding='10' cellspacing='0'> |
|
<tr><td><pre> |
|
$text |
|
</pre></td></tr> |
|
</table> |
|
END |
|
} |
|
elsif ($mode eq 'make_rpm') { |
|
return $text; |
|
} |
|
elsif ($mode eq 'text') { |
|
return $rpm=<<END; |
|
Software Package Description |
|
|
|
$text |
|
END |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 428 sub format_rpmSummary {
|
Line 727 sub format_rpmSummary {
|
my $text=&trim($parser->get_text('/rpmSummary')); |
my $text=&trim($parser->get_text('/rpmSummary')); |
$parser->get_tag('/rpmSummary'); |
$parser->get_tag('/rpmSummary'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $rpmSummary="\nRPMSUMMARY $text"; |
return $rpmSummary="\nSummary : $text"; |
|
} |
|
elsif ($mode eq 'text') { |
|
return $rpmSummary="\nSummary : $text"; |
|
} |
|
elsif ($mode eq 'make_rpm') { |
|
return <<END; |
|
<summary>$text</summary> |
|
END |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 439 sub format_rpmName {
|
Line 746 sub format_rpmName {
|
my $text=&trim($parser->get_text('/rpmName')); |
my $text=&trim($parser->get_text('/rpmName')); |
$parser->get_tag('/rpmName'); |
$parser->get_tag('/rpmName'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $rpmName="\nRPMNAME $text"; |
return $rpmName="\nName : $text"; |
|
} |
|
elsif ($mode eq 'text') { |
|
return $rpmName="\nName : $text"; |
|
} |
|
elsif ($mode eq 'make_rpm') { |
|
return <<END; |
|
<name>$text</name> |
|
END |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 450 sub format_rpmVersion {
|
Line 765 sub format_rpmVersion {
|
my $text=$parser->get_text('/rpmVersion'); |
my $text=$parser->get_text('/rpmVersion'); |
$parser->get_tag('/rpmVersion'); |
$parser->get_tag('/rpmVersion'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $rpmVersion="\nRPMVERSION $text"; |
return $rpmVersion="\nVersion : $text"; |
|
} |
|
elsif ($mode eq 'text') { |
|
return $rpmVersion="\nVersion : $text"; |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 461 sub format_rpmRelease {
|
Line 779 sub format_rpmRelease {
|
my $text=$parser->get_text('/rpmRelease'); |
my $text=$parser->get_text('/rpmRelease'); |
$parser->get_tag('/rpmRelease'); |
$parser->get_tag('/rpmRelease'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $rpmRelease="\nRPMRELEASE $text"; |
return $rpmRelease="\nRelease : $text"; |
|
} |
|
elsif ($mode eq 'text') { |
|
return $rpmRelease="\nRelease : $text"; |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 472 sub format_rpmVendor {
|
Line 793 sub format_rpmVendor {
|
my $text=$parser->get_text('/rpmVendor'); |
my $text=$parser->get_text('/rpmVendor'); |
$parser->get_tag('/rpmVendor'); |
$parser->get_tag('/rpmVendor'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $rpmVendor="\nRPMVENDOR $text"; |
return $rpmVendor="\nVendor : $text"; |
|
} |
|
elsif ($mode eq 'text') { |
|
return $rpmVendor="\nVendor : $text"; |
|
} |
|
elsif ($mode eq 'make_rpm') { |
|
return <<END; |
|
<vendor>$text</vendor> |
|
END |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 483 sub format_rpmBuildRoot {
|
Line 812 sub format_rpmBuildRoot {
|
my $text=$parser->get_text('/rpmBuildRoot'); |
my $text=$parser->get_text('/rpmBuildRoot'); |
$parser->get_tag('/rpmBuildRoot'); |
$parser->get_tag('/rpmBuildRoot'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $rpmBuildRoot="\nRPMBUILDROOT $text"; |
return $rpmBuildRoot="\nBuild Root : $text"; |
|
} |
|
elsif ($mode eq 'text') { |
|
return $rpmBuildRoot="\nBuild Root : $text"; |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 494 sub format_rpmCopyright {
|
Line 826 sub format_rpmCopyright {
|
my $text=$parser->get_text('/rpmCopyright'); |
my $text=$parser->get_text('/rpmCopyright'); |
$parser->get_tag('/rpmCopyright'); |
$parser->get_tag('/rpmCopyright'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $rpmCopyright="\nRPMCOPYRIGHT $text"; |
return $rpmCopyright="\nLicense : $text"; |
|
} |
|
elsif ($mode eq 'text') { |
|
return $rpmCopyright="\nLicense : $text"; |
|
} |
|
elsif ($mode eq 'make_rpm') { |
|
return <<END; |
|
<copyright>$text</copyright> |
|
END |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 505 sub format_rpmGroup {
|
Line 845 sub format_rpmGroup {
|
my $text=$parser->get_text('/rpmGroup'); |
my $text=$parser->get_text('/rpmGroup'); |
$parser->get_tag('/rpmGroup'); |
$parser->get_tag('/rpmGroup'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $rpmGroup="\nRPMGROUP $text"; |
return $rpmGroup="\nGroup : $text"; |
|
} |
|
elsif ($mode eq 'text') { |
|
return $rpmGroup="\nGroup : $text"; |
|
} |
|
elsif ($mode eq 'make_rpm') { |
|
return <<END; |
|
<group>Utilities/System</group> |
|
END |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 516 sub format_rpmSource {
|
Line 864 sub format_rpmSource {
|
my $text=$parser->get_text('/rpmSource'); |
my $text=$parser->get_text('/rpmSource'); |
$parser->get_tag('/rpmSource'); |
$parser->get_tag('/rpmSource'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $rpmSource="\nRPMSOURCE $text"; |
return $rpmSource="\nSource : $text"; |
|
} |
|
elsif ($mode eq 'text') { |
|
return $rpmSource="\nSource : $text"; |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 527 sub format_rpmAutoReqProv {
|
Line 878 sub format_rpmAutoReqProv {
|
my $text=$parser->get_text('/rpmAutoReqProv'); |
my $text=$parser->get_text('/rpmAutoReqProv'); |
$parser->get_tag('/rpmAutoReqProv'); |
$parser->get_tag('/rpmAutoReqProv'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $rpmAutoReqProv="\nRPMAUTOREQPROV $text"; |
return $rpmAutoReqProv="\nAutoReqProv : $text"; |
|
} |
|
elsif ($mode eq 'text') { |
|
return $rpmAutoReqProv="\nAutoReqProv : $text"; |
|
} |
|
elsif ($mode eq 'make_rpm') { |
|
return <<END; |
|
<AutoReqProv>$text</AutoReqProv> |
|
END |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 538 sub format_rpmdescription {
|
Line 897 sub format_rpmdescription {
|
my $text=$parser->get_text('/rpmdescription'); |
my $text=$parser->get_text('/rpmdescription'); |
$parser->get_tag('/rpmdescription'); |
$parser->get_tag('/rpmdescription'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $rpmdescription="\nRPMDESCRIPTION $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 <<END; |
|
<description>$text</description> |
|
END |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 549 sub format_rpmpre {
|
Line 922 sub format_rpmpre {
|
my $text=$parser->get_text('/rpmpre'); |
my $text=$parser->get_text('/rpmpre'); |
$parser->get_tag('/rpmpre'); |
$parser->get_tag('/rpmpre'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $rpmpre="\nRPMPRE $text"; |
# return $rpmpre="\n<br />RPMPRE $text"; |
|
return ''; |
|
} |
|
elsif ($mode eq 'make_rpm') { |
|
return <<END; |
|
<pre>$text</pre> |
|
END |
} |
} |
else { |
else { |
return ''; |
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 '<rpmRequires>'.$text.'</rpmRequires>'; |
|
} |
# -------------------------------------------------- Format directories section |
# -------------------------------------------------- Format directories section |
sub format_directories { |
sub format_directories { |
my $text=$parser->get_text('/directories'); |
my $text=$parser->get_text('/directories'); |
$parser->get_tag('/directories'); |
$parser->get_tag('/directories'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $directories="\nBEGIN DIRECTORIES\n$text\nEND DIRECTORIES\n"; |
$text=~s/\[\{\{\{\{\{DPATHLENGTH\}\}\}\}\}\]/$dpathlength/g; |
|
return $directories="\n<br /> <br />". |
|
"<a name='directories' />". |
|
"<font size='+2'>Directory Structure</font>". |
|
"\n<br /> <br />". |
|
"<table border='1' cellpadding='3' cellspacing='0'>\n". |
|
"<tr><th bgcolor='#ffffff'>Category</th>". |
|
"<th bgcolor='#ffffff'>Status</th>\n". |
|
"<th bgcolor='#ffffff'>Expected Permissions & Ownership</th>\n". |
|
"<th bgcolor='#ffffff' colspan='$dpathlength'>Target Directory ". |
|
"Path</th></tr>\n". |
|
"\n$text\n</table><br />"."\n"; |
|
} |
|
elsif ($mode eq 'text') { |
|
return $directories="\nDirectory Structure\n$text\n". |
|
"\n"; |
} |
} |
elsif ($mode eq 'install') { |
elsif ($mode eq 'install') { |
return "\n".'directories:'."\n".$text; |
return "\n".'directories:'."\n".$text; |
} |
} |
|
elsif ($mode eq 'rpm_file_list') { |
|
return $text; |
|
} |
|
elsif ($mode eq 'uninstall_shell_commands') { |
|
return $text; |
|
} |
else { |
else { |
return ''; |
return ''; |
} |
} |
Line 572 sub format_directories {
|
Line 999 sub format_directories {
|
# ---------------------------------------------------- Format directory section |
# ---------------------------------------------------- Format directory section |
sub format_directory { |
sub format_directory { |
my (@tokeninfo)=@_; |
my (@tokeninfo)=@_; |
$targetdir='';$categoryname='';$description=''; |
$targetdir='';$categoryname='';$description='';$protectionlevel=''; |
$parser->get_text('/directory'); |
$parser->get_text('/directory'); |
$parser->get_tag('/directory'); |
$parser->get_tag('/directory'); |
|
$directory_count++; |
|
$categorycount{$categoryname}++; |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $directory="\nDIRECTORY $targetdir $categoryname $description"; |
my @a; |
|
@a=($targetdir=~/\//g); |
|
my $d=scalar(@a)+1; |
|
$dpathlength=$d if $d>$dpathlength; |
|
my $thtml=$targetdir; |
|
$thtml=~s/\//\<\/td\>\<td bgcolor='#ffffff'\>/g; |
|
my ($chmod,$chown)=split(/\s/,$categoryhash{$categoryname}); |
|
return $directory="\n<tr><td rowspan='2' bgcolor='#ffffff'>". |
|
"$categoryname</td>". |
|
"<td rowspan='2' bgcolor='#ffffff'><!-- POSTEVAL [$categoryname] ". |
|
"verify.pl directory /$targetdir $categoryhash{$categoryname} -->". |
|
" </td>". |
|
"<td rowspan='2' bgcolor='#ffffff'>$chmod<br />$chown</td>". |
|
"<td bgcolor='#ffffff'>$thtml</td></tr>". |
|
"<tr><td bgcolor='#ffffff' colspan='[{{{{{DPATHLENGTH}}}}}]'>". |
|
"$description</td></tr>"; |
|
} |
|
if ($mode eq 'text') { |
|
return $directory="\nDIRECTORY $targetdir $categoryname ". |
|
"$description"; |
} |
} |
elsif ($mode eq 'install') { |
elsif ($mode eq 'install') { |
return "\t".'install '.$categoryhash{$categoryname}.' -d /'. |
return "\t".'install '.$categoryhash{$categoryname}.' -d '. |
$targetroot.$targetdir."\n"; |
$targetroot.'/'.$targetdir."\n"; |
|
} |
|
elsif ($mode eq 'rpm_file_list') { |
|
return $targetroot.'/'.$targetdir."\n"; |
|
} |
|
elsif ($mode eq 'uninstall_shell_commands') { |
|
if ($protectionlevel eq 'never_delete') { |
|
return 'echo "LEAVING BEHIND '.$targetroot.'/'.$targetdir. |
|
' which may have important data worth saving"'."\n"; |
|
} |
|
elsif ($protectionlevel eq 'weak_delete') { |
|
if ($targetdir!~/\w/) { |
|
die("targetdir=\"$targetdir\"! NEVER EVER DELETE THE WHOLE ". |
|
"FILESYSTEM"."\n"); |
|
} |
|
return 'rm -Rvf -i '.$targetroot.'/'.$targetdir."\n"; |
|
} |
|
elsif ($protectionlevel =~ /never/) { |
|
die("CONFUSING PROTECTION LEVEL \"$protectionlevel\" FOUND ". |
|
"FOR directory $targetdir"."\n"); |
|
} |
|
elsif ($protectionlevel !~ |
|
/^never_delete|weak_delete|modest_delete|strong_delete|absolute_delete$/) { |
|
die("CONFUSING OR MISSING PROTECTION LEVEL \"$protectionlevel\" ". |
|
"FOUND FOR directory $targetdir\n"); |
|
} |
|
else { |
|
if ($targetdir!~/\w/) { |
|
die("targetdir=\"$targetdir\"! NEVER EVER DELETE THE WHOLE ". |
|
"FILESYSTEM"."\n"); |
|
} |
|
return 'rm -Rvf '.$targetroot.'/'.$targetdir. |
|
"| grep 'removed directory'"."\n"; |
|
} |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 597 sub format_targetdir {
|
Line 1078 sub format_targetdir {
|
} |
} |
return ''; |
return ''; |
} |
} |
|
# ---------------------------------------------- Format protectionlevel section |
|
sub format_protectionlevel { |
|
my @tokeninfo=@_; |
|
$protectionlevel=''; |
|
my $text=&trim($parser->get_text('/protectionlevel')); |
|
if ($text) { |
|
$parser->get_tag('/protectionlevel'); |
|
$protectionlevel=$text; |
|
} |
|
return ''; |
|
} |
# ------------------------------------------------- Format categoryname section |
# ------------------------------------------------- Format categoryname section |
sub format_categoryname { |
sub format_categoryname { |
my @tokeninfo=@_; |
my @tokeninfo=@_; |
Line 612 sub format_categoryname {
|
Line 1104 sub format_categoryname {
|
sub format_description { |
sub format_description { |
my @tokeninfo=@_; |
my @tokeninfo=@_; |
$description=''; |
$description=''; |
my $text=&trim($parser->get_text('/description')); |
my $text=&htmlsafe(&trim($parser->get_text('/description'))); |
if ($text) { |
if ($text) { |
$parser->get_tag('/description'); |
$parser->get_tag('/description'); |
$description=$text; |
$description=$text; |
Line 623 sub format_description {
|
Line 1115 sub format_description {
|
sub format_files { |
sub format_files { |
my $text=$parser->get_text('/files'); |
my $text=$parser->get_text('/files'); |
$parser->get_tag('/files'); |
$parser->get_tag('/files'); |
if ($mode eq 'html') { |
if ($mode eq 'MANIFEST') { |
return $directories="\nBEGIN FILES\n$text\nEND FILES\n"; |
return $text; |
|
} |
|
elsif ($mode eq 'html') { |
|
return $directories="\n<br /> <br />". |
|
"<a name='files' />". |
|
"<font size='+2'>Files</font><br /> <br />". |
|
"<p>All source and target locations are relative to the ". |
|
"sourceroot and targetroot values at the beginning of this ". |
|
"document.</p>". |
|
"\n<table border='1' cellpadding='5'>". |
|
"<tr><th>Status</th><th colspan='2'>Category</th>". |
|
"<th>Name/Location</th>". |
|
"<th>Description</th><th>Notes</th></tr>". |
|
"$text</table>\n". |
|
"\n"; |
|
} |
|
elsif ($mode eq 'text') { |
|
return $directories="\n". |
|
"File and Directory Structure". |
|
"\n$text\n". |
|
"\n"; |
} |
} |
elsif ($mode eq 'install') { |
elsif ($mode eq 'install') { |
return "\n".'files:'."\n".$text. |
return "\n".'files:'."\n".$text. |
"\n".'links:'."\n".join('',@links); |
"\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; $shell ./$1;\\"; |
|
} |
|
else { |
|
$command=~s/(.*?\/)([^\/]+\s+.*)$/$1/; |
|
$command2="cd $command; $shell ./$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 { |
else { |
return ''; |
return ''; |
} |
} |
Line 644 sub format_links {
|
Line 1216 sub format_links {
|
my $text=$parser->get_text('/links'); |
my $text=$parser->get_text('/links'); |
$parser->get_tag('/links'); |
$parser->get_tag('/links'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $links="\nBEGIN LINKS\n$text\nEND LINKS\n"; |
return $links="\n<br />BEGIN LINKS\n$text\n<br />END LINKS\n"; |
} |
} |
elsif ($mode eq 'install') { |
elsif ($mode eq 'install') { |
return "\n".'links:'."\n\t".$text; |
return "\n".'links:'."\n\t".$text; |
Line 657 sub format_links {
|
Line 1229 sub format_links {
|
sub format_file { |
sub format_file { |
my @tokeninfo=@_; |
my @tokeninfo=@_; |
$file=''; $source=''; $target=''; $categoryname=''; $description=''; |
$file=''; $source=''; $target=''; $categoryname=''; $description=''; |
$note=''; $build=''; $status=''; $dependencies=''; |
$note=''; $build=''; $status=''; $dependencies=''; $installscript=''; |
|
$buildlink = ''; |
my $text=&trim($parser->get_text('/file')); |
my $text=&trim($parser->get_text('/file')); |
|
my $buildtest; |
|
$file_count++; |
|
$categorycount{$categoryname}++; |
if ($source) { |
if ($source) { |
$parser->get_tag('/file'); |
$parser->get_tag('/file'); |
if ($mode eq 'html') { |
if ($mode eq 'MANIFEST') { |
return ($file="\nBEGIN FILE\n". |
my $command=$build; |
"$source $target $categoryname $description $note " . |
if ($command!~/\s/) { |
"$build $status $dependencies" . |
$command=~s/\/([^\/]*)$//; |
"\nEND FILE"); |
} |
} |
else { |
elsif ($mode eq 'install' && $categoryname ne 'conf') { |
$command=~s/(.*?\/)([^\/]+\s+.*)$/$1/; |
return "\t".'@test -e '.$sourceroot.$source. |
} |
' && install '. |
$command=~s/^$sourceroot\///; |
$categoryhash{$categoryname}.' '. |
my (@deps)=split(/\;/,$dependencies); |
$sourceroot.$source.' '. |
my $retval=join("\n",($source, |
$targetroot.$target. |
(map {"$command$_"} @deps))); |
' || echo "**** LON-CAPA WARNING '. |
if ($tokeninfo[2]{type} eq 'private') { |
'**** CVS source file does not exist: '.$sourceroot.'/'. |
return "\n"; |
$source.'"'."\n"; |
} |
|
return $retval."\n"; |
|
} |
|
elsif ($mode eq 'html') { |
|
return ($file="\n<!-- FILESORT:$target -->". |
|
"<tr>". |
|
"<td><!-- POSTEVAL [$categoryname] verify.pl file '$sourcerootarg' ". |
|
"'$targetrootarg' ". |
|
"'$source' '$target' ". |
|
"$categoryhash{$categoryname} --> </td><td>". |
|
"<img src='$fab{$categoryname}.gif' ". |
|
"alt='$categoryname icon' /></td>". |
|
"<td>$categoryname<br /><font size='-1'>". |
|
$categoryhash{$categoryname}."</font></td>". |
|
"<td>SOURCE: $source<br />TARGET: $target</td>". |
|
"<td>$description</td>". |
|
"<td>$note</td>". |
|
"</tr>"); |
|
# return ($file="\n<br />BEGIN FILE\n". |
|
# "$source $target $categoryname $description $note " . |
|
# "$build $status $dependencies" . |
|
# "\nEND FILE"); |
|
} |
|
elsif (($mode eq 'install') && (($categoryname ne 'conf') && |
|
($categoryname ne 'www 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; $shell ./$1;\\"; |
|
my $depstring; |
|
foreach my $dep (@deps) { |
|
$depstring.=<<END; |
|
ECODE=0; DEP=''; \\ |
|
test -e $dep || (echo '**** WARNING **** cannot evaluate status of dependency $dep (for building ${sourceroot}/${source} with)'$logcmd); DEP="1"; \\ |
|
[ -n DEP ] && { perl filecompare.pl -b2 $dep ${targetroot}/${target} || ECODE=\$\$?; } || DEP="1"; \\ |
|
case "\$\$ECODE" in \\ |
|
2) echo "**** WARNING **** dependency $dep is newer than target file ${targetroot}/${target}; you may want to run make build"$logcmd;; \\ |
|
esac; \\ |
|
END |
|
} |
|
chomp $depstring; |
|
$buildtest=<<END; |
|
\@if !(test -e "${sourceroot}/${source}") && !(test -e "${targetroot}/${target}"); then \\ |
|
echo "**** ERROR **** ${sourceroot}/${source} is missing and is also not present at target location ${targetroot}/${target}; you must run make build"$logcmd; exit; \\ |
|
END |
|
$buildtest.=<<END if $depstring; |
|
elif !(test -e "${sourceroot}/${source}"); then \\ |
|
$depstring |
|
END |
|
$buildtest.=<<END; |
|
fi |
|
END |
|
} |
|
if ($installscript) { |
|
my $dir = $sourceroot.'/'.$source; |
|
$dir =~ s|/([^/]*)$||; |
|
my $result =" |
|
$buildtest cd $dir ; $shell $installscript"; |
|
if ($categoryname |
|
&& exists($categoryhash{"chmod.$categoryname"}) ) { |
|
$result .="\\\n"; |
|
$result .=<<"END" |
|
chmod -R $categoryhash{"chmod.$categoryname"} ${targetroot}/${target} \\ |
|
chown -R $categoryhash{"chown.$categoryname"} ${targetroot}/${target} |
|
END |
|
} else { |
|
$result.="\n"; |
|
} |
|
return $result; |
|
} |
|
my $testtarget = $target; |
|
if ($categoryname eq 'setuid script') { |
|
my ($path,$filename) = ($target =~ /^(.*\/)([^\/]+)$/); |
|
my $alttarget = $path.'.'.$filename; |
|
if ((-e "$targetroot/$target") && (-B "$targetroot/$target") && |
|
(-e "$targetroot/$alttarget") && (-T "$targetroot/$alttarget")) { |
|
$testtarget = $alttarget; |
|
} |
|
} |
|
my $bflag='-b5'; |
|
$bflag='-b3' if ($buildlink); |
|
$bflag='-b6' if (($dependencies) or |
|
($categoryname eq 'pdf manual')); |
|
if ($tokeninfo[2]{type} eq 'private') { |
|
return <<END; |
|
$buildtest \@if (test -e "${sourceroot}/${source}") && (test -e "${targetroot}/${target}"); then \\ |
|
ECODE=0; \\ |
|
perl filecompare.pl $bflag ${sourceroot}/${source} ${targetroot}/${testtarget} || ECODE=\$\$?; \\ |
|
case "\$\$ECODE" in \\ |
|
1) echo "${targetroot}/${target} is unchanged";; \\ |
|
2) echo "**** WARNING **** target file ${targetroot}/${target} is newer than CVS source; saving current (old) target file to ${targetroot}/${target}.lpmlsave and then overwriting"$logcmd && install -o www -g www -m 0600 ${targetroot}/${target} ${targetroot}/${target}.lpmlsave && install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\ |
|
0) echo "install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}" && install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\ |
|
esac; \\ |
|
elif (test -e "${sourceroot}/${source}") && !(test -e "${targetroot}/${target}"); then\\ |
|
echo "install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}" && install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}; \\ |
|
fi |
|
\@if (test -e "${targetroot}/${target}"); then \\ |
|
perl verifymodown.pl ${targetroot}/${target} "$categoryhash{$categoryname}"$logcmd; \\ |
|
fi |
|
END |
|
} else { |
|
return <<END; |
|
$buildtest \@if !(test -e "${sourceroot}/${source}") && !(test -e "${targetroot}/${target}"); then \\ |
|
echo "**** ERROR **** CVS source file does not exist: ${sourceroot}/${source} and neither does target: ${targetroot}/${target}"$logcmd; \\ |
|
elif !(test -e "${sourceroot}/${source}"); then \\ |
|
echo "**** WARNING **** CVS source file does not exist: ${sourceroot}/${source}"$logcmd; \\ |
|
perl verifymodown.pl ${targetroot}/${target} "$categoryhash{$categoryname}"$logcmd; \\ |
|
elif !(test -e "${targetroot}/${target}"); then \\ |
|
echo "install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}" && install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}; \\ |
|
else \\ |
|
ECODE=0; \\ |
|
perl filecompare.pl $bflag ${sourceroot}/${source} ${targetroot}/${testtarget} || ECODE=\$\$?; \\ |
|
case "\$\$ECODE" in \\ |
|
1) echo "${targetroot}/${target} is unchanged";; \\ |
|
2) echo "**** WARNING **** target file ${targetroot}/${target} is newer than CVS source; saving current (old) target file to ${targetroot}/${target}.lpmlsave and then overwriting"$logcmd && install -o www -g www -m 0600 ${targetroot}/${target} ${targetroot}/${target}.lpmlsave && install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\ |
|
0) echo "install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}" && install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\ |
|
esac; \\ |
|
perl verifymodown.pl ${targetroot}/${target} "$categoryhash{$categoryname}"$logcmd; \\ |
|
fi |
|
END |
|
} |
|
} |
|
elsif ($mode eq 'configinstall' && (($categoryname eq 'conf') || |
|
($categoryname eq 'www conf'))) { |
|
push @configall,$targetroot.'/'.$target; |
|
return $targetroot.'/'.$target.': alwaysrun'."\n". |
|
"\t".'@# Compare source with target and intelligently respond'. |
|
"\n\t\n\t\n". |
|
|
|
|
|
"\t".'@echo -n ""; ECODE=0 && { perl filecompare.pl -b4 \\'. |
|
"\n\t".$sourceroot.'/'.$source." \\\n\t". |
|
$targetroot.'/'.$target." \\\n\t". |
|
' || ECODE=$$?; } && '."\\\n\t"."\\\n\t"."\\\n\t". |
|
|
|
|
|
'{ [ $$ECODE != "2" ] || '." \\\n\t".'(install '. |
|
$categoryhash{$categoryname}." \\\n\t\t". |
|
$sourceroot.'/'.$source." \\\n\t\t". |
|
$targetroot.'/'.$target.'.lpmlnew'." \\\n\t\t". |
|
' && echo "**** NOTE: CONFIGURATION FILE CHANGE ****"'. |
|
" \\\n\t\t".$logcmd.' && '." \\\n\t\t"."echo -n \"". |
|
'You likely need to compare contents of "'."\\\n\t\t\t". |
|
'&& echo -n "'.$targetroot.'/'.$target.'"'."\\\n\t\t". |
|
'&& echo -n " with the new "'."\\\n\t\t\t". |
|
'&& echo "'.$targetroot.'/'.$target.'.lpmlnew"'."\\\n\t\t". |
|
"$logcmd); } && "." \\\n\t"."\\\n\t"."\\\n\t". |
|
|
|
|
|
'{ [ $$ECODE != "3" ] || '."\\\n\t". |
|
'(install '. |
|
$categoryhash{$categoryname}."\\\n\t\t". |
|
$sourceroot.'/'.$source."\\\n\t\t". |
|
$targetroot.'/'.$target."\\\n\t\t". |
|
' && echo "**** WARNING: NEW CONFIGURATION FILE ADDED ****"'. |
|
"\\\n\t\t".$logcmd.' && '."\\\n\t\t". |
|
'echo -n "'. |
|
'You likely need to review the contents of "'."\\\n\t\t\t". |
|
'&& echo -n "'. |
|
$targetroot.'/'.$target.'"'."\\\n\t\t\t". |
|
'&& echo -n "'. |
|
' to make sure its "'."\\\n\t\t". |
|
'&& echo "'. |
|
'settings are compatible with your overall system"'."\\\n\t\t". |
|
"$logcmd); } && "."\\\n\t"."\\\n\t"."\\\n\t". |
|
|
|
|
|
'{ [ $$ECODE != "1" ] || ('."\\\n\t\t". |
|
'echo "**** ERROR ****"'.$logcmd.' && '."\\\n\t\t".'echo -n "'. |
|
'Configuration source file does not exist "'."\\\n\t\t". |
|
'&& echo -n "'.$sourceroot.'/'.$source.'"'."\\\n\t\t". |
|
"$logcmd); } && "."\\\n\t\t". |
|
"perl verifymodown.pl ${targetroot}/${target} "."\\\n\t\t\t". |
|
"\"$categoryhash{$categoryname}\""."\\\n\t\t\t". |
|
"$logcmd;\n\n"; |
|
} |
|
elsif ($mode eq 'build' && $build) { |
|
push @buildall,$sourceroot.'/'.$source; |
|
push @buildinfo,$targetroot.'/'.$target.';'.$sourceroot.'/'. |
|
$source.';'.$build.';'. |
|
$dependencies; |
|
# return '# need to build '.$source."; |
|
} |
|
elsif ($mode eq 'rpm_file_list') { |
|
if ($categoryname eq 'doc') { |
|
return $targetroot.'/'.$target.' # doc'."\n"; |
|
} |
|
elsif ($categoryname eq 'conf') { |
|
return $targetroot.'/'.$target.' # config'."\n"; |
|
} |
|
else { |
|
return $targetroot.'/'.$target."\n"; |
|
} |
} |
} |
else { |
else { |
return ''; |
return ''; |
Line 686 sub format_file {
|
Line 1457 sub format_file {
|
# --------------------------------------------------------- Format link section |
# --------------------------------------------------------- Format link section |
sub format_link { |
sub format_link { |
my @tokeninfo=@_; |
my @tokeninfo=@_; |
$link=''; $linkto=''; $target=''; $categoryname=''; $description=''; |
$link=''; $linkto=''; $source=''; $target=''; $categoryname=''; |
$note=''; $build=''; $status=''; $dependencies=''; |
$description=''; $note=''; $build=''; $status=''; $dependencies=''; |
my $text=&trim($parser->get_text('/link')); |
my $text=&trim($parser->get_text('/link')); |
if ($linkto) { |
if ($linkto) { |
$parser->get_tag('/link'); |
$parser->get_tag('/link'); |
if ($mode eq 'html') { |
if ($mode eq 'html') { |
return $link="\nBEGIN LINK\n". |
my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target); |
"$linkto $target $categoryname $description $note " . |
$link_count+=scalar(@targets); |
"$build $status $dependencies" . |
foreach my $tgt (@targets) { |
"\nEND LINK"; |
$categorycount{$categoryname}++; |
|
push @links,("\n<!-- FILESORT:$tgt -->". |
|
"<tr>". |
|
"<td><!-- POSTEVAL [$categoryname] verify.pl link ". |
|
"'/$targetrootarg$linkto' '/$targetrootarg$tgt' ". |
|
"$categoryhash{$categoryname} --> </td><td>". |
|
"<img src='$fab{$categoryname}.gif' ". |
|
"alt='$categoryname icon' /></td>". |
|
"<td><font size='-1'>$categoryname</font></td>". |
|
"<td>LINKTO: $linkto<br />TARGET: $tgt</td>". |
|
"<td>$description</td>". |
|
"<td>$note</td>". |
|
"</tr>"); |
|
# push @links,"\t".'ln -fs /'.$linkto.' /'.$targetroot.$tgt. |
|
# "\n"; |
|
} |
|
return join('',@links); |
|
# return ($link="\n<!-- FILESORT:$target -->". |
|
# "<tr>". |
|
# "<td> </td><td><img src='$fab{$categoryname}.gif' ". |
|
# "alt='$categoryname icon' /></td>". |
|
# "<td>$categoryname</td>". |
|
# "<td>LINKTO: $linkto<br />TARGET: $target</td>". |
|
# "<td>$description</td>". |
|
# "<td>$note</td>". |
|
# "</tr>"); |
|
# return $link="\n<tr><td colspan='6'>BEGIN LINK\n". |
|
# "$linkto $target $categoryname $description $note " . |
|
# "$build $status $dependencies" . |
|
# "\nEND LINK</td></tr>"; |
} |
} |
elsif ($mode eq 'install') { |
elsif ($mode eq 'install') { |
my @targets=split(/\;/,$target); |
my @targets=map {s/^\s*//;s/\s$//;$_} split(/\;/,$target); |
foreach my $tgt (@targets) { |
foreach my $tgt (@targets) { |
push @links,"\t".'ln -fs /'.$linkto.' /'.$targetroot.$tgt. |
push @links,"\t".'ln -fs /'.$linkto.' '.$targetroot.'/'.$tgt. |
"\n"; |
"\n"; |
} |
} |
|
# return join('',@links); |
return ''; |
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 { |
else { |
return ''; |
return ''; |
} |
} |
Line 719 sub format_fileglob {
|
Line 1528 sub format_fileglob {
|
$note=''; $build=''; $status=''; $dependencies=''; |
$note=''; $build=''; $status=''; $dependencies=''; |
$filenames=''; |
$filenames=''; |
my $text=&trim($parser->get_text('/fileglob')); |
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) { |
if ($sourcedir) { |
$parser->get_tag('/fileglob'); |
$parser->get_tag('/fileglob'); |
if ($mode eq 'html') { |
if ($mode eq 'MANIFEST') { |
return $fileglob="\nBEGIN FILEGLOB\n". |
return join("\n",(map {"$sourcedir$_"} split(/\;/,$filenames2)))."\n"; |
"$glob sourcedir $targetdir $categoryname $description $note ". |
} |
"$build $status $dependencies $filenames" . |
elsif ($mode eq 'html') { |
"\nEND FILEGLOB"; |
return $fileglob="\n<tr>". |
|
"<td><!-- POSTEVAL [$categoryname] verify.pl fileglob '$sourcerootarg' ". |
|
"'$targetrootarg' ". |
|
"'$glob' '$sourcedir' '$filenames2' '$targetdir' ". |
|
"$categoryhash{$categoryname} --> </td>". |
|
"<td>"."<img src='$fab{$categoryname}.gif' ". |
|
"alt='$categoryname icon' /></td>". |
|
"<td>$categoryname<br />". |
|
"<font size='-1'>".$categoryhash{$categoryname}."</font></td>". |
|
"<td>SOURCEDIR: $sourcedir<br />". |
|
"TARGETDIR: $targetdir<br />". |
|
"GLOB: $glob<br />". |
|
"FILENAMES: $filenames". |
|
"</td>". |
|
"<td>$description</td>". |
|
"<td>$note</td>". |
|
"</tr>"; |
|
# return $fileglob="\n<tr><td colspan='6'>BEGIN FILEGLOB\n". |
|
# "$glob sourcedir $targetdir $categoryname $description $note ". |
|
# "$build $status $dependencies $filenames" . |
|
# "\nEND FILEGLOB</td></tr>"; |
} |
} |
elsif ($mode eq 'install') { |
elsif ($mode eq 'install') { |
return "\t".'install '. |
my $eglob=$glob; |
|
if ($glob eq '*') { |
|
$eglob='[^C][^V][^S]'.$glob; |
|
} |
|
return "\t".'install -p '. |
$categoryhash{$categoryname}.' '. |
$categoryhash{$categoryname}.' '. |
$sourceroot.'/'.$sourcedir.$glob.' '. |
$sourceroot.'/'.$sourcedir.$eglob.' '. |
$targetroot.'/'.$targetdir.'.'."\n"; |
$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 { |
else { |
return ''; |
return ''; |
} |
} |
Line 776 sub format_source {
|
Line 1624 sub format_source {
|
sub format_note { |
sub format_note { |
my @tokeninfo=@_; |
my @tokeninfo=@_; |
$note=''; |
$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) { |
if ($text) { |
$parser->get_tag('/note'); |
# $parser->get_tag('/note'); |
$note=$text; |
$note=$text; |
} |
} |
return ''; |
return ''; |
Line 791 sub format_build {
|
Line 1655 sub format_build {
|
my $text=&trim($parser->get_text('/build')); |
my $text=&trim($parser->get_text('/build')); |
if ($text) { |
if ($text) { |
$parser->get_tag('/build'); |
$parser->get_tag('/build'); |
$build=$text; |
$build=$sourceroot.'/'.$text.';'.$tokeninfo[2]{'trigger'}; |
|
$build=~s/([^\\])\\\s+/$1/g; # allow for lines split onto new lines |
|
} |
|
return ''; |
|
} |
|
# ------------------------------------------------ Format installscript section |
|
sub format_installscript { |
|
my @tokeninfo=@_; |
|
$installscript= &trim($parser->get_text('/installscript')); |
|
if ($installscript) { |
|
$parser->get_tag('/installscript'); |
|
$installscript=~s/([^\\])\\\s+/$1/g; # allow for lines split onto new lines |
|
} |
|
return ''; |
|
} |
|
# -------------------------------------------------------- Format build section |
|
sub format_buildlink { |
|
my @tokeninfo=@_; |
|
my $text=&trim($parser->get_text('/buildlink')); |
|
if ($text) { |
|
$parser->get_tag('/buildlink'); |
|
$buildlink=$sourceroot.'/'.$text; |
|
} else { |
|
$buildlink=''; |
} |
} |
return ''; |
return ''; |
} |
} |
Line 809 sub format_status {
|
Line 1696 sub format_status {
|
# ------------------------------------------------- Format dependencies section |
# ------------------------------------------------- Format dependencies section |
sub format_dependencies { |
sub format_dependencies { |
my @tokeninfo=@_; |
my @tokeninfo=@_; |
$dependencies=''; |
|
my $text=&trim($parser->get_text('/dependencies')); |
my $text=&trim($parser->get_text('/dependencies')); |
if ($text) { |
if ($text) { |
$parser->get_tag('/dependencies'); |
$parser->get_tag('/dependencies'); |
$dependencies=$text; |
$dependencies=join(';',((map {s/^\s*//;s/\s$//;$_} split(/\;/,$text)),$dependencies)); |
|
$dependencies=~s/;$//; |
|
} else { |
|
$dependencies=''; |
|
} |
|
return ''; |
|
} |
|
sub format_privatedependencies { |
|
my @tokeninfo=@_; |
|
#$dependencies=''; |
|
my $text=&trim($parser->get_text('/privatedependencies')); |
|
if ($text) { |
|
$parser->get_tag('/privatedependencies'); |
|
if ($mode eq 'MANIFEST') { return ''; } |
|
$dependencies=join(';',((map {s/^\s*//;s/\s$//;$_} split(/\;/,$text)),$dependencies)); |
|
$dependencies=~s/;$//; |
} |
} |
return ''; |
return ''; |
} |
} |
Line 838 sub format_filenames {
|
Line 1739 sub format_filenames {
|
} |
} |
return ''; |
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 |
# ------------------------------------------------------- Format linkto section |
sub format_linkto { |
sub format_linkto { |
my @tokeninfo=@_; |
my @tokeninfo=@_; |
Line 848 sub format_linkto {
|
Line 1759 sub format_linkto {
|
} |
} |
return ''; |
return ''; |
} |
} |
|
# ------------------------------------- Render less-than and greater-than signs |
|
sub htmlsafe { |
|
my $text=@_[0]; |
|
$text =~ s/</</g; |
|
$text =~ s/>/>/g; |
|
return $text; |
|
} |
# --------------------------------------- remove starting and ending whitespace |
# --------------------------------------- remove starting and ending whitespace |
sub trim { |
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 |
|
|
|
lpml_parse.pl - This is meant to parse files meeting the lpml document type. |
|
|
|
=head1 SYNOPSIS |
|
|
|
<STDIN> | perl lpml_parse.pl <MODE> <CATEGORY> <DIST> <SOURCE> <TARGET> |
|
|
|
Usage is for the 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 runtime default /home/sherbert/loncapa /tmp/install |
|
|
|
=head1 DESCRIPTION |
|
|
|
The general flow of the script is to get command line arguments, run through |
|
the XML document three times, and output according to any desired mode: |
|
install, configinstall, build, rpm, dpkg, htmldoc, textdoc, and status. |
|
|
|
A number of coding decisions are made according to the following principle: |
|
installation software must be stand-alone. Therefore, for instance, I try |
|
not to use the GetOpt::Long module or any other perl modules. (I do however |
|
use HTML::TokeParser.) I also have tried to keep all the MODES of |
|
parsing inside this file. Therefore, format_TAG subroutines are fairly |
|
lengthy with their conditional logic. A more "elegant" solution might |
|
be to dynamically register the parsing mode and subroutines, or maybe even work |
|
with stylesheets. However, in order to make this the installation back-bone |
|
of choice, there are advantages for HAVING EVERYTHING IN ONE FILE. |
|
This way, the LPML installation software does not have to rely on OTHER |
|
installation software (a chicken versus the egg problem). Besides, I would |
|
suggest the modes of parsing are fairly constant: install, configinstall, |
|
build, rpm, dpkg, htmldoc, textdoc, and status. |
|
|
|
Another coding decision is about using a multiple pass-through approach to |
|
parsing the lpml file. This saves memory and makes sure the server will never |
|
be overloaded. During the first pass-through, the script gathers information |
|
specific as to resolving what tags with what 'dist=' attributes are to be used. |
|
During the second pass-through, the script cleans up white-space surrounding |
|
the XML tags, and filters through the tags based on information regarding the |
|
'dist=' attributes (information gathered in the first pass-through). |
|
The third and final pass-through involves formatting and rendering the XML |
|
into whatever XML mode is chosen: install, configinstall, build, rpm, dpkg, |
|
htmldoc, textdoc, and status. |
|
|
|
The hierarchy mandated by the DTD does not always correspond to the hierarchy |
|
that is sensible for a Makefile. For instance, in a Makefile it is sensible |
|
that soft-links are installed after files. However, in an LPML document, it |
|
is sensible that files and links be considered together and the writer of the |
|
LPML document should be free to place things in whatever order makes best |
|
sense in terms of LOOKING at the information. The complication that arises |
|
is that the parser needs to have a memory for passing values from |
|
leaves on the XML tree to higher-up branches. Currently, this memory is |
|
hard-coded (like with the @links array), but it may benefit from a more |
|
formal approach in the future. |
|
|
|
=head1 README |
|
|
|
This parses an LPML file to generate information useful for |
|
source to target installation, compilation, filesystem status |
|
checking, RPM and Debian software packaging, and documentation. |
|
|
|
More information on LPML is available at http://lpml.sourceforge.net. |
|
|
|
=head1 PREREQUISITES |
|
|
|
HTML::TokeParser |
|
|
|
=head1 COREQUISITES |
|
|
|
=head1 OSNAMES |
|
|
|
linux |
|
|
|
=head1 SCRIPT CATEGORIES |
|
|
|
UNIX/System_administration |
|
|
|
=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 |