--- loncom/build/lpml_parse.pl 2002/04/21 23:36:17 1.46 +++ loncom/build/lpml_parse.pl 2003/09/11 22:01:48 1.52 @@ -12,7 +12,7 @@ # The LearningOnline Network with CAPA # lpml_parse.pl - Linux Packaging Markup Language parser # -# $Id: lpml_parse.pl,v 1.46 2002/04/21 23:36:17 harris41 Exp $ +# $Id: lpml_parse.pl,v 1.52 2003/09/11 22:01:48 albertel 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 # ### @@ -298,6 +299,7 @@ my $directories; my $directory; my $targetdirs; my $targetdir; +my $protectionlevel; my $categoryname; my $description; my $files; @@ -351,6 +353,7 @@ $parser->{textify}={ category => \&format_category, abbreviation => \&format_abbreviation, targetdir => \&format_targetdir, + protectionlevel => \&format_protectionlevel, chown => \&format_chown, chmod => \&format_chmod, rpm => \&format_rpm, @@ -383,6 +386,7 @@ $parser->{textify}={ build => \&format_build, status => \&format_status, dependencies => \&format_dependencies, + privatedependencies => \&format_privatedependencies, buildlink => \&format_buildlink, glob => \&format_glob, sourcedir => \&format_sourcedir, @@ -974,6 +978,9 @@ sub format_directories { elsif ($mode eq 'rpm_file_list') { return $text; } + elsif ($mode eq 'uninstall_shell_commands') { + return $text; + } else { return ''; } @@ -981,7 +988,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 +1022,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 +1067,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=@_; @@ -1178,7 +1226,21 @@ sub format_file { if ($source) { $parser->get_tag('/file'); if ($mode eq 'MANIFEST') { - return $source."\n"; + 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". @@ -1255,36 +1317,55 @@ END elsif ($mode eq 'configinstall' && $categoryname eq '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; @@ -1541,12 +1622,24 @@ sub format_status { # ------------------------------------------------- Format dependencies section sub format_dependencies { my @tokeninfo=@_; - $dependencies=''; + #$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/;$//; + } + 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 ''; }