--- loncom/build/lpml_parse.pl	2001/12/15 20:20:11	1.32
+++ loncom/build/lpml_parse.pl	2002/04/08 12:51:03	1.44
@@ -1,11 +1,16 @@
 #!/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
 # lpml_parse.pl - Linux Packaging Markup Language parser
 #
-# $Id: lpml_parse.pl,v 1.32 2001/12/15 20:20:11 harris41 Exp $
+# $Id: lpml_parse.pl,v 1.44 2002/04/08 12:51:03 harris41 Exp $
 #
-# Written by Scott Harrison, harris41@msu.edu
+# Written by Scott Harrison, codeharrison@yahoo.com
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -35,7 +40,9 @@
 # 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 - 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 - Scott Harrison
 #
 ###
 
@@ -56,7 +63,8 @@
 #
 # 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.
+# 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.
 # See lpml.dtd.  LPML=Linux Packaging Markup Language.
@@ -82,7 +90,7 @@ END
 
 # ------------------------------------------------- Grab command line arguments
 
-my $mode;
+my $mode='';
 if (@ARGV==5) {
     $mode = shift @ARGV;
 }
@@ -93,20 +101,20 @@ else {
     exit -1; # exit with error status
 }
 
-my $categorytype;
+my $categorytype='';
 if (@ARGV) {
     $categorytype = shift @ARGV;
 }
 
-my $dist;
+my $dist='';
 if (@ARGV) {
     $dist = shift @ARGV;
 }
 
-my $targetroot;
-my $sourceroot;
-my $targetrootarg;
-my $sourcerootarg;
+my $targetroot='';
+my $sourceroot='';
+my $targetrootarg='';
+my $sourcerootarg='';
 if (@ARGV) {
     $sourceroot = shift @ARGV;
 }
@@ -128,15 +136,15 @@ if ($mode eq 'install' or $mode eq 'conf
 #             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
+#             4th argument (sourceroot) is: described below
+#             5th argument (targetroot) is: described below
 END
 }
 
 # ---------------------------------------------------- Start first pass through
 my @parsecontents = <>;
 my $parsestring = join('',@parsecontents);
-my $outstring;
+my $outstring='';
 
 # Need to make a pass through and figure out what defaults are
 # overrided.  Top-down overriding strategy (leaves don't know
@@ -150,7 +158,7 @@ $parser = HTML::TokeParser->new(\$parses
     die('can\'t create TokeParser object');
 $parser->xml_mode('1');
 my %hash;
-my $key;
+my $key='';
 while ($token = $parser->get_token()) {
     if ($token->[0] eq 'S') {
 	$hloc++;
@@ -171,9 +179,9 @@ while ($token = $parser->get_token()) {
 }
 
 # --------------------------------------------------- Start second pass through
-undef $hloc;
-undef @hierarchy;
-undef $parser;
+undef($hloc);
+undef(@hierarchy);
+undef($parser);
 $hierarchy[0]=0;
 $parser = HTML::TokeParser->new(\$parsestring) or
     die('can\'t create TokeParser object');
@@ -206,7 +214,7 @@ while ($token = $parser->get_token()) {
 	    $cleanstring.=$token->[4];
 	}
 	if ($token->[4]=~/\/>$/) {
-	    $hloc--;
+#	    $hloc--;
 	}
     }
     if ($token->[0] eq 'E') {
@@ -279,10 +287,6 @@ my $link_count;
 my $fileglob_count;
 my $fileglobnames_count;
 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 @buildinfo;
@@ -321,6 +325,7 @@ $parser->{textify}={
     rpmAutoReqProv => \&format_rpmAutoReqProv,
     rpmdescription => \&format_rpmdescription,
     rpmpre => \&format_rpmpre,
+    rpmRequires => \&format_rpmRequires,
     directories => \&format_directories,
     directory => \&format_directory,
     categoryname => \&format_categoryname,
@@ -367,13 +372,6 @@ exit;
 # ------------------------ Final output at end of markup parsing and formatting
 sub end {
     if ($mode eq 'html') {
-	# START TEMP WAY
-#	my $totallinecount;
-#	my $totalbytecount;
-#	map {$totallinecount+=$linecount{$_};
-#	     $totalbytecount+=$bytecount{$_}}
-# 	  @categorynamelist;
-        # END TEMP WAY
 	return "<br />&nbsp;<br />".
 	    "<a name='summary' /><font size='+2'>Summary of Source Repository".
 	    "</font>".
@@ -411,16 +409,6 @@ sub end {
 	    "</table>".
 	    "</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 />&nbsp;<br />".
-#	    "Total Lines of Code: $totallinecount".
-#	    "<br />&nbsp;<br />".
-#	    "Total Bytes: $totalbytecount".
-# END TEMP WAY
     }
     if ($mode eq 'install') {
 	return '';
@@ -664,6 +652,9 @@ $text
 </table>
 END
     }
+    elsif ($mode eq 'make_rpm') {
+	return $text;
+    }
     elsif ($mode eq 'text') {
 	return $rpm=<<END;
 Software Package Description
@@ -685,6 +676,11 @@ sub format_rpmSummary {
     elsif ($mode eq 'text') {
 	return $rpmSummary="\nSummary     : $text";
     }
+    elsif ($mode eq 'make_rpm') {
+	return <<END;
+<summary>$text</summary>
+END
+    }
     else {
 	return '';
     }
@@ -699,6 +695,11 @@ sub format_rpmName {
     elsif ($mode eq 'text') {
 	return $rpmName="\nName        : $text";
     }
+    elsif ($mode eq 'make_rpm') {
+	return <<END;
+<name>$text</name>
+END
+    }
     else {
 	return '';
     }
@@ -741,6 +742,11 @@ sub format_rpmVendor {
     elsif ($mode eq 'text') {
 	return $rpmVendor="\nVendor      : $text";
     }
+    elsif ($mode eq 'make_rpm') {
+	return <<END;
+<vendor>$text</vendor>
+END
+    }
     else {
 	return '';
     }
@@ -769,6 +775,11 @@ sub format_rpmCopyright {
     elsif ($mode eq 'text') {
 	return $rpmCopyright="\nLicense     : $text";
     }
+    elsif ($mode eq 'make_rpm') {
+	return <<END;
+<copyright>$text</copyright>
+END
+    }
     else {
 	return '';
     }
@@ -783,6 +794,11 @@ sub format_rpmGroup {
     elsif ($mode eq 'text') {
 	return $rpmGroup="\nGroup       : $text";
     }
+    elsif ($mode eq 'make_rpm') {
+	return <<END;
+<group>Utilities/System</group>
+END
+    }
     else {
 	return '';
     }
@@ -808,9 +824,14 @@ sub format_rpmAutoReqProv {
     if ($mode eq 'html') {
 	return $rpmAutoReqProv="\nAutoReqProv : $text";
     }
-    if ($mode eq 'text') {
+    elsif ($mode eq 'text') {
 	return $rpmAutoReqProv="\nAutoReqProv : $text";
     }
+    elsif ($mode eq 'make_rpm') {
+	return <<END;
+<AutoReqProv>$text</AutoReqProv>
+END
+    }
     else {
 	return '';
     }
@@ -829,6 +850,13 @@ sub format_rpmdescription {
 	$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 {
 	return '';
     }
@@ -841,9 +869,41 @@ sub format_rpmpre {
 #	return $rpmpre="\n<br />RPMPRE $text";
 	return '';
     }
+    elsif ($mode eq 'make_rpm') {
+	return <<END;
+<pre>$text</pre>
+END
+    }
+    else {
+	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
 sub format_directories {
@@ -869,7 +929,10 @@ sub format_directories {
     }
     elsif ($mode eq 'install') {
 	return "\n".'directories:'."\n".$text;
-   }
+    }
+    elsif ($mode eq 'rpm_file_list') {
+	return $text;
+    }
     else {
 	return '';
     }
@@ -892,7 +955,9 @@ sub format_directory {
 	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} -->&nbsp;</td>".
+	    "<td rowspan='2' bgcolor='#ffffff'><!-- POSTEVAL [$categoryname] ".
+	    "verify.pl directory /$targetdir $categoryhash{$categoryname} -->".
+	    "&nbsp;</td>".
 	    "<td rowspan='2' bgcolor='#ffffff'>$chmod<br />$chown</td>".
 	    "<td bgcolor='#ffffff'>$thtml</td></tr>".
 	    "<tr><td bgcolor='#ffffff' colspan='[{{{{{DPATHLENGTH}}}}}]'>".
@@ -906,6 +971,9 @@ sub format_directory {
 	return "\t".'install '.$categoryhash{$categoryname}.' -d '.
 	    $targetroot.'/'.$targetdir."\n";
     }
+    elsif ($mode eq 'rpm_file_list') {
+	return $targetroot.'/'.$targetdir."\n";
+    }
     else {
 	return '';
     }
@@ -985,8 +1053,14 @@ sub format_files {
 	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;\\";
+	    if ($command!~/\s/) {
+		$command=~s/\/([^\/]*)$//;
+		$command2="cd $command; sh ./$1;\\";
+	    }
+	    else {
+		$command=~s/(.*?\/)([^\/]+\s+.*)$/$1/;
+		$command2="cd $command; sh ./$2;\\";
+	    }
 	    my $depstring;
 	    my $depstring2="\t\t\@echo '';\\\n";
 	    my $olddep;
@@ -1022,6 +1096,9 @@ sub format_files {
 		$binfo."\n".
 		"alwaysrun:\n\n";
     }
+    elsif ($mode eq 'rpm_file_list') {
+	return $text;
+    }
     else {
 	return '';
     }
@@ -1054,19 +1131,12 @@ sub format_file {
     my $buildtest;
     $file_count++;
     $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) {
 	$parser->get_tag('/file');
 	if ($mode eq 'html') {
 	    return ($file="\n<!-- FILESORT:$target -->".
 		    "<tr>".
-		    "<td><!-- POSTEVAL [$categoryname] verify.pl file '$sourcerootarg' ".
+          "<td><!-- POSTEVAL [$categoryname] verify.pl file '$sourcerootarg' ".
 		    "'$targetrootarg' ".
 		    "'$source' '$target' ".
 		    "$categoryhash{$categoryname} -->&nbsp;</td><td>".
@@ -1095,10 +1165,10 @@ sub format_file {
 		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"; \\
+		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 $command/$dep is newer than target file ${targetroot}/${target}; you may want to run make build"$logcmd;; \\
+			2) echo "**** WARNING **** dependency $dep is newer than target file ${targetroot}/${target}; you may want to run make build"$logcmd;; \\
 		esac; \\
 END
 		}
@@ -1166,7 +1236,8 @@ END
 		$logcmd.' && echo "'.
 		'Configuration source file does not exist '.
 		''.$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) {
 	    push @buildall,$sourceroot.'/'.$source;
@@ -1175,6 +1246,17 @@ END
 		$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 {
 	    return '';
 	}
@@ -1187,7 +1269,6 @@ sub format_link {
     $link=''; $linkto=''; $source=''; $target=''; $categoryname=''; 
     $description=''; $note=''; $build=''; $status=''; $dependencies='';
     my $text=&trim($parser->get_text('/link'));
-    my @links;
     if ($linkto) {
 	$parser->get_tag('/link');
 	if ($mode eq 'html') {
@@ -1228,11 +1309,20 @@ sub format_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.
+		push @links,"\t".'ln -fs /'.$linkto.' '.$targetroot.'/'.$tgt.
 		    "\n";
 	    }
+#	    return join('',@links);
 	    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 {
 	    return '';
 	}
@@ -1252,23 +1342,11 @@ sub format_fileglob {
     my @semi=($filenames2=~/(\;)/g);
     $fileglobnames_count+=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) {
 	$parser->get_tag('/fileglob');
 	if ($mode eq 'html') {
 	    return $fileglob="\n<tr>".
-		"<td><!-- POSTEVAL [$categoryname] verify.pl fileglob '$sourcerootarg' ".
+      "<td><!-- POSTEVAL [$categoryname] verify.pl fileglob '$sourcerootarg' ".
 		"'$targetrootarg' ".
 		"'$glob' '$sourcedir' '$filenames2' '$targetdir' ".
 		"$categoryhash{$categoryname} -->&nbsp;</td>".
@@ -1299,6 +1377,16 @@ sub format_fileglob {
 		$sourceroot.'/'.$sourcedir.$eglob.' '.
 		$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 {
 	    return '';
 	}
@@ -1374,6 +1462,7 @@ sub format_build {
     if ($text) {
 	$parser->get_tag('/build');
 	$build=$sourceroot.'/'.$text.';'.$tokeninfo[2]{'trigger'};
+	$build=~s/([^\\])\\\s+/$1/g; # allow for lines split onto new lines
     }
     return '';
 }
@@ -1432,7 +1521,7 @@ sub format_filenames {
     }
     return '';
 }
-# ------------------------------------------------ Format specialnotice section
+# ----------------------------------------------- Format specialnotices section
 sub format_specialnotices {
     $parser->get_tag('/specialnotices');
     return '';
@@ -1466,10 +1555,11 @@ sub trim {
 
 # ----------------------------------- POD (plain old documentation, CPAN style)
 
+=pod
+
 =head1 NAME
 
-lpml_parse.pl - This is meant to parse files meeting the lpml document type.
-See lpml.dtd.  LPML=Linux Packaging Markup Language.
+lpml_parse.pl - This is meant to parse LPML files (Linux Packaging Markup Language)
 
 =head1 SYNOPSIS
 
@@ -1533,4 +1623,12 @@ linux
 
 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