loncom/build/lpml_parse.pl - diff

Return to lpml_parse.pl CVS log

Up to [LON-CAPA] / loncom / build

Diff for /loncom/build/lpml_parse.pl between versions 1.3 and 1.22

version 1.3, 2001/06/24 23:00:32	version 1.22, 2001/11/17 23:23:36
Line 1	Line 1
#!/usr/bin/perl	#!/usr/bin/perl

# Scott Harrison	# Scott Harrison
	# 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/17,9/18 - Scott Harrison
	# 11/4,11/5,11/6,11/7,11/16,11/17 - Scott Harrison
	#
	# $Id$
	###

	###############################################################################
	## ##
	## 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) ##
	## 6. Functions (most all just format contents of different markup tags) ##
	## 7. POD (plain old documentation, CPAN style) ##
	## ##
	###############################################################################

	# ----------------------------------------------------------------------- Notes
	#
# I am using a multiple pass-through approach to parsing	# I am using a multiple pass-through approach to parsing
# the lpml file. This saves memory and makes sure the server	# the lpml file. This saves memory and makes sure the server
# will never be overloaded.	# 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;	use HTML::TokeParser;

Line 14 my $usage=<<END;	Line 39 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 distribution (default,redhat6.2,debian2.2,redhat7.1,etc).	2nd argument is the category permissions to use (runtime or development)
3rd argument is to manually specify a sourceroot.	3rd argument is the distribution (default,redhat6.2,debian2.2,redhat7.1,etc).
4th argument is to manually specify a targetroot.	4th argument is to manually specify a sourceroot.
	5th argument is to manually specify a targetroot.

Only the 1st argument is mandatory for the program to run.	Only the 1st argument is mandatory for the program to run.

Line 29 END	Line 55 END
# ------------------------------------------------- Grab command line arguments	# ------------------------------------------------- Grab command line arguments

my $mode;	my $mode;
if (@ARGV) {	if (@ARGV==5) {
$mode = shift @ARGV;	$mode = shift @ARGV;
}	}
else {	else {
	@ARGV=();shift @ARGV;
while(<>){} # throw away the input to avoid broken pipes	while(<>){} # throw away the input to avoid broken pipes
print $usage;	print $usage;
exit -1; # exit with error status	exit -1; # exit with error status
}	}

	my $categorytype;
	if (@ARGV) {
	$categorytype = shift @ARGV;
	}

my $dist;	my $dist;
if (@ARGV) {	if (@ARGV) {
$dist = shift @ARGV;	$dist = shift @ARGV;
Line 46 if (@ARGV) {	Line 78 if (@ARGV) {
my $targetroot;	my $targetroot;
my $sourceroot;	my $sourceroot;
if (@ARGV) {	if (@ARGV) {
$targetroot = shift @ARGV;	$sourceroot = shift @ARGV;
}	}
if (@ARGV) {	if (@ARGV) {
$sourceroot = shift @ARGV;	$targetroot = shift @ARGV;
	}
	$sourceroot=~s/\/$//;
	$targetroot=~s/\/$//;

	my $logcmd='\| tee -a WARNINGS';

	my $invocation;
	# --------------------------------------------------- Record program invocation
	if ($mode eq 'install' or $mode eq 'configinstall' or $mode eq 'build') {
	$invocation=(<<END);
	# Invocation: STDINPUT \| lpml_parse.pl
	# 1st argument (mode) is: $mode
	# 2nd argument (category type) is: $categorytype
	# 3rd argument (distribution) is: $dist
	# 4th argument (targetroot) is: described below
	# 5th argument (sourceroot) is: described below
	END
}	}

# ---------------------------------------------------- Start first pass through	# ---------------------------------------------------- Start first pass through
Line 104 while ($token = $parser->get_token()) {	Line 153 while ($token = $parser->get_token()) {
$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'}.' ';
	# This conditional clause is set up to ignore two sets
	# of invalid conditions before accepting entry into
	# the cleanstring.
if ($hash{$key}==2 and	if ($hash{$key}==2 and
!($thisdist eq ' ' or $thisdist =~/\s$dist\s/)) {	!($thisdist eq ' ' or $thisdist =~/\s$dist\s/)) {
if ($token->[4]!~/\/>$/) {	if ($token->[4]!~/\/>$/) {
Line 134 while ($token = $parser->get_token()) {	Line 186 while ($token = $parser->get_token()) {
}	}
}	}
$cleanstring=&trim($cleanstring);	$cleanstring=&trim($cleanstring);
	$cleanstring=~s/\>\s\n\s\</\>\</g;

# ---------------------------------------------------- Start final pass through	# ---------------------------------------------------- Start final pass through

Line 176 my $target;	Line 229 my $target;
my $source;	my $source;
my $note;	my $note;
my $build;	my $build;
	my $buildlink;
my $commands;	my $commands;
my $command;	my $command;
my $status;	my $status;
my $dependencies;	my $dependencies;
my $dependency;	my $dependency;
	my @links;
	my %categoryhash;

	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 217 $parser->{textify}={	Line 278 $parser->{textify}={
files => \&format_files,	files => \&format_files,
file => \&format_file,	file => \&format_file,
fileglob => \&format_fileglob,	fileglob => \&format_fileglob,
	links => \&format_links,
link => \&format_link,	link => \&format_link,
linkto => \&format_linkto,	linkto => \&format_linkto,
source => \&format_source,	source => \&format_source,
Line 225 $parser->{textify}={	Line 287 $parser->{textify}={
build => \&format_build,	build => \&format_build,
status => \&format_status,	status => \&format_status,
dependencies => \&format_dependencies,	dependencies => \&format_dependencies,
	buildlink => \&format_buildlink,
glob => \&format_glob,	glob => \&format_glob,
sourcedir => \&format_sourcedir,	sourcedir => \&format_sourcedir,
filenames => \&format_filenames,	filenames => \&format_filenames,
Line 242 while ($token = $parser->get_tag('lpml')	Line 305 while ($token = $parser->get_tag('lpml')
$token = $parser->get_tag('/lpml');	$token = $parser->get_tag('/lpml');
print $lpml;	print $lpml;
print "\n";	print "\n";
$text=~s/\s\n\s\n\s*/\n/g;	# $text=~s/\s\n\s\n\s*/\n/g;
print $text;	print $text;
print "\n";	print "\n";
print &end();	print &end();
}	}
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 />THE END\n";
	}
	if ($mode eq 'install') {
	return '';
}	}
}	}

Line 267 sub format_lpml {	Line 336 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 = "<br />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;
	$lpml .= "SHELL=\"/bin/bash\"\n\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 .= "SHELL=\"/bin/bash\"\n\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 .= "SHELL=\"/bin/sh\"\n\n";
	}
	else {
	return '';
}	}
}	}
# --------------------------------------------------- Format targetroot section	# --------------------------------------------------- Format targetroot section
Line 276 sub format_targetroot {	Line 370 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' or $mode eq 'build' or
	$mode eq 'configinstall') {
	return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n";
}	}
else {	else {
return '';	return '';
Line 288 sub format_sourceroot {	Line 386 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' or $mode eq 'build' or
	$mode eq 'configinstall') {
	return '# SOURCE CODE LOCATION IS "'.$sourceroot."\"\n";;
}	}
else {	else {
return '';	return '';
Line 299 sub format_categories {	Line 401 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 />BEGIN CATEGORIES\n$text\n".
	"<br />END CATEGORIES\n";
}	}
else {	else {
return '';	return '';
Line 314 sub format_category {	Line 417 sub format_category {
$parser->get_text('/category');	$parser->get_text('/category');
$parser->get_tag('/category');	$parser->get_tag('/category');
if ($mode eq 'html') {	if ($mode eq 'html') {
return $category="\nCATEGORY $category_att_name $category_att_type ".	return $category="\n<br />CATEGORY $category_att_name ".
"$chmod $chown";	"$category_att_type $chmod $chown";
}	}
else {	else {
	if ($category_att_type eq $categorytype) {
	my ($user,$group)=split(/\:/,$chown);
	$categoryhash{$category_att_name}='-o '.$user.' -g '.$group.
	' -m '.$chmod;
	}
return '';	return '';
}	}
}	}
Line 348 sub format_rpm {	Line 456 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="\n<br />BEGIN RPM\n$text\n<br />END RPM";
}	}
else {	else {
return '';	return '';
Line 359 sub format_rpmSummary {	Line 467 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="\n<br />RPMSUMMARY $text";
}	}
else {	else {
return '';	return '';
Line 370 sub format_rpmName {	Line 478 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="\n<br />RPMNAME $text";
}	}
else {	else {
return '';	return '';
Line 381 sub format_rpmVersion {	Line 489 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="\n<br />RPMVERSION $text";
}	}
else {	else {
return '';	return '';
Line 392 sub format_rpmRelease {	Line 500 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="\n<br />RPMRELEASE $text";
}	}
else {	else {
return '';	return '';
Line 403 sub format_rpmVendor {	Line 511 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="\n<br />RPMVENDOR $text";
}	}
else {	else {
return '';	return '';
Line 414 sub format_rpmBuildRoot {	Line 522 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="\n<br />RPMBUILDROOT $text";
}	}
else {	else {
return '';	return '';
Line 425 sub format_rpmCopyright {	Line 533 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="\n<br />RPMCOPYRIGHT $text";
}	}
else {	else {
return '';	return '';
Line 436 sub format_rpmGroup {	Line 544 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="\n<br />RPMGROUP $text";
}	}
else {	else {
return '';	return '';
Line 447 sub format_rpmSource {	Line 555 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="\n<br />RPMSOURCE $text";
}	}
else {	else {
return '';	return '';
Line 458 sub format_rpmAutoReqProv {	Line 566 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="\n<br />RPMAUTOREQPROV $text";
}	}
else {	else {
return '';	return '';
Line 469 sub format_rpmdescription {	Line 577 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";	return $rpmdescription="\n<br />RPMDESCRIPTION $text";
}	}
else {	else {
return '';	return '';
Line 480 sub format_rpmpre {	Line 588 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";
}	}
else {	else {
return '';	return '';
Line 488 sub format_rpmpre {	Line 596 sub format_rpmpre {
}	}
# -------------------------------------------------- Format directories section	# -------------------------------------------------- Format directories section
sub format_directories {	sub format_directories {
my $text=&trim($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";	return $directories="\n<br />BEGIN DIRECTORIES\n$text\n<br />".
	"END DIRECTORIES\n";
}	}
	elsif ($mode eq 'install') {
	return "\n".'directories:'."\n".$text;
	}
else {	else {
return '';	return '';
}	}
Line 504 sub format_directory {	Line 616 sub format_directory {
$parser->get_text('/directory');	$parser->get_text('/directory');
$parser->get_tag('/directory');	$parser->get_tag('/directory');
if ($mode eq 'html') {	if ($mode eq 'html') {
return $directory="\nDIRECTORY $targetdir $categoryname $description";	return $directory="\n<br />DIRECTORY $targetdir $categoryname ".
	"$description";
	}
	elsif ($mode eq 'install') {
	return "\t".'install '.$categoryhash{$categoryname}.' -d '.
	$targetroot.'/'.$targetdir."\n";
}	}
else {	else {
return '';	return '';
Line 536 sub format_categoryname {	Line 653 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 545 sub format_description {	Line 662 sub format_description {
}	}
# -------------------------------------------------------- Format files section	# -------------------------------------------------------- Format files section
sub format_files {	sub format_files {
my $text=&trim($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 'html') {
return $directories="\nBEGIN FILES\n$text\nEND FILES\n";	return $directories="\n<br />BEGIN FILES\n$text\n<br />END FILES\n";
	}
	elsif ($mode eq 'install') {
	return "\n".'files:'."\n".$text.
	"\n".'links:'."\n".join('',@links);
	}
	elsif ($mode eq 'configinstall') {
	return "\n".'configfiles: '.
	join(' ',@configall).
	"\n\n".$text.
	"\n\nalwaysrun:\n\n";
	}
	elsif ($mode eq 'build') {
	my $binfo;
	my $tword;
	my $command2;
	my @deps;
	foreach my $bi (@buildinfo) {
	my ($target,$source,$command,$trigger,@deps)=split(/\;/,$bi);
	$tword=''; $tword=' alwaysrun' if $trigger eq 'always run';
	$command=~s/\/([^\/]*)$//;
	$command2="cd $command; sh ./$1;\\";
	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";
}	}
else {	else {
return '';	return '';
Line 559 sub format_fileglobs {	Line 731 sub format_fileglobs {

}	}
# -------------------------------------------------------- Format links section	# -------------------------------------------------------- Format links section
	# deprecated.. currently <link></link>'s are included in <files></files>
sub format_links {	sub format_links {
	my $text=$parser->get_text('/links');
	$parser->get_tag('/links');
	if ($mode eq 'html') {
	return $links="\n<br />BEGIN LINKS\n$text\n<br />END LINKS\n";
	}
	elsif ($mode eq 'install') {
	return "\n".'links:'."\n\t".$text;
	}
	else {
	return '';
	}
}	}
# --------------------------------------------------------- Format file section	# --------------------------------------------------------- Format file section
sub format_file {	sub format_file {
Line 568 sub format_file {	Line 751 sub format_file {
$file=''; $source=''; $target=''; $categoryname=''; $description='';	$file=''; $source=''; $target=''; $categoryname=''; $description='';
$note=''; $build=''; $status=''; $dependencies='';	$note=''; $build=''; $status=''; $dependencies='';
my $text=&trim($parser->get_text('/file'));	my $text=&trim($parser->get_text('/file'));
	my $buildtest;
if ($source) {	if ($source) {
$parser->get_tag('/file');	$parser->get_tag('/file');
if ($mode eq 'html') {	if ($mode eq 'html') {
return ($file="\nBEGIN FILE\n".	return ($file="\n<br />BEGIN FILE\n".
"$source $target $categoryname $description $note " .	"$source $target $categoryname $description $note " .
"$build $status $dependencies" .	"$build $status $dependencies" .
"\nEND FILE");	"\nEND FILE");
}	}
	elsif ($mode eq 'install' && $categoryname ne 'conf') {
	if ($build) {
	my $bi=$sourceroot.'/'.$source.';'.$build.';'.
	$dependencies;
	my ($source2,$command,$trigger,@deps)=split(/\;/,$bi);
	$tword=''; $tword=' alwaysrun' if $trigger eq 'always run';
	$command=~s/\/([^\/]*)$//;
	$command2="cd $command; sh ./$1;\\";
	my $depstring;
	foreach my $dep (@deps) {
	$depstring.=<<END;
	ECODE=0; DEP=''; \\
	test -e $command/$dep \|\| (echo '** WARNING ** cannot evaluate status of dependency $command/$dep (for building ${sourceroot}/${source} with)'$logcmd); DEP="1"; \\
	[ -n DEP ] && { perl filecompare.pl -b2 $command/$dep ${targetroot}/${target} \|\| ECODE=\$\$?; } \|\| DEP="1"; \\
	case "\$\$ECODE" in \\
	2) echo "** WARNING ** dependency $command/$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
	}
	my $bflag='-b1';
	$bflag='-b3' if $dependencies or $buildlink;
	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; \\
	else \\
	ECODE=0; \\
	perl filecompare.pl $bflag ${sourceroot}/${source} ${targetroot}/${target} \|\| 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 $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\
	0) echo "install $categoryhash{$categorname} ${sourceroot}/${source} ${targetroot}/${target}" && install $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\
	esac; \\
	perl verifymodown.pl ${targetroot}/${target} "$categoryhash{$categoryname}"$logcmd; \\
	fi
	END
	# return "\t".'@test -e '.$sourceroot.'/'.$source.
	# ' && perl filecompare.pl -b '.$sourceroot.'/'.$source.' '.
	# $targetroot.'/'.$target.
	# ' && install '.
	# $categoryhash{$categoryname}.' '.
	# $sourceroot.'/'.$source.' '.
	# $targetroot.'/'.$target.
	# ' \|\| echo "**** WARNING '.
	# '**** CVS source file does not exist: '.$sourceroot.'/'.
	# $source.'"'."\n";
	}
	elsif ($mode eq 'configinstall' && $categoryname eq 'conf') {
	push @configall,$targetroot.'/'.$target;
	return $targetroot.'/'.$target.': alwaysrun'."\n".
	"\t".'@echo -n ""; ECODE=0 && { perl filecompare.pl -b4 '.
	$sourceroot.'/'.$source.' '.$targetroot.'/'.$target.
	' \|\| ECODE=$$?; } && '.
	'{ [ $$ECODE != "2" ] \|\| (install '.
	$categoryhash{$categoryname}.' '.
	$sourceroot.'/'.$source.' '.
	$targetroot.'/'.$target.'.lpmlnew'.
	' && echo "** NOTE: CONFIGURATION FILE CHANGE **"'.
	$logcmd.' && echo "'.
	'You likely need to compare contents of '.
	''.$targetroot.'/'.$target.' with the new '.
	''.$targetroot.'/'.$target.'.lpmlnew"'.
	"$logcmd); } && ".
	'{ [ $$ECODE != "3" ] \|\| (install '.
	$categoryhash{$categoryname}.' '.
	$sourceroot.'/'.$source.' '.
	$targetroot.'/'.$target.''.
	' && echo "** WARNING: NEW CONFIGURATION FILE ADDED **"'.
	$logcmd.' && echo "'.
	'You likely need to review the contents of '.
	''.$targetroot.'/'.$target.' to make sure its '.
	'settings are compatible with your overall system"'.
	"$logcmd); } && ".
	'{ [ $$ECODE != "1" ] \|\| ('.
	'echo "** ERROR **"'.
	$logcmd.' && echo "'.
	'Configuration source file does not exist '.
	''.$sourceroot.'/'.$source.'"'.
	"$logcmd); } && perl verifymodown.pl ${targetroot}/${target} \"$categoryhash{$categoryname}\"$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.";
	}
else {	else {
return '';	return '';
}	}
Line 591 sub format_link {	Line 877 sub format_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".	return $link="\n<br />BEGIN LINK\n".
"$linkto $target $categoryname $description $note " .	"$linkto $target $categoryname $description $note " .
"$build $status $dependencies" .	"$build $status $dependencies" .
"\nEND LINK";	"\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 {	else {
return '';	return '';
}	}
Line 613 sub format_fileglob {	Line 907 sub format_fileglob {
if ($sourcedir) {	if ($sourcedir) {
$parser->get_tag('/fileglob');	$parser->get_tag('/fileglob');
if ($mode eq 'html') {	if ($mode eq 'html') {
return $fileglob="\nBEGIN FILEGLOB\n".	return $fileglob="\n<br />BEGIN FILEGLOB\n".
"$glob sourcedir $targetdir $categoryname $description $note ".	"$glob sourcedir $targetdir $categoryname $description $note ".
"$build $status $dependencies $filenames" .	"$build $status $dependencies $filenames" .
"\nEND FILEGLOB";	"\nEND FILEGLOB";
}	}
	elsif ($mode eq 'install') {
	return "\t".'install '.
	$categoryhash{$categoryname}.' '.
	$sourceroot.'/'.$sourcedir.'[^C][^V][^S]'.$glob.' '.
	$targetroot.'/'.$targetdir.'.'."\n";
	}
else {	else {
return '';	return '';
}	}
Line 676 sub format_build {	Line 976 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'};
	}
	return '';
	}
	# -------------------------------------------------------- Format build section
	sub format_buildlink {
	my @tokeninfo=@_;
	$buildlink='';
	my $text=&trim($parser->get_text('/buildlink'));
	if ($text) {
	$parser->get_tag('/buildlink');
	$buildlink=$sourceroot.'/'.$text;
}	}
return '';	return '';
}	}
Line 698 sub format_dependencies {	Line 1009 sub format_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)));
}	}
return '';	return '';
}	}
Line 716 sub format_glob {	Line 1028 sub format_glob {
# ---------------------------------------------------- Format filenames section	# ---------------------------------------------------- Format filenames section
sub format_filenames {	sub format_filenames {
my @tokeninfo=@_;	my @tokeninfo=@_;
$glob='';
my $text=&trim($parser->get_text('/filenames'));	my $text=&trim($parser->get_text('/filenames'));
if ($text) {	if ($text) {
$parser->get_tag('/filenames');	$parser->get_tag('/filenames');
Line 727 sub format_filenames {	Line 1038 sub format_filenames {
# ------------------------------------------------------- Format linkto section	# ------------------------------------------------------- Format linkto section
sub format_linkto {	sub format_linkto {
my @tokeninfo=@_;	my @tokeninfo=@_;
$glob='';
my $text=&trim($parser->get_text('/linkto'));	my $text=&trim($parser->get_text('/linkto'));
if ($text) {	if ($text) {
$parser->get_tag('/linkto');	$parser->get_tag('/linkto');
Line 735 sub format_linkto {	Line 1045 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)

	=head1 NAME

	lpml_parse.pl - This is meant to parse files meeting the lpml document type.
	See lpml.dtd. LPML=Linux Packaging Markup Language.

	=head1 SYNOPSIS

	Usage is for lpml file to come in through standard input.

	=over 4

	=item *

	1st argument is the mode of parsing.

	=item *

	2nd argument is the category permissions to use (runtime or development)

	=item *

	3rd argument is the distribution
	(default,redhat6.2,debian2.2,redhat7.1,etc).

	=item *

	4th argument is to manually specify a sourceroot.

	=item *

	5th argument is to manually specify a targetroot.

	=back

	Only the 1st argument is mandatory for the program to run.

	Example:

	cat ../../doc/loncapafiles.lpml \|\\
	perl lpml_parse.pl html default /home/sherbert/loncapa /tmp/install

	=head1 DESCRIPTION

	I am using a multiple pass-through approach to parsing
	the lpml file. This saves memory and makes sure the server
	will never be overloaded.

	=head1 README

	I am using a multiple pass-through approach to parsing
	the lpml file. This saves memory and makes sure the server
	will never be overloaded.

	=head1 PREREQUISITES

	HTML::TokeParser

	=head1 COREQUISITES

	=head1 OSNAMES

	linux

	=head1 SCRIPT CATEGORIES

	Packaging/Administrative

	=cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.3
changed lines
	Added in v.1.22