[BACK]Return to lonpublisher.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / publisher

Diff for /loncom/publisher/lonpublisher.pm between versions 1.107 and 1.114

version 1.107, 2002/11/06 22:36:08 version 1.114, 2003/03/07 17:55:05
Line 33 Line 33
 # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer  # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
 # 03/23 Guy Albertelli  # 03/23 Guy Albertelli
 # 03/24,03/29,04/03 Gerd Kortemeyer  # 03/24,03/29,04/03 Gerd Kortemeyer
 # 04/16/2001 Scott Harrison  
 # 05/03,05/05,05/07 Gerd Kortemeyer  # 05/03,05/05,05/07 Gerd Kortemeyer
 # 05/28/2001 Scott Harrison  
 # 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26,10/16 Gerd Kortemeyer  # 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26,10/16 Gerd Kortemeyer
 # 12/04,12/05 Guy Albertelli  # 12/04,12/05 Guy Albertelli
 # 12/05 Gerd Kortemeyer  # 12/05 Gerd Kortemeyer
 # 12/05 Guy Albertelli  # 12/05 Guy Albertelli
 # 12/06,12/07 Gerd Kortemeyer  # 12/06,12/07 Gerd Kortemeyer
 # 12/15,12/16 Scott Harrison  
 # 12/25 Gerd Kortemeyer  # 12/25 Gerd Kortemeyer
 # YEAR=2002  # YEAR=2002
 # 1/16,1/17 Scott Harrison  
 # 1/17 Gerd Kortemeyer  # 1/17 Gerd Kortemeyer
 #  #
 ###  ###
Line 121  use File::Copy; Line 117  use File::Copy;
 use Apache::Constants qw(:common :http :methods);  use Apache::Constants qw(:common :http :methods);
 use HTML::LCParser;  use HTML::LCParser;
 use Apache::lonxml;  use Apache::lonxml;
 use Apache::lonhomework;  
 use Apache::loncacc;  use Apache::loncacc;
 use DBI;  use DBI;
 use Apache::lonnet();  use Apache::lonnet();
Line 794  This is the workhorse function of this m Line 789  This is the workhorse function of this m
 backup copies, performs any automatic processing (prior to publication,  backup copies, performs any automatic processing (prior to publication,
 especially for rat and ssi files),  especially for rat and ssi files),
   
   Returns a 2 element array, the first is the string to be shown to the
   user, the second is an error code, either 1 (an error occured) or 0
   (no error occurred)
   
 I<Additional documentation needed.>  I<Additional documentation needed.>
   
 =cut  =cut
Line 810  sub publish { Line 809  sub publish {
     my %allow=();      my %allow=();
   
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
  return    return ('<font color="red">No write permission to user directory, FAIL</font>',1);
          '<font color=red>No write permission to user directory, FAIL</font>';  
     }      }
     print $logfile       print $logfile 
 "\n\n================= Publish ".localtime()." Phase One  ================\n";  "\n\n================= Publish ".localtime()." Phase One  ================\n";
Line 825  sub publish { Line 823  sub publish {
     print $logfile "Copied original file to ".$copyfile."\n";      print $logfile "Copied original file to ".$copyfile."\n";
         } else {          } else {
     print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";      print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";
           return "<font color=red>Failed to write backup copy, $!,FAIL</font>";      return ("<font color=\"red\">Failed to write backup copy, $!,FAIL</font>",1);
         }          }
 # ------------------------------------------------------------- IDs and indices  # ------------------------------------------------------------- IDs and indices
   
  my ($outstring,$error);   my ($outstring,$error);
  ($outstring,$error,%allow)=&fix_ids_and_indices($logfile,$source,   ($outstring,$error,%allow)=&fix_ids_and_indices($logfile,$source,
  $target);   $target);
  if ($error) { return $outstring; }   if ($error) { return ($outstring,$error); }
 # ------------------------------------------------------------ Construct Allows  # ------------------------------------------------------------ Construct Allows
           
  $scrout.='<h3>Dependencies</h3>';   $scrout.='<h3>Dependencies</h3>';
Line 877  sub publish { Line 875  sub publish {
           my $org;            my $org;
           unless ($org=Apache::File->new('>'.$source)) {            unless ($org=Apache::File->new('>'.$source)) {
              print $logfile "No write permit to $source\n";               print $logfile "No write permit to $source\n";
              return                return ('<font color="red">No write permission to '.$source.
  '<font color="red">No write permission to '.$source.       ', FAIL</font>',1);
  ', FAIL</font>';  
   }    }
           print($org $outstring);            print($org $outstring);
         }          }
Line 1127  END Line 1124  END
     my $copyright_help =      my $copyright_help =
         Apache::loncommon::help_open_topic('Publishing_Copyright');          Apache::loncommon::help_open_topic('Publishing_Copyright');
     $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;      $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;
     return $scrout.      return ($scrout.'<p><input type="submit" value="Finalize Publication" /></p></form>',0);
         '<p><input type="submit" value="Finalize Publication" /></p></form>';  
 # =============================================================================  # =============================================================================
 # BATCH MODE  # BATCH MODE
 #  #
Line 1156  END Line 1152  END
  $ENV{'form.copyright'}='default';   $ENV{'form.copyright'}='default';
     }       } 
     $ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta);      $ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta);
     return $scrout;      return ($scrout,0);
   }    }
 }  }
   
Line 1203  sub phasetwo { Line 1199  sub phasetwo {
     my ($r,$source,$target,$style,$distarget,$batch)=@_;      my ($r,$source,$target,$style,$distarget,$batch)=@_;
     $source=~s/\/+/\//g;      $source=~s/\/+/\//g;
     $target=~s/\/+/\//g;      $target=~s/\/+/\//g;
   
       if ($target=~/\_\_\_/) {
    $r->print(
    '<font color="red">Unsupported character combination "<tt>___</tt>" in filename, FAIL</font>');
           return 0;
       }
     $distarget=~s/\/+/\//g;      $distarget=~s/\/+/\//g;
     my $logfile;      my $logfile;
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
  return    $r->print(
             '<font color=red>No write permission to user directory, FAIL</font>';          '<font color="red">No write permission to user directory, FAIL</font>');
           return 0;
     }      }
     print $logfile       print $logfile 
         "\n================= Publish ".localtime()." Phase Two  ================\n";          "\n================= Publish ".localtime()." Phase Two  ================\n";
Line 1247  sub phasetwo { Line 1250  sub phasetwo {
         my $mfh;          my $mfh;
         unless ($mfh=Apache::File->new('>'.$source.'.meta')) {          unless ($mfh=Apache::File->new('>'.$source.'.meta')) {
             return               return 
                 '<font color=red>Could not write metadata, FAIL</font>';                  '<font color="red">Could not write metadata, FAIL</font>';
         }          }
         foreach (sort keys %metadatafields) {          foreach (sort keys %metadatafields) {
             unless ($_=~/\./) {              unless ($_=~/\./) {
Line 1299  sub phasetwo { Line 1302  sub phasetwo {
         my $srcd=$1;          my $srcd=$1;
         unless ($srcd=~/^\/home\/httpd\/html\/res/) {          unless ($srcd=~/^\/home\/httpd\/html\/res/) {
             print $logfile "\nPANIC: Target dir is ".$srcd;              print $logfile "\nPANIC: Target dir is ".$srcd;
             return "<font color=red>Invalid target directory, FAIL</font>";              return "<font color=\"red\">Invalid target directory, FAIL</font>";
         }          }
         opendir(DIR,$srcd);          opendir(DIR,$srcd);
         while ($filename=readdir(DIR)) {          while ($filename=readdir(DIR)) {
Line 1324  sub phasetwo { Line 1327  sub phasetwo {
             $r->print('<p>Copied old target file');              $r->print('<p>Copied old target file');
         } else {          } else {
     print $logfile "Unable to write ".$copyfile.':'.$!."\n";      print $logfile "Unable to write ".$copyfile.':'.$!."\n";
             return "<font color=red>Failed to copy old target, $!, FAIL</font>";              return "<font color=\"red\">Failed to copy old target, $!, FAIL</font>";
         }          }
                   
 # --------------------------------------------------------------- Copy Metadata  # --------------------------------------------------------------- Copy Metadata
Line 1338  sub phasetwo { Line 1341  sub phasetwo {
     print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";      print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
             if (-e $target.'.meta') {              if (-e $target.'.meta') {
                 return                   return 
                     "<font color=red>Failed to write old metadata copy, $!, FAIL</font>";                      "<font color=\"red\">Failed to write old metadata copy, $!, FAIL</font>";
     }      }
         }          }
                   
Line 1369  sub phasetwo { Line 1372  sub phasetwo {
         $r->print('<p>Copied source file');          $r->print('<p>Copied source file');
     } else {      } else {
         print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";          print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
         return "<font color=red>Failed to copy source, $!, FAIL</font>";          return "<font color=\"red\">Failed to copy source, $!, FAIL</font>";
     }      }
           
 # --------------------------------------------------------------- Copy Metadata  # --------------------------------------------------------------- Copy Metadata
Line 1382  sub phasetwo { Line 1385  sub phasetwo {
     } else {      } else {
         print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";          print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
         return           return 
             "<font color=red>Failed to write metadata copy, $!, FAIL</font>";              "<font color=\"red\">Failed to write metadata copy, $!, FAIL</font>";
     }      }
     $r->rflush;      $r->rflush;
 # --------------------------------------------------- Send update notifications  # --------------------------------------------------- Send update notifications
Line 1470  sub batchpublish { Line 1473  sub batchpublish {
   
 # phase one takes  # phase one takes
 #  my ($source,$target,$style,$batch)=@_;  #  my ($source,$target,$style,$batch)=@_;
     $r->print('<p>'.&publish($srcfile,$targetfile,$thisembstyle,1).'</p>');      my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1);
       $r->print('<p>'.$outstring.'</p>');
 # phase two takes  # phase two takes
 # my ($source,$target,$style,$distarget,batch)=@_;  # my ($source,$target,$style,$distarget,batch)=@_;
 # $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},...  # $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},...
     $r->print('<p>');      if (!$error) {
     &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);   $r->print('<p>');
     $r->print('</p>');   &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
    $r->print('</p>');
       }
     return '';      return '';
 }  }
   
Line 1591  sub handler { Line 1597  sub handler {
   
 # -------------------------------------------------------------- Check filename  # -------------------------------------------------------------- Check filename
   
   my $fn=$ENV{'form.filename'};    my $fn=&Apache::lonnet::unescape($ENV{'form.filename'});
   
       
   unless ($fn) {     unless ($fn) { 
Line 1721  unless ($ENV{'form.phase'} eq 'two') { Line 1727  unless ($ENV{'form.phase'} eq 'two') {
 # ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.  # ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.
   
        unless ($ENV{'form.phase'} eq 'two') {         unless ($ENV{'form.phase'} eq 'two') {
          $r->print(     my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle);
           '<hr />'.&publish($thisfn,$thistarget,$thisembstyle));     $r->print('<hr />'.$outstring);
        } else {         } else {
            $r->print('<hr />');             $r->print('<hr />');
            &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget);              &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget); 
        }           }
   
   }    }
   $r->print('</body></html>');    $r->print('</body></html>');
   
Removed from v.1.107  
changed lines
  Added in v.1.114

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