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.35 and 1.43

version 1.35, 2002/01/09 22:18:16	version 1.43, 2002/04/08 10:56:16
Line 1	Line 1
#!/usr/bin/perl	#!/usr/bin/perl

	# -------------------------------------------------------- Documentation notice
	# Run "perldoc ./lpml_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
# lpml_parse.pl - Linux Packaging Markup Language parser	# lpml_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 37	Line 42
# 11/4,11/5,11/6,11/7,11/16,11/17 - 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	# 12/2,12/3,12/4,12/5,12/6,12/13,12/19,12/29 - Scott Harrison
# YEAR=2002	# YEAR=2002
# 1/8,1/9 - Scott Harrison	# 1/8,1/9,1/29,1/31,2/5,3/21,4/8 - Scott Harrison
#	#
###	###

Line 58	Line 63
#	#
# 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. At some point, I expect the
	# first two steps will be implemented with my XFML
#	#
# This is meant to parse files meeting the lpml document type.	# This is meant to parse files meeting the lpml document type.
# See lpml.dtd. LPML=Linux Packaging Markup Language.	# See lpml.dtd. LPML=Linux Packaging Markup Language.
Line 84 END	Line 90 END

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

my $mode;	my $mode='';
if (@ARGV==5) {	if (@ARGV==5) {
$mode = shift @ARGV;	$mode = shift @ARGV;
}	}
Line 95 else {	Line 101 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 $targetrootarg='';
my $sourcerootarg;	my $sourcerootarg='';
if (@ARGV) {	if (@ARGV) {
$sourceroot = shift @ARGV;	$sourceroot = shift @ARGV;
}	}
Line 130 if ($mode eq 'install' or $mode eq 'conf	Line 136 if ($mode eq 'install' or $mode eq 'conf
# 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
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 152 $parser = HTML::TokeParser->new(\$parses	Line 158 $parser = HTML::TokeParser->new(\$parses
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++;
Line 173 while ($token = $parser->get_token()) {	Line 179 while ($token = $parser->get_token()) {
}	}

# --------------------------------------------------- Start second pass through	# --------------------------------------------------- Start second pass through
undef $hloc;	undef($hloc);
undef @hierarchy;	undef(@hierarchy);
undef $parser;	undef($parser);
$hierarchy[0]=0;	$hierarchy[0]=0;
$parser = HTML::TokeParser->new(\$parsestring) or	$parser = HTML::TokeParser->new(\$parsestring) or
die('can\'t create TokeParser object');	die('can\'t create TokeParser object');
Line 208 while ($token = $parser->get_token()) {	Line 214 while ($token = $parser->get_token()) {
$cleanstring.=$token->[4];	$cleanstring.=$token->[4];
}	}
if ($token->[4]=~/\/>$/) {	if ($token->[4]=~/\/>$/) {
$hloc--;	# $hloc--;
}	}
}	}
if ($token->[0] eq 'E') {	if ($token->[0] eq 'E') {
Line 281 my $link_count;	Line 287 my $link_count;
my $fileglob_count;	my $fileglob_count;
my $fileglobnames_count;	my $fileglobnames_count;
my %categorycount;	my %categorycount;
# START TEMP WAY
#my %bytecount; # TEMP WAY TO COUNT INFORMATION
#my %linecount; # TEMP WAY TO COUNT INFORMATION
# END TEMP WAY

my @buildall;	my @buildall;
my @buildinfo;	my @buildinfo;
Line 370 exit;	Line 372 exit;
# ------------------------ Final output at end of markup parsing and formatting	# ------------------------ Final output at end of markup parsing and formatting
sub end {	sub end {
if ($mode eq 'html') {	if ($mode eq 'html') {
# START TEMP WAY
# my $totallinecount;
# my $totalbytecount;
# map {$totallinecount+=$linecount{$_};
# $totalbytecount+=$bytecount{$_}}
# @categorynamelist;
# END TEMP WAY
return "<br /> <br />".	return "<br /> <br />".
"<a name='summary' /><font size='+2'>Summary of Source Repository".	"<a name='summary' /><font size='+2'>Summary of Source Repository".
"</font>".	"</font>".
Line 414 sub end {	Line 409 sub end {
"</table>".	"</table>".
"</body></html>\n";	"</body></html>\n";

# START TEMP WAY
# join("\n",(map {"<tr><td><img src='$fab{$_}.gif' ".
# "alt='$_ icon' /></td>".
# "<td>$_</td><td>$categorycount{$_}</td><td>$linecount{$_}</td><td>$bytecount{$_}</td></tr>"}
# @categorynamelist)).
# "<br /> <br />".
# "Total Lines of Code: $totallinecount".
# "<br /> <br />".
# "Total Bytes: $totalbytecount".
# END TEMP WAY
}	}
if ($mode eq 'install') {	if ($mode eq 'install') {
return '';	return '';
Line 970 sub format_directory {	Line 955 sub format_directory {
my ($chmod,$chown)=split(/\s/,$categoryhash{$categoryname});	my ($chmod,$chown)=split(/\s/,$categoryhash{$categoryname});
return $directory="\n<tr><td rowspan='2' bgcolor='#ffffff'>".	return $directory="\n<tr><td rowspan='2' bgcolor='#ffffff'>".
"$categoryname</td>".	"$categoryname</td>".
"<td rowspan='2' bgcolor='#ffffff'><!-- POSTEVAL [$categoryname] verify.pl directory /$targetdir $categoryhash{$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 rowspan='2' bgcolor='#ffffff'>$chmod<br />$chown</td>".
"<td bgcolor='#ffffff'>$thtml</td></tr>".	"<td bgcolor='#ffffff'>$thtml</td></tr>".
"<tr><td bgcolor='#ffffff' colspan='[{{{{{DPATHLENGTH}}}}}]'>".	"<tr><td bgcolor='#ffffff' colspan='[{{{{{DPATHLENGTH}}}}}]'>".
Line 1144 sub format_file {	Line 1131 sub format_file {
my $buildtest;	my $buildtest;
$file_count++;	$file_count++;
$categorycount{$categoryname}++;	$categorycount{$categoryname}++;
# START TEMP WAY
# if (-T "$sourcerootarg/$source") {
# $linecount{$categoryname}+=`wc -l $sourcerootarg/$source`;
# }
# my $bytesize=(-s "$sourcerootarg/$source");
# $bytecount{$categoryname}+=$bytesize;
# END TEMP WAY
if ($source) {	if ($source) {
$parser->get_tag('/file');	$parser->get_tag('/file');
if ($mode eq 'html') {	if ($mode eq 'html') {
return ($file="\n<!-- FILESORT:$target -->".	return ($file="\n<!-- FILESORT:$target -->".
"<tr>".	"<tr>".
"<td><!-- POSTEVAL [$categoryname] verify.pl file '$sourcerootarg' ".	"<td><!-- POSTEVAL [$categoryname] verify.pl file '$sourcerootarg' ".
"'$targetrootarg' ".	"'$targetrootarg' ".
"'$source' '$target' ".	"'$source' '$target' ".
"$categoryhash{$categoryname} --> </td><td>".	"$categoryhash{$categoryname} --> </td><td>".
Line 1256 END	Line 1236 END
$logcmd.' && echo "'.	$logcmd.' && echo "'.
'Configuration source file does not exist '.	'Configuration source file does not exist '.
''.$sourceroot.'/'.$source.'"'.	''.$sourceroot.'/'.$source.'"'.
"$logcmd); } && perl verifymodown.pl ${targetroot}/${target} \"$categoryhash{$categoryname}\"$logcmd;\n\n";	"$logcmd); } && perl verifymodown.pl ${targetroot}/${target} \"".
	"$categoryhash{$categoryname}\"$logcmd;\n\n";
}	}
elsif ($mode eq 'build' && $build) {	elsif ($mode eq 'build' && $build) {
push @buildall,$sourceroot.'/'.$source;	push @buildall,$sourceroot.'/'.$source;
Line 1361 sub format_fileglob {	Line 1342 sub format_fileglob {
my @semi=($filenames2=~/(\;)/g);	my @semi=($filenames2=~/(\;)/g);
$fileglobnames_count+=scalar(@semi)+1;	$fileglobnames_count+=scalar(@semi)+1;
$categorycount{$categoryname}+=scalar(@semi)+1;	$categorycount{$categoryname}+=scalar(@semi)+1;
# START TEMP WAY
# for my $f (split(/\;/,$filenames2)) {
# if (-T "$sourcerootarg/$sourcedir/$f") {
# $linecount{$categoryname}+=`wc -l $sourcerootarg/$sourcedir/$f`;
# open OUT,">>/tmp/junk123";
# print OUT "$linecount{$categoryname} $categoryname $sourcerootarg/$sourcedir/$f\n";
# close OUT;
# }
# my $bytesize=(-s "$sourcerootarg/$sourcedir/$f");
# $bytecount{$categoryname}+=$bytesize;
# }
# END TEMP WAY
if ($sourcedir) {	if ($sourcedir) {
$parser->get_tag('/fileglob');	$parser->get_tag('/fileglob');
if ($mode eq 'html') {	if ($mode eq 'html') {
return $fileglob="\n<tr>".	return $fileglob="\n<tr>".
"<td><!-- POSTEVAL [$categoryname] verify.pl fileglob '$sourcerootarg' ".	"<td><!-- POSTEVAL [$categoryname] verify.pl fileglob '$sourcerootarg' ".
"'$targetrootarg' ".	"'$targetrootarg' ".
"'$glob' '$sourcedir' '$filenames2' '$targetdir' ".	"'$glob' '$sourcedir' '$filenames2' '$targetdir' ".
"$categoryhash{$categoryname} --> </td>".	"$categoryhash{$categoryname} --> </td>".
Line 1493 sub format_build {	Line 1462 sub format_build {
if ($text) {	if ($text) {
$parser->get_tag('/build');	$parser->get_tag('/build');
$build=$sourceroot.'/'.$text.';'.$tokeninfo[2]{'trigger'};	$build=$sourceroot.'/'.$text.';'.$tokeninfo[2]{'trigger'};
	$build=~s/([^\\])\\\s+/$1/g; # allow for lines split onto new lines
}	}
return '';	return '';
}	}
Line 1551 sub format_filenames {	Line 1521 sub format_filenames {
}	}
return '';	return '';
}	}
# ------------------------------------------------ Format specialnotice section	# ----------------------------------------------- Format specialnotices section
sub format_specialnotices {	sub format_specialnotices {
$parser->get_tag('/specialnotices');	$parser->get_tag('/specialnotices');
return '';	return '';
Line 1585 sub trim {	Line 1555 sub trim {

# ----------------------------------- POD (plain old documentation, CPAN style)	# ----------------------------------- POD (plain old documentation, CPAN style)

	=pod

=head1 NAME	=head1 NAME

lpml_parse.pl - This is meant to parse files meeting the lpml document type.	lpml_parse.pl - This is meant to parse files meeting the lpml document type.
Line 1652 linux	Line 1624 linux

Packaging/Administrative	Packaging/Administrative

	=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	=cut

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

Removed from v.1.35
changed lines
	Added in v.1.43