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.4

version 1.3, 2001/06/24 23:00:32	version 1.4, 2001/09/07 16:49:18
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 - Scott Harrison

	###############################################################################
	## ##
	## ORGANIZATION OF THIS PERL SCRIPT ##
	## 1. Notes ##
	## 2. Get command line arguments ##
	## 3. First pass through (grab distribution-specific information) ##
	## 4. Second pass through (parse out what is not necessary) ##
	## 5. Third pass through (translate markup according to specified mode) ##
	## ##
	###############################################################################

	# ----------------------------------------------------------------------- Notes
	#
# I am using a multiple pass-through approach to parsing	# 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 32 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 48 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 71 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/\/$//;

# ---------------------------------------------------- Start first pass through	# ---------------------------------------------------- Start first pass through
my @parsecontents = <>;	my @parsecontents = <>;
Line 104 while ($token = $parser->get_token()) {	Line 131 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 164 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

# storage variables	# storage variables
Line 181 my $command;	Line 211 my $command;
my $status;	my $status;
my $dependencies;	my $dependencies;
my $dependency;	my $dependency;
	my @links;
	my %categoryhash;

# Make new parser with distribution specific input	# Make new parser with distribution specific input
undef $parser;	undef $parser;
Line 217 $parser->{textify}={	Line 249 $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 242 while ($token = $parser->get_tag('lpml')	Line 275 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();
Line 253 sub end {	Line 286 sub end {
if ($mode eq 'html') {	if ($mode eq 'html') {
return "THE END\n";	return "THE END\n";
}	}
	if ($mode eq 'install') {
	return '';
	}
}	}

# ----------------------- Take in string to parse and the separation expression	# ----------------------- Take in string to parse and the separation expression
Line 269 sub format_lpml {	Line 305 sub format_lpml {
if ($mode eq 'html') {	if ($mode eq 'html') {
$lpml = "LPML BEGINNING: $date";	$lpml = "LPML BEGINNING: $date";
}	}
	elsif ($mode eq 'install') {
	print '# LPML install targets. Linux Packaging Markup Language,';
	print ' by Scott Harrison 2001'."\n";
	print '# This file was automatically generated on '.`date`;
	}
	else {
	return '';
	}
}	}
# --------------------------------------------------- Format targetroot section	# --------------------------------------------------- Format targetroot section
sub format_targetroot {	sub format_targetroot {
Line 278 sub format_targetroot {	Line 322 sub format_targetroot {
if ($mode eq 'html') {	if ($mode eq 'html') {
return $targetroot="\nTARGETROOT: $text";	return $targetroot="\nTARGETROOT: $text";
}	}
	elsif ($mode eq 'install') {
	return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n";
	}
else {	else {
return '';	return '';
}	}
Line 290 sub format_sourceroot {	Line 337 sub format_sourceroot {
if ($mode eq 'html') {	if ($mode eq 'html') {
return $sourceroot="\nSOURCEROOT: $text";	return $sourceroot="\nSOURCEROOT: $text";
}	}
	elsif ($mode eq 'install') {
	return '# SOURCE CODE LOCATION IS "'.$sourceroot."\"\n";;
	}
else {	else {
return '';	return '';
}	}
Line 318 sub format_category {	Line 368 sub format_category {
"$chmod $chown";	"$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 488 sub format_rpmpre {	Line 543 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="\nBEGIN DIRECTORIES\n$text\nEND DIRECTORIES\n";
}	}
	elsif ($mode eq 'install') {
	return "\n".'directories:'."\n".$text;
	}
else {	else {
return '';	return '';
}	}
Line 506 sub format_directory {	Line 564 sub format_directory {
if ($mode eq 'html') {	if ($mode eq 'html') {
return $directory="\nDIRECTORY $targetdir $categoryname $description";	return $directory="\nDIRECTORY $targetdir $categoryname $description";
}	}
	elsif ($mode eq 'install') {
	return "\t".'install '.$categoryhash{$categoryname}.' -d '.
	$targetroot.$targetdir."\n";
	}
else {	else {
return '';	return '';
}	}
Line 545 sub format_description {	Line 607 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="\nBEGIN FILES\n$text\nEND FILES\n";
}	}
	elsif ($mode eq 'install') {
	return "\n".'files:'."\n".$text.
	"\n".'links:'."\n".join('',@links);
	}
else {	else {
return '';	return '';
}	}
Line 559 sub format_fileglobs {	Line 625 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="\nBEGIN LINKS\n$text\nEND 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 576 sub format_file {	Line 653 sub format_file {
"$build $status $dependencies" .	"$build $status $dependencies" .
"\nEND FILE");	"\nEND FILE");
}	}
	elsif ($mode eq 'install') {
	return "\t".'@test -e '.$sourceroot.$source.
	'/loncom/html/index.html && install '.
	$categoryhash{$categoryname}.' '.
	$sourceroot.$source.'/loncom/html/index.html '.
	$targetroot.$target.
	'/home/httpd/html/index.html \|\| echo "**** LON-CAPA WARNING '.
	'**** CVS source file does not exist: '.$sourceroot.$source.
	'/loncom/html/index.html"'."\n";
	}
else {	else {
return '';	return '';
}	}
Line 596 sub format_link {	Line 683 sub format_link {
"$build $status $dependencies" .	"$build $status $dependencies" .
"\nEND LINK";	"\nEND LINK";
}	}
	elsif ($mode eq 'install') {
	push @links,"\t".'ln -s /'.$linkto.' /'.$targetroot.$target.' '.
	$categoryname."\n";
	return '';
	}
else {	else {
return '';	return '';
}	}

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

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