Diff for /loncom/build/lpml_parse.pl between versions 1.45 and 1.51

version 1.45, 2002/04/13 19:29:32 version 1.51, 2002/10/13 17:27:49
Line 47 Line 47
 # 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,1/29,1/31,2/5,3/21,4/8,4/12 - Scott Harrison  # 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
 #  #
 ###  ###
   
Line 298  my $directories; Line 299  my $directories;
 my $directory;  my $directory;
 my $targetdirs;  my $targetdirs;
 my $targetdir;  my $targetdir;
   my $protectionlevel;
 my $categoryname;  my $categoryname;
 my $description;  my $description;
 my $files;  my $files;
Line 351  $parser->{textify}={ Line 353  $parser->{textify}={
     category => \&format_category,      category => \&format_category,
     abbreviation => \&format_abbreviation,      abbreviation => \&format_abbreviation,
     targetdir => \&format_targetdir,      targetdir => \&format_targetdir,
       protectionlevel => \&format_protectionlevel,
     chown => \&format_chown,      chown => \&format_chown,
     chmod => \&format_chmod,      chmod => \&format_chmod,
     rpm => \&format_rpm,      rpm => \&format_rpm,
Line 974  sub format_directories { Line 977  sub format_directories {
     elsif ($mode eq 'rpm_file_list') {      elsif ($mode eq 'rpm_file_list') {
  return $text;   return $text;
     }      }
       elsif ($mode eq 'uninstall_shell_commands') {
    return $text;
       }
     else {      else {
  return '';   return '';
     }      }
Line 981  sub format_directories { Line 987  sub format_directories {
 # ---------------------------------------------------- Format directory section  # ---------------------------------------------------- Format directory section
 sub format_directory {  sub format_directory {
     my (@tokeninfo)=@_;      my (@tokeninfo)=@_;
     $targetdir='';$categoryname='';$description='';      $targetdir='';$categoryname='';$description='';$protectionlevel='';
     $parser->get_text('/directory');      $parser->get_text('/directory');
     $parser->get_tag('/directory');      $parser->get_tag('/directory');
     $directory_count++;      $directory_count++;
Line 1015  sub format_directory { Line 1021  sub format_directory {
     elsif ($mode eq 'rpm_file_list') {      elsif ($mode eq 'rpm_file_list') {
  return $targetroot.'/'.$targetdir."\n";   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 {      else {
  return '';   return '';
     }      }
Line 1030  sub format_targetdir { Line 1066  sub format_targetdir {
     }      }
     return '';      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  # ------------------------------------------------- Format categoryname section
 sub format_categoryname {  sub format_categoryname {
     my @tokeninfo=@_;      my @tokeninfo=@_;
Line 1056  sub format_description { Line 1103  sub format_description {
 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');
     if ($mode eq 'html') {      if ($mode eq 'MANIFEST') {
    return $text;
       }
       elsif ($mode eq 'html') {
  return $directories="\n<br />&nbsp;<br />".   return $directories="\n<br />&nbsp;<br />".
     "<a name='files' />".      "<a name='files' />".
     "<font size='+2'>Files</font><br />&nbsp;<br />".      "<font size='+2'>Files</font><br />&nbsp;<br />".
Line 1174  sub format_file { Line 1224  sub format_file {
     $categorycount{$categoryname}++;      $categorycount{$categoryname}++;
     if ($source) {      if ($source) {
  $parser->get_tag('/file');   $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)));
       return $retval."\n";
    }
    elsif ($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' ".
Line 1249  END Line 1313  END
  elsif ($mode eq 'configinstall' && $categoryname eq 'conf') {   elsif ($mode eq 'configinstall' && $categoryname eq 'conf') {
     push @configall,$targetroot.'/'.$target;      push @configall,$targetroot.'/'.$target;
     return $targetroot.'/'.$target.': alwaysrun'."\n".      return $targetroot.'/'.$target.': alwaysrun'."\n".
  "\t".'@echo -n ""; ECODE=0 && { perl filecompare.pl -b4 '.   "\t".'@# Compare source with target and intelligently respond'.
  $sourceroot.'/'.$source.' '.$targetroot.'/'.$target.   "\n\t\n\t\n".
  ' || ECODE=$$?; } && '.  
  '{ [ $$ECODE != "2" ] || (install '.  
                 $categoryhash{$categoryname}.' '.   "\t".'@echo -n ""; ECODE=0 && { perl filecompare.pl -b4 \\'.
  $sourceroot.'/'.$source.' '.   "\n\t".$sourceroot.'/'.$source." \\\n\t".
  $targetroot.'/'.$target.'.lpmlnew'.   $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 ****"'.   ' && echo "**** NOTE: CONFIGURATION FILE CHANGE ****"'.
  $logcmd.' && echo "'.   " \\\n\t\t".$logcmd.' && '." \\\n\t\t"."echo -n \"".
  'You likely need to compare contents of '.   'You likely need to compare contents of "'."\\\n\t\t\t".
  ''.$targetroot.'/'.$target.' with the new '.   '&& echo -n "'.$targetroot.'/'.$target.'"'."\\\n\t\t".
                 ''.$targetroot.'/'.$target.'.lpmlnew"'.   '&& echo -n " with the new "'."\\\n\t\t\t".
  "$logcmd); } && ".                  '&& echo "'.$targetroot.'/'.$target.'.lpmlnew"'."\\\n\t\t".
  '{ [ $$ECODE != "3" ] || (install '.   "$logcmd); } && "." \\\n\t"."\\\n\t"."\\\n\t".
                 $categoryhash{$categoryname}.' '.  
  $sourceroot.'/'.$source.' '.  
  $targetroot.'/'.$target.''.   '{ [ $$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 ****"'.   ' && echo "**** WARNING: NEW CONFIGURATION FILE ADDED ****"'.
  $logcmd.' && echo "'.   "\\\n\t\t".$logcmd.' && '."\\\n\t\t".
  'You likely need to review the contents of '.   'echo -n "'.
  ''.$targetroot.'/'.$target.' to make sure its '.   'You likely need to review the contents of "'."\\\n\t\t\t".
                 'settings are compatible with your overall system"'.   '&& echo -n "'.
  "$logcmd); } && ".   $targetroot.'/'.$target.'"'."\\\n\t\t\t".
  '{ [ $$ECODE != "1" ] || ('.   '&& echo -n "'.
  'echo "**** ERROR ****"'.   ' to make sure its "'."\\\n\t\t".
  $logcmd.' && echo "'.   '&& echo "'.
  'Configuration source file does not exist '.                  'settings are compatible with your overall system"'."\\\n\t\t".
  ''.$sourceroot.'/'.$source.'"'.   "$logcmd); } && "."\\\n\t"."\\\n\t"."\\\n\t".
       "$logcmd); } && perl verifymodown.pl ${targetroot}/${target} \"".  
  "$categoryhash{$categoryname}\"$logcmd;\n\n";  
    '{ [ $$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) {   elsif ($mode eq 'build' && $build) {
     push @buildall,$sourceroot.'/'.$source;      push @buildall,$sourceroot.'/'.$source;
Line 1385  sub format_fileglob { Line 1468  sub format_fileglob {
     $categorycount{$categoryname}+=scalar(@semi)+1;      $categorycount{$categoryname}+=scalar(@semi)+1;
     if ($sourcedir) {      if ($sourcedir) {
  $parser->get_tag('/fileglob');   $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>".      return $fileglob="\n<tr>".
       "<td><!-- POSTEVAL [$categoryname] verify.pl fileglob '$sourcerootarg' ".        "<td><!-- POSTEVAL [$categoryname] verify.pl fileglob '$sourcerootarg' ".
  "'$targetrootarg' ".   "'$targetrootarg' ".

Removed from v.1.45  
changed lines
  Added in v.1.51


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