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

Diff for /loncom/publisher/loncfile.pm between versions 1.68 and 1.74

version 1.68, 2005/05/25 22:27:17 version 1.74, 2005/11/09 09:06:59
Line 69  use File::Copy; Line 69  use File::Copy;
 use HTML::Entities();  use HTML::Entities();
 use Apache::Constants qw(:common :http :methods);  use Apache::Constants qw(:common :http :methods);
 use Apache::loncacc;  use Apache::loncacc;
 use Apache::Log ();  
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon();  use Apache::loncommon();
 use Apache::lonlocal;  use Apache::lonlocal;
Line 101  my $r;    # Needs to be global for some Line 100  my $r;    # Needs to be global for some
 =cut  =cut
   
 sub Debug {  sub Debug {
     
     # Marshall the parameters.  
     
     my $r       = shift;  
     my $log     = $r->log;  
     my $message = shift;  
     
     # Put out the indicated message butonly if DEBUG is true.      # Put out the indicated message butonly if DEBUG is true.
     
     if ($DEBUG) {      if ($DEBUG) {
    my ($r,$message) = @_;
  $r->log_reason($message);   $r->log_reason($message);
     }      }
 }  }
Line 194  sub obsolete_unpub { Line 186  sub obsolete_unpub {
     }      }
 }  }
   
   # see if directory is empty
   # ignores any .meta, .save, .bak, and .log files created for a previously
   # published file, which has since been marked obsolete and deleted.
   sub empty_directory {
       my ($dirname,$phase) = @_;
       if (opendir DIR, $dirname) {
           my @files = grep(!/^\.\.?$/, readdir(DIR)); # ignore . and ..
           if (@files) { 
               my @orphans = grep(/\.(meta|save|log|bak)$/,@files);
               if (scalar(@files) - scalar(@orphans) > 0) { 
                   return 0;
               } else {
                   if (($phase eq 'Delete2') && (@orphans > 0)) {
                       foreach my $file (@orphans) {
                           if ($file =~ /\.(meta|save|log|bak)$/) {
                               unlink($dirname.$file);
                           }
                       }
                   }
               }
           }
           closedir(DIR);
           return 1;
       }
       return 0;
   }
   
 =pod  =pod
   
Line 296  sub cleanDest { Line 313  sub cleanDest {
  $foundbad=1;   $foundbad=1;
  $dest=~s/\.//g;   $dest=~s/\.//g;
     }      }
     if  ($dest=~/[\#\?&%\"]/) {      if  ($dest=~/[\#\?&%\":]/) {
  $foundbad=1;   $foundbad=1;
  $dest=~s/[\#\?&%\"]//g;   $dest=~s/[\#\?&%\":]//g;
     }      }
     if ($dest=~m|/|) {      if ($dest=~m|/|) {
  my ($newpath)=($dest=~m|(.*)/|);   my ($newpath)=($dest=~m|(.*)/|);
Line 519  sub Delete1 { Line 536  sub Delete1 {
     if( -e $fn) {      if( -e $fn) {
  $request->print('<input type="hidden" name="newfilename" value="'.   $request->print('<input type="hidden" name="newfilename" value="'.
  $fn.'"/>');   $fn.'"/>');
  unless (&obsolete_unpub($user,$domain,$fn)) {          if (-d $fn) {
     $request->print('<h3>'.&mt('Cannot delete non-obsolete published file').'</h3>'.              unless (&empty_directory($fn,'Delete1')) {
                   $request->print('<h3>'.&mt('Only empty directories may be deleted.').'</h3>'.
                               'You must delete the contents of the directory first.<br />'.
                               '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
                   return;
               }
           } else { 
       unless (&obsolete_unpub($user,$domain,$fn)) {
           $request->print('<h3>'.&mt('Cannot delete non-obsolete published file').'</h3>'.
     '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');      '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
     return;          return;
  }      }
           }
  $request->print('<p>'.&mt('Delete').' '.&display($fn).'?</p>');   $request->print('<p>'.&mt('Delete').' '.&display($fn).'?</p>');
  &CloseForm1($request, $fn);   &CloseForm1($request, $fn);
     } else {      } else {
Line 710  sub NewFile1 { Line 736  sub NewFile1 {
         ##Informs User (name).(number).(extension) not allowed           ##Informs User (name).(number).(extension) not allowed 
  if($newfilename =~ /\.(\d+)\.(\w+)$/){   if($newfilename =~ /\.(\d+)\.(\w+)$/){
     $r->print('<font color="red">'.$newfilename.      $r->print('<font color="red">'.$newfilename.
       ' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').')'.        ' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').') '.
         ' '.&mt('Not Allowed').'</font>');
       return;
    }
    if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){
       $r->print('<font color="red">'.$newfilename.
         ' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '.
       ' '.&mt('Not Allowed').'</font>');        ' '.&mt('Not Allowed').'</font>');
     return;      return;
  }   }
Line 932  Returns: Line 964  Returns:
   
 sub Delete2 {  sub Delete2 {
     my ($request, $user, $filename) = @_;      my ($request, $user, $filename) = @_;
     if(opendir DIR, $filename) {       if (-d $filename) { 
  my @files=readdir(DIR);   unless (&empty_directory($filename,'Delete2')) { 
  shift @files; shift @files; # takes off . and ..  
  if(@files) {   
     $request->print('<font color="red"> '.&mt('Error: Directory Non Empty').'</font>');       $request->print('<font color="red"> '.&mt('Error: Directory Non Empty').'</font>'); 
     return 0;      return 0;
  } else {      } else {   
Line 987  sub Delete2 { Line 1017  sub Delete2 {
   
 =back  =back
   
 Returns 0 failure, and 0 successs.  Returns 0 failure, and 1 successs.
   
 =cut  =cut
   
Line 995  sub Copy2 { Line 1025  sub Copy2 {
     my ($request, $username, $dir, $oldfile, $newfile) = @_;      my ($request, $username, $dir, $oldfile, $newfile) = @_;
     &Debug($request ,"Will try to copy $oldfile to $newfile");      &Debug($request ,"Will try to copy $oldfile to $newfile");
     if(-e $oldfile) {      if(-e $oldfile) {
           if ($oldfile eq $newfile) {
               $request->print('<font color="red"> '.&mt('Warning').': '.&mt('Name of new file is the same as name of old file').' - '.&mt('no action taken').'.</font>');
               return 1;
           }
  unless (copy($oldfile, $newfile)) {   unless (copy($oldfile, $newfile)) {
     $request->print('<font color="red"> '.&mt('copy Error').': '.$!.'</font>');      $request->print('<font color="red"> '.&mt('copy Error').': '.$!.'</font>');
     return 0;      return 0;
Removed from v.1.68  
changed lines
  Added in v.1.74

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