loncom/build/piml_parse.pl - diff

Return to piml_parse.pl CVS log

Up to [LON-CAPA] / loncom / build

Diff for /loncom/build/piml_parse.pl between versions 1.5 and 1.11

version 1.5, 2002/02/05 01:49:39	version 1.11, 2005/10/05 18:37:03
Line 1	Line 1
#!/usr/bin/perl	#!/usr/bin/perl

	# -------------------------------------------------------- Documentation notice
	# Run "perldoc ./piml_parse.pl" in order to best view the software
	# documentation internalized in this program.

	# --------------------------------------------------------- License Information
# The LearningOnline Network with CAPA	# The LearningOnline Network with CAPA
# piml_parse.pl - Linux Packaging Markup Language parser	# piml_parse.pl - Linux Packaging Markup Language parser
#	#
# $Id$	# $Id$
#	#
# Written by Scott Harrison, harris41@msu.edu	# Written by Scott Harrison, codeharrison@yahoo.com
#	#
# Copyright Michigan State University Board of Trustees	# Copyright Michigan State University Board of Trustees
#	#
Line 30	Line 35
# http://www.lon-capa.org/	# http://www.lon-capa.org/
#	#
# YEAR=2002	# YEAR=2002
# 1/28,1/29,1/30,1/31 - Scott Harrison	# 1/28,1/29,1/30,1/31,2/5,4/8 - Scott Harrison
#	#
###	###

Line 56	Line 61
# This is meant to parse files meeting the piml document type.	# This is meant to parse files meeting the piml document type.
# See piml.dtd. PIML=Post Installation Markup Language.	# See piml.dtd. PIML=Post Installation Markup Language.

	# To reduce system dependencies, I'm using a lightweight
	# parser. At some point, I need to get serious with a
	# better xml parsing engine and stylesheet usage.
use HTML::TokeParser;	use HTML::TokeParser;

my $usage=<<END;	my $usage=(<<END);
** ERROR ERROR ERROR ERROR **	** ERROR ERROR ERROR ERROR **
Usage is for piml file to come in through standard input.	Usage is for piml file to come in through standard input.
1st argument is the category permissions to use (runtime or development)	1st argument is the category permissions to use (runtime or development)
2nd argument is the distribution (default,redhat6.2,debian2.2,redhat7.1,etc).	2nd argument is the distribution (default,redhat6,debian2.2,redhat7,etc).
3rd argument is to manually specify a targetroot	3rd 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.

Example:	Example:

cat ../../doc/loncapafiles.piml \|\\	cat ../../doc/sanitycheck.piml \|\\
perl piml_parse.pl html development default /home/sherbert/loncapa /tmp/install	perl piml_parse.pl development default /home/sherbert/loncapa
END	END

# ------------------------------------------------- Grab command line arguments	# ------------------------------------------------- Grab command line arguments

my $mode;	# If number of arguments is incorrect, then give up and print usage message.
if (@ARGV==3) {	unless (@ARGV == 3)
$mode = shift @ARGV;	{
}	@ARGV=();shift(@ARGV);
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); # print usage message
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 $targetrootarg;	my $targetrootarg;
if (@ARGV) {	if (@ARGV)
$targetroot = shift @ARGV;	{
}	$targetroot = shift(@ARGV);
	}

$targetroot=~s/\/$//;	$targetroot=~s/\/$//;
$targetrootarg=$targetroot;	$targetrootarg=$targetroot;

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

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

# ---------------------------------------------------- Start first pass through	# ---------------------------------------------------- Start first pass through
my @parsecontents = <>;	my @parsecontents = <>;
my $parsestring = join('',@parsecontents);	my $parsestring = join('',@parsecontents);
my $outstring;	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 (leaves don't know
Line 129 my $outstring;	Line 140 my $outstring;
my @hierarchy;	my @hierarchy;
$hierarchy[0]=0;	$hierarchy[0]=0;
my $hloc=0;	my $hloc=0;
my $token;	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 %hash;
my $key;	my $key;
while ($token = $parser->get_token()) {	while ($token = $parser->get_token())
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	$hash{$key}=1; # there is a default setting for this key
}	}
elsif ($dist && $hash{$key}==1 && $thisdist=~/\s$dist\s/) {	elsif ($dist && $hash{$key}==1 && $thisdist=~/\s$dist\s/)
	{
$hash{$key}=2; # disregard default setting for this key if	$hash{$key}=2; # disregard default setting for this key if
# there is a directly requested distribution match	# there is a directly requested distribution match
}	}
}	}
if ($token->[0] eq 'E') {	if ($token->[0] eq 'E')
	{
$hloc--;	$hloc--;
}	}
}	}

# --------------------------------------------------- Start second pass through	# --------------------------------------------------- Start second pass through
undef $hloc;	undef $hloc;
Line 244 my @buildinfo;	Line 260 my @buildinfo;
my @configall;	my @configall;

# Make new parser with distribution specific input	# Make new parser with distribution specific input
undef $parser;	undef($parser);
$parser = HTML::TokeParser->new(\$cleanstring) or	$parser = HTML::TokeParser->new(\$cleanstring) or
die('can\'t create TokeParser object');	die('can\'t create TokeParser object');
$parser->xml_mode('1');	$parser->xml_mode('1');
Line 270 $parser->{textify}={	Line 286 $parser->{textify}={
filenames => \&format_filenames,	filenames => \&format_filenames,
perlscript => \&format_perlscript,	perlscript => \&format_perlscript,
TARGET => \&format_TARGET,	TARGET => \&format_TARGET,
	DIST => \&format_DIST,
};	};

my $text;	my $text;
my $token;	my $token;
undef $hloc;	undef($hloc);
undef @hierarchy;	undef(@hierarchy);
my $hloc;	my $hloc;
my @hierarchy2;	my @hierarchy2;
while ($token = $parser->get_tag('piml')) {	while ($token = $parser->get_tag('piml'))
	{
&format_piml(@{$token});	&format_piml(@{$token});
$text = &trim($parser->get_text('/piml'));	$text = &trim($parser->get_text('/piml'));
$token = $parser->get_tag('/piml');	$token = $parser->get_tag('/piml');
print $piml;	print($piml);
print "\n";	print("\n");
print $text;	print($text);
print "\n";	print("\n");
print &end();	print(&end());
}	}
exit;	exit(0);

# ---------- Functions (most all just format contents of different markup tags)	# ---------- Functions (most all just format contents of different markup tags)

Line 315 sub format_piml {	Line 333 sub format_piml {

END	END
}	}

# --------------------------------------------------- Format targetroot section	# --------------------------------------------------- Format targetroot section
sub format_targetroot {	sub format_targetroot {
my $text=&trim($parser->get_text('/targetroot'));	my $text=&trim($parser->get_text('/targetroot'));
$text=$targetroot if $targetroot;	$text=$targetroot if $targetroot;
$parser->get_tag('/targetroot');	$parser->get_tag('/targetroot');
return '# TARGET INSTALL LOCATION is "'.$targetroot."\"\n";	return('# TARGET INSTALL LOCATION is "'.$targetroot."\"\n");
}	}

# -------------------------------------------------- Format perl script section	# -------------------------------------------------- Format perl script section
sub format_perlscript {	sub format_perlscript {
my (@tokeninfo)=@_;	my (@tokeninfo)=@_;
Line 329 sub format_perlscript {	Line 349 sub format_perlscript {
my $text=$parser->get_text('/perlscript');	my $text=$parser->get_text('/perlscript');
$parser->get_tag('/perlscript');	$parser->get_tag('/perlscript');
if ($mode eq 'bg') {	if ($mode eq 'bg') {
open OUT,">/tmp/piml$$.pl";	open(OUT,">/tmp/piml$$.pl");
print OUT $text;	print(OUT $text);
close OUT;	close(OUT);
return <<END;	return(<<END);
# launch background process for $target	# launch background process for $target
system("perl /tmp/piml$$.pl &");	system("perl /tmp/piml$$.pl &");
END	END
}	}
else {	else {
return $text;	return($text);
}	}
}	}

# --------------------------------------------------------------- Format TARGET	# --------------------------------------------------------------- Format TARGET
sub format_TARGET {	sub format_TARGET {
my (@tokeninfo)=@_;	my (@tokeninfo)=@_;
$parser->get_tag('/TARGET');	$parser->get_tag('/TARGET');
return $target;	return($target);
	}

	# ----------------------------------------------------------------- Format DIST
	sub format_DIST {
	my (@tokeninfo)=@_;
	$parser->get_tag('/DIST');
	return($dist);
}	}

# --------------------------------------------------- Format categories section	# --------------------------------------------------- Format categories section
sub format_categories {	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');
return '# CATEGORIES'."\n".$text;	return('# CATEGORIES'."\n".$text);
}	}

# --------------------------------------------------- Format categories section	# --------------------------------------------------- Format categories section
sub format_category {	sub format_category {
my (@tokeninfo)=@_;	my (@tokeninfo)=@_;
Line 367 sub format_category {	Line 397 sub format_category {
$categoryhash{$category_att_name}='-o '.$user.' -g '.$group.	$categoryhash{$category_att_name}='-o '.$user.' -g '.$group.
' -m '.$chmod;	' -m '.$chmod;
}	}
return '';	return('');
}	}

# --------------------------------------------------- Format categories section	# --------------------------------------------------- Format categories section
sub format_abbreviation {	sub format_abbreviation {
my @tokeninfo=@_;	my @tokeninfo=@_;
Line 378 sub format_abbreviation {	Line 409 sub format_abbreviation {
$parser->get_tag('/abbreviation');	$parser->get_tag('/abbreviation');
$abbreviation=$text;	$abbreviation=$text;
}	}
return '';	return('');
}	}

# -------------------------------------------------------- Format chown section	# -------------------------------------------------------- Format chown section
sub format_chown {	sub format_chown {
my @tokeninfo=@_;	my @tokeninfo=@_;
Line 389 sub format_chown {	Line 421 sub format_chown {
$parser->get_tag('/chown');	$parser->get_tag('/chown');
$chown=$text;	$chown=$text;
}	}
return '';	return('');
}	}

# -------------------------------------------------------- Format chmod section	# -------------------------------------------------------- Format chmod section
sub format_chmod {	sub format_chmod {
my @tokeninfo=@_;	my @tokeninfo=@_;
Line 400 sub format_chmod {	Line 433 sub format_chmod {
$parser->get_tag('/chmod');	$parser->get_tag('/chmod');
$chmod=$text;	$chmod=$text;
}	}
return '';	return('');
}	}

# ------------------------------------------------- Format categoryname section	# ------------------------------------------------- Format categoryname section
sub format_categoryname {	sub format_categoryname {
my @tokeninfo=@_;	my @tokeninfo=@_;
Line 411 sub format_categoryname {	Line 445 sub format_categoryname {
$parser->get_tag('/categoryname');	$parser->get_tag('/categoryname');
$categoryname=$text;	$categoryname=$text;
}	}
return '';	return('');
}	}

# -------------------------------------------------------- Format files section	# -------------------------------------------------------- Format files section
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');
return "\n".'# There are '.$file_count.' files this script works on'.	return("\n".'# There are '.$file_count.' files this script works on'.
"\n\n".$text;	"\n\n".$text);
}	}

# --------------------------------------------------------- Format file section	# --------------------------------------------------------- Format file section
sub format_file {	sub format_file {
my @tokeninfo=@_;	my @tokeninfo=@_;
Line 429 sub format_file {	Line 465 sub format_file {
$file_count++;	$file_count++;
$categorycount{$categoryname}++;	$categorycount{$categoryname}++;
$parser->get_tag('/file');	$parser->get_tag('/file');
return "# File: $target\n".	return("# File: $target\n".
"$text\n";	"$text\n");
return '';
}	}

# ------------------------------------------------------- Format target section	# ------------------------------------------------------- Format target section
sub format_target {	sub format_target {
my @tokeninfo=@_;	my @tokeninfo=@_;
Line 442 sub format_target {	Line 478 sub format_target {
$parser->get_tag('/target');	$parser->get_tag('/target');
$target=$targetrootarg.$text;	$target=$targetrootarg.$text;
}	}
return '';	return('');
}	}

# --------------------------------------------------------- Format note section	# --------------------------------------------------------- Format note section
sub format_note {	sub format_note {
my @tokeninfo=@_;	my @tokeninfo=@_;
Line 467 sub format_note {	Line 504 sub format_note {
if ($text) {	if ($text) {
$note=$text;	$note=$text;
}	}
return '';	return('');

}	}

# ------------------------------------------------- Format dependencies section	# ------------------------------------------------- Format dependencies section
sub format_dependencies {	sub format_dependencies {
my @tokeninfo=@_;	my @tokeninfo=@_;
Line 480 sub format_dependencies {	Line 517 sub format_dependencies {
$dependencies=join(';',	$dependencies=join(';',
(map {s/^\s*//;s/\s$//;$_} split(/\;/,$text)));	(map {s/^\s*//;s/\s$//;$_} split(/\;/,$text)));
}	}
return '';	return('');
}	}

# ------------------------------------------------ Format specialnotice section	# ------------------------------------------------ Format specialnotice section
sub format_specialnotices {	sub format_specialnotices {
$parser->get_tag('/specialnotices');	$parser->get_tag('/specialnotices');
return '';	return('');
}	}

# ------------------------------------------------ Format specialnotice section	# ------------------------------------------------ Format specialnotice section
sub format_specialnotice {	sub format_specialnotice {
$parser->get_tag('/specialnotice');	$parser->get_tag('/specialnotice');
return '';	return('');
}	}

# ------------------------------------- Render less-than and greater-than signs	# ------------------------------------- Render less-than and greater-than signs
sub htmlsafe {	sub htmlsafe {
my $text=@_[0];	my $text=@_[0];
$text =~ s/</</g;	$text =~ s/</</g;
$text =~ s/>/>/g;	$text =~ s/>/>/g;
return $text;	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 (plain old documentation, CPAN style)

	=pod

=head1 NAME	=head1 NAME

piml_parse.pl - This is meant to parse files meeting the piml document type.	piml_parse.pl - This is meant to parse files meeting the piml document type.
Line 524 Usage is for piml file to come in throug	Line 567 Usage is for piml file to come in throug
=item *	=item *

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

=item *	=item *

Line 537 Only the 1st argument is mandatory for t	Line 580 Only the 1st argument is mandatory for t
Example:	Example:

cat ../../doc/loncapafiles.piml \|\\	cat ../../doc/loncapafiles.piml \|\\
perl piml_parse.pl html default /home/sherbert/loncapa /tmp/install	perl piml_parse.pl development default /home/sherbert/loncapa

=head1 DESCRIPTION	=head1 DESCRIPTION

Line 565 linux	Line 608 linux

Packaging/Administrative	Packaging/Administrative

	=head1 AUTHOR

	Scott Harrison
	sharrison@users.sourceforge.net

	Please let me know how/if you are finding this script useful and
	any/all suggestions. -Scott

=cut	=cut

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

Removed from v.1.5
changed lines
	Added in v.1.11