--- loncom/build/lpml_parse.pl	2002/04/13 19:29:32	1.45
+++ loncom/build/lpml_parse.pl	2014/06/09 05:14:12	1.61
@@ -12,7 +12,7 @@
 # The LearningOnline Network with CAPA
 # lpml_parse.pl - Linux Packaging Markup Language parser
 #
-# $Id: lpml_parse.pl,v 1.45 2002/04/13 19:29:32 harris41 Exp $
+# $Id: lpml_parse.pl,v 1.61 2014/06/09 05:14:12 raeburn Exp $
 #
 # Written by Scott Harrison, codeharrison@yahoo.com
 #
@@ -47,6 +47,7 @@
 # 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,4/12 - Scott Harrison
+# 4/21,4/26,5/19,5/23,10/13 - Scott Harrison
 #
 ###
 
@@ -85,6 +86,7 @@ Usage is for lpml file to come in throug
     typical choices: default,redhat6.2,debian2.2,redhat7
 4th argument is to manually specify a sourceroot.
 5th argument is to manually specify a targetroot.
+6th argument is to manually specify a shell.
 
 Only the 1st argument is mandatory for the program to run.
 
@@ -99,7 +101,7 @@ END
 # ------------------------------------------------- Grab command line arguments
 
 my $mode='';
-if (@ARGV==5) {
+if (@ARGV == 6 || @ARGV == 5) {
     $mode = shift @ARGV;
 }
 else {
@@ -134,6 +136,11 @@ $targetroot=~s/\/$//; # remove trailing
 $sourcerootarg=$sourceroot;
 $targetrootarg=$targetroot;
 
+my $shell = 'sh';
+if (@ARGV) {
+    $shell = shift @ARGV;
+}
+
 my $logcmd='| tee -a WARNINGS';
 
 my $invocation; # Record how the program was invoked
@@ -146,6 +153,7 @@ if ($mode eq 'install' or $mode eq 'conf
 #             3rd argument (distribution) is: $dist
 #             4th argument (sourceroot) is: described below
 #             5th argument (targetroot) is: described below
+#             6th argument (shell) is: $shell	
 END
 }
 
@@ -298,6 +306,7 @@ my $directories;
 my $directory;
 my $targetdirs;
 my $targetdir;
+my $protectionlevel;
 my $categoryname;
 my $description;
 my $files;
@@ -311,6 +320,7 @@ my $targets;
 my $target;
 my $source;
 my $note;
+my $installscript;
 my $build;
 my $buildlink;
 my $commands;
@@ -351,6 +361,7 @@ $parser->{textify}={
     category => \&format_category,
     abbreviation => \&format_abbreviation,
     targetdir => \&format_targetdir,
+    protectionlevel => \&format_protectionlevel,
     chown => \&format_chown,
     chmod => \&format_chmod,
     rpm => \&format_rpm,
@@ -381,8 +392,10 @@ $parser->{textify}={
     target => \&format_target,
     note => \&format_note,
     build => \&format_build,
+    installscript => \&format_installscript,
     status => \&format_status,
     dependencies => \&format_dependencies,
+    privatedependencies => \&format_privatedependencies,
     buildlink => \&format_buildlink,
     glob => \&format_glob,
     sourcedir => \&format_sourcedir,
@@ -525,7 +538,7 @@ END
 	print ' by Scott Harrison 2001'."\n";
 	print '# This file was automatically generated on '.`date`;
 	print "\n".$invocation;
-	$lpml .= "SHELL=\"/bin/bash\"\n\n";
+	$lpml .= "\n";
     }
     elsif ($mode eq 'configinstall') {
 	print '# LPML configuration file targets (configinstall).'."\n";
@@ -533,14 +546,14 @@ END
 	print ' by Scott Harrison 2001'."\n";
 	print '# This file was automatically generated on '.`date`;
 	print "\n".$invocation;
-	$lpml .= "SHELL=\"/bin/bash\"\n\n";
+	$lpml .= "\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";
+	$lpml .= "\n";
     }
     else {
 	return '';
@@ -639,6 +652,8 @@ sub format_category {
 	    my ($user,$group)=split(/\:/,$chown);
 	    $categoryhash{$category_att_name}='-o '.$user.' -g '.$group.
 		' -m '.$chmod;
+	    $categoryhash{"chmod.".$category_att_name}=$chmod;
+	    $categoryhash{"chown.".$category_att_name}=$chown;
 	}
 	return '';
     }
@@ -974,6 +989,9 @@ sub format_directories {
     elsif ($mode eq 'rpm_file_list') {
 	return $text;
     }
+    elsif ($mode eq 'uninstall_shell_commands') {
+	return $text;
+    }
     else {
 	return '';
     }
@@ -981,7 +999,7 @@ sub format_directories {
 # ---------------------------------------------------- Format directory section
 sub format_directory {
     my (@tokeninfo)=@_;
-    $targetdir='';$categoryname='';$description='';
+    $targetdir='';$categoryname='';$description='';$protectionlevel='';
     $parser->get_text('/directory');
     $parser->get_tag('/directory');
     $directory_count++;
@@ -1015,6 +1033,36 @@ sub format_directory {
     elsif ($mode eq 'rpm_file_list') {
 	return $targetroot.'/'.$targetdir."\n";
     }
+    elsif ($mode eq 'uninstall_shell_commands') {
+	if ($protectionlevel eq 'never_delete') {
+	    return 'echo "LEAVING BEHIND '.$targetroot.'/'.$targetdir.
+		' which may have important data worth saving"'."\n";
+	}
+	elsif ($protectionlevel eq 'weak_delete') {
+	    if ($targetdir!~/\w/) {
+		die("targetdir=\"$targetdir\"! NEVER EVER DELETE THE WHOLE ".
+		    "FILESYSTEM"."\n");
+	    }
+	    return 'rm -Rvf -i '.$targetroot.'/'.$targetdir."\n";
+	}
+	elsif ($protectionlevel =~ /never/) {
+	    die("CONFUSING PROTECTION LEVEL \"$protectionlevel\" FOUND ".
+		"FOR directory $targetdir"."\n");
+	}
+	elsif ($protectionlevel !~
+    /^never_delete|weak_delete|modest_delete|strong_delete|absolute_delete$/) {
+	    die("CONFUSING OR MISSING PROTECTION LEVEL \"$protectionlevel\" ".
+		"FOUND FOR directory $targetdir\n");
+	}
+	else {
+	    if ($targetdir!~/\w/) {
+		die("targetdir=\"$targetdir\"! NEVER EVER DELETE THE WHOLE ".
+		    "FILESYSTEM"."\n");
+	    }
+	    return 'rm -Rvf '.$targetroot.'/'.$targetdir.
+		"| grep 'removed directory'"."\n";
+	}
+    }
     else {
 	return '';
     }
@@ -1030,6 +1078,17 @@ sub format_targetdir {
     }
     return '';
 }
+# ---------------------------------------------- Format protectionlevel section
+sub format_protectionlevel {
+    my @tokeninfo=@_;
+    $protectionlevel='';
+    my $text=&trim($parser->get_text('/protectionlevel'));
+    if ($text) {
+	$parser->get_tag('/protectionlevel');
+	$protectionlevel=$text;
+    }
+    return '';
+}
 # ------------------------------------------------- Format categoryname section
 sub format_categoryname {
     my @tokeninfo=@_;
@@ -1056,7 +1115,10 @@ sub format_description {
 sub format_files {
     my $text=$parser->get_text('/files');
     $parser->get_tag('/files');
-    if ($mode eq 'html') {
+    if ($mode eq 'MANIFEST') {
+	return $text;
+    }
+    elsif ($mode eq 'html') {
 	return $directories="\n<br />&nbsp;<br />".
 	    "<a name='files' />".
 	    "<font size='+2'>Files</font><br />&nbsp;<br />".
@@ -1096,11 +1158,11 @@ sub format_files {
 	    $tword=''; $tword=' alwaysrun' if $trigger eq 'always run'; 
 	    if ($command!~/\s/) {
 		$command=~s/\/([^\/]*)$//;
-		$command2="cd $command; sh ./$1;\\";
+		$command2="cd $command; $shell ./$1;\\";
 	    }
 	    else {
 		$command=~s/(.*?\/)([^\/]+\s+.*)$/$1/;
-		$command2="cd $command; sh ./$2;\\";
+		$command2="cd $command; $shell ./$2;\\";
 	    }
 	    my $depstring;
 	    my $depstring2="\t\t\@echo '';\\\n";
@@ -1167,14 +1229,32 @@ sub format_links {
 sub format_file {
     my @tokeninfo=@_;
     $file=''; $source=''; $target=''; $categoryname=''; $description='';
-    $note=''; $build=''; $status=''; $dependencies='';
+    $note=''; $build=''; $status=''; $dependencies=''; $installscript='';
+    $buildlink = '';
     my $text=&trim($parser->get_text('/file'));
     my $buildtest;
     $file_count++;
     $categorycount{$categoryname}++;
     if ($source) {
 	$parser->get_tag('/file');
-	if ($mode eq 'html') {
+	if ($mode eq 'MANIFEST') {
+	    my $command=$build;
+	    if ($command!~/\s/) {
+		$command=~s/\/([^\/]*)$//;
+	    }
+	    else {
+		$command=~s/(.*?\/)([^\/]+\s+.*)$/$1/;
+	    }
+	    $command=~s/^$sourceroot\///;
+	    my (@deps)=split(/\;/,$dependencies);
+	    my $retval=join("\n",($source,
+		       (map {"$command$_"} @deps)));
+	    if ($tokeninfo[2]{type} eq 'private') {
+		return "\n";
+	    }
+	    return $retval."\n";
+	}
+	elsif ($mode eq 'html') {
 	    return ($file="\n<!-- FILESORT:$target -->".
 		    "<tr>".
           "<td><!-- POSTEVAL [$categoryname] verify.pl file '$sourcerootarg' ".
@@ -1194,14 +1274,15 @@ sub format_file {
 #		"$build $status $dependencies" .
 #		"\nEND FILE");
 	}
-	elsif ($mode eq 'install' && $categoryname ne 'conf') {
+	elsif (($mode eq 'install') && (($categoryname ne 'conf') && 
+					($categoryname ne 'www 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;\\";
+		$command2="cd $command; $shell ./$1;\\";
 		my $depstring;
 		foreach my $dep (@deps) {
 		    $depstring.=<<END;
@@ -1225,60 +1306,120 @@ END
                 $buildtest.=<<END;
 	fi
 END
+            }
+	    if ($installscript) {
+		my $dir = $sourceroot.'/'.$source;
+		$dir =~ s|/([^/]*)$||;
+		my $result =" 
+$buildtest	cd $dir ; $shell $installscript";
+		if ($categoryname 
+		    && exists($categoryhash{"chmod.$categoryname"}) ) {
+		    $result .="\\\n";
+		    $result .=<<"END"
+		chmod -R $categoryhash{"chmod.$categoryname"} ${targetroot}/${target} \\
+		chown -R $categoryhash{"chown.$categoryname"} ${targetroot}/${target} 
+END
+                } else {
+		    $result.="\n";
+		}
+		return $result;
 	    }
-            my $bflag='-b1';
-            $bflag='-b3' if $dependencies or $buildlink;
-	    return <<END;
+            my $bflag='-b5';
+            $bflag='-b3' if ($buildlink);
+            $bflag='-b6' if (($dependencies) or
+                             ($categoryname eq 'pdf manual'));
+	    if ($tokeninfo[2]{type} eq 'private') {
+		return <<END;
+$buildtest	\@if (test -e "${sourceroot}/${source}") && (test -e "${targetroot}/${target}"); then \\
+		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 -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\
+			0) echo "install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}" && install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\
+                esac; \\
+	elif (test -e "${sourceroot}/${source}") && !(test -e "${targetroot}/${target}"); then\\
+		echo "install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}" && install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}; \\
+	fi
+	\@if (test -e "${targetroot}/${target}"); then \\
+		perl verifymodown.pl ${targetroot}/${target} "$categoryhash{$categoryname}"$logcmd; \\
+	fi
+END
+            } else {
+	        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; \\
+	elif !(test -e "${targetroot}/${target}"); then \\
+		echo "install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}" && install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}; \\
 	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{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}" && install $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\
+			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 -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\
+			0) echo "install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target}" && install -p $categoryhash{$categoryname} ${sourceroot}/${source} ${targetroot}/${target};; \\
 		esac; \\
 		perl verifymodown.pl ${targetroot}/${target} "$categoryhash{$categoryname}"$logcmd; \\
 	fi
 END
+            }
 	}
-	elsif ($mode eq 'configinstall' && $categoryname eq 'conf') {
+	elsif ($mode eq 'configinstall' && (($categoryname eq 'conf') ||
+					    ($categoryname eq 'www 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'.
+		"\t".'@# Compare source with target and intelligently respond'.
+		"\n\t\n\t\n".
+
+
+		"\t".'@echo -n ""; ECODE=0 && { perl filecompare.pl -b4 \\'.
+		"\n\t".$sourceroot.'/'.$source." \\\n\t".
+		$targetroot.'/'.$target." \\\n\t".
+		' || ECODE=$$?; } && '."\\\n\t"."\\\n\t"."\\\n\t".
+
+
+		'{ [ $$ECODE != "2" ] || '." \\\n\t".'(install '.
+                $categoryhash{$categoryname}." \\\n\t\t".
+		$sourceroot.'/'.$source." \\\n\t\t".
+		$targetroot.'/'.$target.'.lpmlnew'." \\\n\t\t".
 		' && 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.''.
+		" \\\n\t\t".$logcmd.' && '." \\\n\t\t"."echo -n \"".
+		'You likely need to compare contents of "'."\\\n\t\t\t".
+		'&& echo -n "'.$targetroot.'/'.$target.'"'."\\\n\t\t".
+		'&& echo -n " with the new "'."\\\n\t\t\t".
+                '&& echo "'.$targetroot.'/'.$target.'.lpmlnew"'."\\\n\t\t".
+		"$logcmd); } && "." \\\n\t"."\\\n\t"."\\\n\t".
+
+
+		'{ [ $$ECODE != "3" ] || '."\\\n\t".
+		'(install '.
+                $categoryhash{$categoryname}."\\\n\t\t".
+		$sourceroot.'/'.$source."\\\n\t\t".
+		$targetroot.'/'.$target."\\\n\t\t".
 		' && 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";
+		"\\\n\t\t".$logcmd.' && '."\\\n\t\t".
+		'echo -n "'.
+		'You likely need to review the contents of "'."\\\n\t\t\t".
+		'&& echo -n "'.
+		$targetroot.'/'.$target.'"'."\\\n\t\t\t".
+		'&& echo -n "'.
+		' to make sure its "'."\\\n\t\t".
+		'&& echo "'.
+                'settings are compatible with your overall system"'."\\\n\t\t".
+		"$logcmd); } && "."\\\n\t"."\\\n\t"."\\\n\t".
+
+
+		'{ [ $$ECODE != "1" ] || ('."\\\n\t\t".
+		'echo "**** ERROR ****"'.$logcmd.' && '."\\\n\t\t".'echo -n "'.
+		'Configuration source file does not exist "'."\\\n\t\t".
+		'&& echo -n "'.$sourceroot.'/'.$source.'"'."\\\n\t\t".
+		"$logcmd); } && "."\\\n\t\t".
+		"perl verifymodown.pl ${targetroot}/${target} "."\\\n\t\t\t".
+		"\"$categoryhash{$categoryname}\""."\\\n\t\t\t".
+		"$logcmd;\n\n";
 	}
 	elsif ($mode eq 'build' && $build) {
 	    push @buildall,$sourceroot.'/'.$source;
@@ -1385,7 +1526,10 @@ sub format_fileglob {
     $categorycount{$categoryname}+=scalar(@semi)+1;
     if ($sourcedir) {
 	$parser->get_tag('/fileglob');
-	if ($mode eq 'html') {
+	if ($mode eq 'MANIFEST') {
+         return join("\n",(map {"$sourcedir$_"} split(/\;/,$filenames2)))."\n";
+	}
+	elsif ($mode eq 'html') {
 	    return $fileglob="\n<tr>".
       "<td><!-- POSTEVAL [$categoryname] verify.pl fileglob '$sourcerootarg' ".
 		"'$targetrootarg' ".
@@ -1413,7 +1557,7 @@ sub format_fileglob {
 	    if ($glob eq '*') {
 		$eglob='[^C][^V][^S]'.$glob;
 	    }
-	    return "\t".'install '.
+	    return "\t".'install -p '.
 		$categoryhash{$categoryname}.' '.
 		$sourceroot.'/'.$sourcedir.$eglob.' '.
 		$targetroot.'/'.$targetdir.'.'."\n";
@@ -1507,14 +1651,25 @@ sub format_build {
     }
     return '';
 }
+# ------------------------------------------------ Format installscript section
+sub format_installscript {
+    my @tokeninfo=@_;
+    $installscript= &trim($parser->get_text('/installscript'));
+    if ($installscript) {
+	$parser->get_tag('/installscript');
+	$installscript=~s/([^\\])\\\s+/$1/g; # allow for lines split onto new lines
+    }
+    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;
+    } else {
+        $buildlink='';
     }
     return '';
 }
@@ -1532,12 +1687,25 @@ sub format_status {
 # ------------------------------------------------- Format dependencies section
 sub format_dependencies {
     my @tokeninfo=@_;
-    $dependencies='';
     my $text=&trim($parser->get_text('/dependencies'));
     if ($text) {
 	$parser->get_tag('/dependencies');
-	$dependencies=join(';',
-			      (map {s/^\s*//;s/\s$//;$_} split(/\;/,$text)));
+	$dependencies=join(';',((map {s/^\s*//;s/\s$//;$_} split(/\;/,$text)),$dependencies));
+	$dependencies=~s/;$//;
+    } else {
+        $dependencies='';
+    }
+    return '';
+}
+sub format_privatedependencies {
+    my @tokeninfo=@_;
+    #$dependencies='';
+    my $text=&trim($parser->get_text('/privatedependencies'));
+    if ($text) {
+	$parser->get_tag('/privatedependencies');
+	if ($mode eq 'MANIFEST') { return '';	}
+	$dependencies=join(';',((map {s/^\s*//;s/\s$//;$_} split(/\;/,$text)),$dependencies));
+	$dependencies=~s/;$//;
     }
     return '';
 }