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

Diff for /loncom/publisher/loncfile.pm between versions 1.70 and 1.82

version 1.70, 2005/07/14 22:49:26 version 1.82, 2007/04/20 20:55:01
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;
   use LONCAPA qw(:DEFAULT :match);
   
   
 my $DEBUG=0;  my $DEBUG=0;
 my $r; # Needs to be global for some stuff RF.  my $r; # Needs to be global for some stuff RF.
Line 101  my $r;    # Needs to be global for some Line 102  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 156  sub URLToPath { Line 150  sub URLToPath {
     $Url=~ s/\/+/\//g;      $Url=~ s/\/+/\//g;
     $Url=~ s/^http\:\/\/[^\/]+//;      $Url=~ s/^http\:\/\/[^\/]+//;
     $Url=~ s/^\///;      $Url=~ s/^\///;
     $Url=~ s/(\~|priv\/)(\w+)\//\/home\/$2\/public_html\//;      $Url=~ s/(\~|priv\/)($match_username)\//\/home\/$2\/public_html\//;
     &Debug($r, "Returning $Url \n");      &Debug($r, "Returning $Url \n");
     return $Url;      return $Url;
 }  }
   
 sub url {  sub url {
     my $fn=shift;      my $fn=shift;
     $fn=~s/^\/home\/(\w+)\/public\_html/\/priv\/$1/;      $fn=~s/^\/home\/($match_username)\/public\_html/\/priv\/$1/;
     $fn=&HTML::Entities::encode($fn,'<>"&');      $fn=&HTML::Entities::encode($fn,'<>"&');
     return $fn;      return $fn;
 }  }
   
 sub display {  sub display {
     my $fn=shift;      my $fn=shift;
     $fn=~s-^/home/(\w+)/public_html-/priv/$1-;      $fn=~s-^/home/($match_username)/public_html-/priv/$1-;
     return '<tt>'.$fn.'</tt>';      return '<tt>'.$fn.'</tt>';
 }  }
   
Line 195  sub obsolete_unpub { Line 189  sub obsolete_unpub {
 }  }
   
 # see if directory is empty  # see if directory is empty
 # ignores any .meta, .save and .log files created for a previously  # ignores any .meta, .save, .bak, and .log files created for a previously
 # published file, which has since been marked obsolete and deleted.  # published file, which has since been marked obsolete and deleted.
 sub empty_directory {  sub empty_directory {
     my ($dirname,$phase) = @_;      my ($dirname,$phase) = @_;
     if (opendir DIR, $dirname) {      if (opendir DIR, $dirname) {
         my @files = grep(!/^\.\.?$/, readdir(DIR)); # ignore . and ..          my @files = grep(!/^\.\.?$/, readdir(DIR)); # ignore . and ..
         if (@files) {           if (@files) { 
             my @orphans = grep(/\.(meta|save|log)$/,@files);              my @orphans = grep(/\.(meta|save|log|bak)$/,@files);
             if (scalar(@files) - scalar(@orphans) > 0) {               if (scalar(@files) - scalar(@orphans) > 0) { 
                 return 0;                  return 0;
             } else {              } else {
                 if (($phase eq 'Delete2') && (@orphans > 0)) {                  if (($phase eq 'Delete2') && (@orphans > 0)) {
                     foreach my $file (@orphans) {                      foreach my $file (@orphans) {
                         if ($file =~ /\.(meta|save|log)$/) {                          if ($file =~ /\.(meta|save|log|bak)$/) {
                             unlink($dirname.$file);                              unlink($dirname.$file);
                         }                          }
                     }                      }
Line 306  sub checksuffix { Line 300  sub checksuffix {
     my $newsuffix;      my $newsuffix;
     if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; }      if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; }
     if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }      if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }
     if ($oldsuffix ne $newsuffix) {      if (lc($oldsuffix) ne lc($newsuffix)) {
  $result.=   $result.=
             '<p><font color="red">'.&mt('Warning: change of MIME type!').'</font></p>';              '<p><span class="LC_warning">'.&mt('Warning: change of MIME type!').'</span></p>';
     }      }
     return $result;      return $result;
 }  }
Line 321  sub cleanDest { Line 315  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 469  sub Rename1 { Line 463  sub Rename1 {
     if (-d $fn) {      if (-d $fn) {
  $newfilename=~/\.(\w+)$/;   $newfilename=~/\.(\w+)$/;
  if (&Apache::loncommon::fileembstyle($1) eq 'ssi') {   if (&Apache::loncommon::fileembstyle($1) eq 'ssi') {
     $request->print('<br /><font color="red">'.      $request->print('<br /><span classr="LC_warning">'.
     &mt('Cannot change MIME type of a directory').      &mt('Cannot change MIME type of a directory').
     '</font>'.      '</span>'.
     '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');      '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
     return;      return;
  }   }
Line 755  sub NewFile1 { Line 749  sub NewFile1 {
     return;      return;
  }   }
  if ($newfilename !~ /\Q.$extension\E$/) {   if ($newfilename !~ /\Q.$extension\E$/) {
     if ($newfilename =~ m|^[^\.]*\.([^\.]+)$|) {      if ($newfilename =~ m|/[^/.]*\.(?:[^/.]+)$|) {
  #already has an extension strip it and add in expected one   #already has an extension strip it and add in expected one
  $newfilename =~ s|.([^\.]+)$||;   $newfilename =~ s|(/[^./])\.(?:[^.]+)$|$1|;
     }      }
     $newfilename.=".$extension";      $newfilename.=".$extension";
  }   }
     }      }
     my $result=&exists($user,$domain,$newfilename);      my $result=&exists($user,$domain,$newfilename);
     if($result) {      if($result) {
  $request->print('<font color="red">'.$result.'</font></form>');   $request->print('<span class="LC_error">'.$result.'</span></form>');
     } else {      } else {
  $request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>');   $request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>');
  $request->print('</form>');   $request->print('</form>');
Line 1025  sub Delete2 { Line 1019  sub Delete2 {
   
 =back  =back
   
 Returns 0 failure, and 0 successs.  Returns 0 failure, and 1 successs.
   
 =cut  =cut
   
Line 1033  sub Copy2 { Line 1027  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;
Line 1139  sub phasetwo { Line 1137  sub phasetwo {
           
     &Debug($r, "loncfile - Entering phase 2 for $fn");      &Debug($r, "loncfile - Entering phase 2 for $fn");
           
     # Break down the file into it's component pieces.      # Break down the file into its component pieces.
           
     my $dir; # Directory path      my $dir; # Directory path
     my $main; # Filename.      my $main; # Filename.
Line 1152  sub phasetwo { Line 1150  sub phasetwo {
  $suffix=$1; #This is the actually filename extension if it exists   $suffix=$1; #This is the actually filename extension if it exists
  $main=~s/\.\w+$//; #strip the extension   $main=~s/\.\w+$//; #strip the extension
     }      }
     my $dest;                   # On success this is where we'll go.      my $dest;                       #
           my $dest_dir;                   # On success this is where we'll go.
       my $disp_newname;               #
       my $dest_newname;               #
     &Debug($r,"loncfile::phase2 dir = $dir main = $main suffix = $suffix");      &Debug($r,"loncfile::phase2 dir = $dir main = $main suffix = $suffix");
     &Debug($r,"    newfilename = ".$env{'form.newfilename'});      &Debug($r,"    newfilename = ".$env{'form.newfilename'});
   
Line 1180  sub phasetwo { Line 1180  sub phasetwo {
     if(!&Rename2($r, $uname, $dir, $fn, $env{'form.newfilename'})) {      if(!&Rename2($r, $uname, $dir, $fn, $env{'form.newfilename'})) {
  return;   return;
     }      }
     $dest = $env{'form.newfilename'};      $dest = $dir."/";
       $dest_newname = $env{'form.newfilename'};
       $env{'form.newfilename'} =~ /.+(\/.+$)/;
       $disp_newname = $1;
       $disp_newname =~ s/\///;
  }   }
     } elsif ($env{'form.action'} eq 'delete') {       } elsif ($env{'form.action'} eq 'delete') { 
  if(!&Delete2($r, $uname, $env{'form.newfilename'})) {   if(!&Delete2($r, $uname, $env{'form.newfilename'})) {
Line 1211  sub phasetwo { Line 1215  sub phasetwo {
     if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) {      if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) {
  $r->print('<h3><a href="javascript:self.close()">'.&mt('Done').'</a></h3>');   $r->print('<h3><a href="javascript:self.close()">'.&mt('Done').'</a></h3>');
     } else {      } else {
  $r->print('<h3><a href="'.&url($dest).'">'.&mt('Done').'</a></h3>');          if ($env{'form.action'} eq 'rename') {
               $r->print('<h3><a href="'.&url($dest).'">'.&mt('Return to Directory').'</a></h3>');
               $r->print('<h3><a href="'.&url($dest_newname).'">'.$disp_newname.'</a></h3>');
           } else {
       $r->print('<h3><a href="'.&url($dest).'">'.&mt('Done').'</a></h3>');
    }
     }      }
 }  }
   
Line 1233  sub handler { Line 1242  sub handler {
   
     if ($env{'form.filename'}) {      if ($env{'form.filename'}) {
  &Debug($r, "test: $env{'form.filename'}");   &Debug($r, "test: $env{'form.filename'}");
  $fn=&Apache::lonnet::unescape($env{'form.filename'});   $fn=&unescape($env{'form.filename'});
  $fn=&URLToPath($fn);   $fn=&URLToPath($fn);
     }  elsif($ENV{'QUERY_STRING'} && $env{'form.phase'} ne 'two') {        }  elsif($ENV{'QUERY_STRING'} && $env{'form.phase'} ne 'two') {  
  #Just hijack the script only the first time around to inject the   #Just hijack the script only the first time around to inject the
  #correct information for further processing   #correct information for further processing
  $fn=&Apache::lonnet::unescape($env{'form.decompress'});   $fn=&unescape($env{'form.decompress'});
  $fn=&URLToPath($fn);   $fn=&URLToPath($fn);
  $env{'form.action'}="decompress";   $env{'form.action'}="decompress";
     } elsif ($env{'form.qualifiedfilename'}) {      } elsif ($env{'form.qualifiedfilename'}) {
Line 1277  sub handler { Line 1286  sub handler {
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
     $r->send_http_header;      $r->send_http_header;
   
       my (%loaditem,$js);
   
     if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) {      if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) {
  my $newdirname = $env{'form.newfilename'};   my $newdirname = $env{'form.newfilename'};
  $r->print('<html><head><title>LON-CAPA Construction Space</title><script language="Javascript">');   $js = qq|
  $r->print(qq|  <script type="text/javascript">
 function writeDone() {  function writeDone() {
     var winName = window.opener      var winName = window.opener
     window.focus();      window.focus();
Line 1288  function writeDone() { Line 1299  function writeDone() {
     setTimeout("self.close()",10000)      setTimeout("self.close()",10000)
 }  }
   </script>    </script>
   </head>|);  |;
  my $loaditem = 'onLoad="writeDone()"';   $loaditem{'onload'} = "writeDone()";
  $r->print(&Apache::loncommon::bodytag('Construction Space File Operation','',$loaditem));  
     } else {  
  $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');  
  $r->print(&Apache::loncommon::bodytag('Construction Space File Operation'));  
     }      }
       
       $r->print(&Apache::loncommon::start_page('Construction Space File Operation',
        $js,
        {'add_entries' => \%loaditem,}));
       
     $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');      $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');
       
Line 1329  function writeDone() { Line 1339  function writeDone() {
      $env{'form.action'} eq 'Select Action' ) {       $env{'form.action'} eq 'Select Action' ) {
  $r->print('<h3>'.&mt('New Resource').'</h3>');   $r->print('<h3>'.&mt('New Resource').'</h3>');
     } else {      } else {
  $r->print('<p>'.&mt('Unknown Action').' '.$env{'form.action'}.' </p></body></html>');   $r->print('<p>'.&mt('Unknown Action').' '.$env{'form.action'}.' </p>'.
     &Apache::loncommon::end_page());
  return OK;     return OK;  
     }      }
     if ($env{'form.phase'} eq 'two') {      if ($env{'form.phase'} eq 'two') {
Line 1340  function writeDone() { Line 1351  function writeDone() {
  &phaseone($r,$fn,$uname,$udom);   &phaseone($r,$fn,$uname,$udom);
     }      }
   
     $r->print('</body></html>');      $r->print(&Apache::loncommon::end_page());
     return OK;        return OK;  
 }  }
   
Removed from v.1.70  
changed lines
  Added in v.1.82

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