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

Diff for /loncom/publisher/loncfile.pm between versions 1.121 and 1.125

version 1.121, 2013/07/23 13:40:20 version 1.125, 2019/03/06 02:31:16
Line 109  sub Debug { Line 109  sub Debug {
 }  }
   
 sub done {  sub done {
     my ($url) = @_;      my ($destfn) = @_;
     return      return
        '<p>'         '<p>'
       .&Apache::lonhtmlcommon::confirm_success(&mt("Done"))        .&Apache::lonhtmlcommon::confirm_success(&mt("Done"))
       .'<br /><a href="'.$url.'">'.&mt("Continue").'</a>'        .'<br /><a href="'.&url($destfn).'">'.&mt("Continue").'</a>'
       .'<script type="text/javascript">'        .'<script type="text/javascript">'
       .'location.href="'.$url.'";'        .'location.href="'.&url($destfn,'js').'";'
       .'</script>'        .'</script>'
       .'</p>';        .'</p>';
 }  }
Line 167  sub URLToPath { Line 167  sub URLToPath {
 }  }
   
 sub url {  sub url {
     my $fn=shift;      my ($fn,$context) = @_;
     my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};      my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     $fn=~ s/^\Q$londocroot\E//;      $fn=~ s/^\Q$londocroot\E//;
     $fn=~s{/\./}{/}g;      $fn=~s{/\./}{/}g;
     $fn=&HTML::Entities::encode($fn,'<>"&');      if ($context eq 'js') {
           &js_escape(\$fn);
       } else {
           $fn=&HTML::Entities::encode($fn,'\'<>"&');
       }
     return $fn;      return $fn;
 }  }
   
Line 279  sub exists { Line 283  sub exists {
     $published=~s{^\Q$londocroot/priv/\E}{$londocroot/res/};      $published=~s{^\Q$londocroot/priv/\E}{$londocroot/res/};
     my ($type,$result);      my ($type,$result);
     if ( -d $construct ) {      if ( -d $construct ) {
  return ('error','<p><span class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</span></p>');   return ('error','<p class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</p>');
   
     }      }
   
     if ( -e $published) {      if ( -e $published) {
  if ( -e $construct ) {   if ( -e $construct ) {
     $type = 'warning';      $type = 'warning';
     $result.='<p><span class="LC_warning">'.&mt('Warning: target file exists, and has been published!').'</span></p>';      $result.='<p class="LC_warning">'.&mt('Warning: target file exists, and has been published!').'</p>';
  } else {   } else {
     my $published_type = (-d $published) ? 'directory' : 'file';      my $published_type = (-d $published) ? 'directory' : 'file';
   
     if ($published_type eq $creating) {      if ($published_type eq $creating) {
  $type = 'warning';   $type = 'warning';
  $result.='<p><span class="LC_warning">'.&mt("Warning: a published $published_type of this name exists.").'</span></p>';   $result.='<p class="LC_warning">'.&mt("Warning: a published $published_type of this name exists.").'</p>';
     } else {      } else {
  $type = 'error';   $type = 'error';
  $result.='<p><span class="LC_error">'.&mt("Error: a published $published_type of this name exists.").'</span></p>';   $result.='<p class="LC_error">'.&mt("Error: a published $published_type of this name exists.").'</p>';
     }      }
  }   }
     } elsif ( -e $construct) {      } elsif ( -e $construct) {
  $type = 'warning';   $type = 'warning';
  $result.='<p><span class="LC_warning">'.&mt('Warning: target file exists!').'</span></p>';   $result.='<p class="LC_warning">'.&mt('Warning: target file exists!').'</p>';
     }      }
   
     return ($type,$result);      return ($type,$result);
Line 344  sub checksuffix { Line 348  sub checksuffix {
     if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }      if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }
     if (lc($oldsuffix) ne lc($newsuffix)) {      if (lc($oldsuffix) ne lc($newsuffix)) {
  $result.=   $result.=
             '<p><span class="LC_warning">'.&mt('Warning: change of MIME type!').'</span></p>';              '<p class="LC_warning">'.&mt('Warning: change of MIME type!').'></p>';
     }      }
     return $result;      return $result;
 }  }
   
 sub cleanDest {  sub cleanDest {
     my ($request,$dest,$subdir,$fn,$uname,$udom)=@_;      my ($dest,$subdir,$fn,$uname,$udom)=@_;
     #remove bad characters      #remove bad characters
     my $foundbad=0;      my $foundbad=0;
       my $warnings;
     my $error='';      my $error='';
     if ($subdir && $dest =~/\./) {      if ($subdir && $dest =~/\./) {
  $foundbad=1;   $foundbad=1;
Line 367  sub cleanDest { Line 372  sub cleanDest {
  my ($newpath)=($dest=~m|(.*)/|);   my ($newpath)=($dest=~m|(.*)/|);
  ($newpath,$error)=&relativeDest($fn,$newpath,$uname,$udom);   ($newpath,$error)=&relativeDest($fn,$newpath,$uname,$udom);
  if (! -d "$newpath") {   if (! -d "$newpath") {
     $request->print('<p><span class="LC_warning">'      $warnings = '<p class="LC_warning">'
                            .&mt("You have requested to create file in directory [_1] which doesn't exist. The requested directory path has been removed from the requested filename."                         .&mt("You have requested to create file in directory [_1] which doesn't exist. The requested directory path has been removed from the requested filename."
                                ,&display($newpath))                             ,&display($newpath))
                            .'</span></p>');                         .'</p>';
     $dest=~s|.*/||;      $dest=~s|.*/||;
  }   }
     }      }
     if ($dest =~ /\.(\d+)\.(\w+)$/){      if ($dest =~ /\.(\d+)\.(\w+)$/) {
  $request->print('<p><span class="LC_warning">'   $warnings .= '<p class="LC_warning">'
  .&mt('Bad filename [_1]',&display($dest))                      .&mt('Bad filename [_1]',&display($dest))
                         .'<br />'                      .'<br />'
                         .&mt('[_1](name).(number).(extension)[_2] not allowed.','<tt>','</tt>')                      .&mt('[_1](name).(number).(extension)[_2] not allowed.','<tt>','</tt>')
                         .'<br />'                      .'<br />'
                         .&mt('Removing the [_1].number.[_2] from requested filename.','<tt>','</tt>')                      .&mt('Removing the [_1].number.[_2] from requested filename.','<tt>','</tt>')
  .'</span></p>');                      .'</p>';
  $dest =~ s/\.(\d+)(\.\w+)$/$2/;   $dest =~ s/\.(\d+)(\.\w+)$/$2/;
     }      }
     if ($foundbad) {      if ($foundbad) {
         $request->print('<p><span class="LC_warning">'          $warnings .= '<p class="LC_warning">'
                        .&mt('Invalid characters in requested name have been removed.')                      .&mt('Invalid characters in requested name have been removed.')
                         .'</span></p>'                      .'</p>';
         );  
     }      }
     return ($dest,$error);      return ($dest,$error,$warnings);
 }  }
   
 sub relativeDest {  sub relativeDest {
Line 469  Parameters: Line 473  Parameters:
   
 sub CloseForm2 {  sub CloseForm2 {
     my ($request, $user, $fn) = @_;      my ($request, $user, $fn) = @_;
     $request->print(&done(&url($fn)));      $request->print(&done($fn));
 }  }
   
 =pod  =pod
Line 708  sub Copy1 { Line 712  sub Copy1 {
         my ($dir,$fname) = ($fn =~ m{^(.+/)([^/]+)$});          my ($dir,$fname) = ($fn =~ m{^(.+/)([^/]+)$});
         my $filesize = $fileinfo[7];          my $filesize = $fileinfo[7];
         $filesize = int($filesize/1000); #expressed in kb          $filesize = int($filesize/1000); #expressed in kb
         my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$domain/$user";          my $output = &Apache::loncommon::excess_filesize_warning($user,$domain,'author',
         my $output = &Apache::loncommon::excess_filesize_warning($user,$domain,$authorspace,  
                                                                  $fname,$filesize,'copy');                                                                   $fname,$filesize,'copy');
         if ($output) {          if ($output) {
             $request->print($output.'<br /><a href="'.&url($dir).'">'.&mt('Cancel').'</a></form>');              $request->print($output.'<br /><a href="'.&url($dir).'">'.&mt('Cancel').'</a></form>');
Line 841  Parameters: Line 844  Parameters:
   
 =item   $newfilename  =item   $newfilename
                   - Name of the file to be created; no path information                    - Name of the file to be created; no path information
   
   =item   $warnings - Information about changes to filename made by cleanDest().
   
 =back  =back
   
 Side Effects:  Side Effects:
Line 857  button which returns you to the director Line 863  button which returns you to the director
 =cut  =cut
   
 sub NewFile1 {  sub NewFile1 {
     my ($request, $user, $domain, $fn, $newfilename) = @_;      my ($request, $user, $domain, $fn, $newfilename, $warnings) = @_;
     return if (&filename_check($newfilename) ne 'ok');      return if (&filename_check($newfilename,$warnings) ne 'ok');
   
     if ($env{'form.action'} =~ /new(.+)file/) {      if ($env{'form.action'} =~ /new(.+)file/) {
  my $extension=$1;   my $extension=$1;
Line 871  sub NewFile1 { Line 877  sub NewFile1 {
  }   }
     }      }
     my ($type, $result)=&exists($user,$domain,$newfilename);      my ($type, $result)=&exists($user,$domain,$newfilename);
     $request->print($result);  
     if ($type eq 'error') {      if ($type eq 'error') {
           $request->print($warnings.$result);
  $request->print('</form>');   $request->print('</form>');
     } else {      } else {
         my $extension;          my $extension;
Line 884  sub NewFile1 { Line 890  sub NewFile1 {
         my @okexts = qw(xml html xhtml htm xhtm problem page sequence rights sty task library js css txt);          my @okexts = qw(xml html xhtml htm xhtm problem page sequence rights sty task library js css txt);
         if (($extension eq '') || (!grep(/^\Q$extension\E/,@okexts))) {          if (($extension eq '') || (!grep(/^\Q$extension\E/,@okexts))) {
             my $validexts = '.'.join(', .',@okexts);              my $validexts = '.'.join(', .',@okexts);
               $request->print($warnings.$result);
             $request->print('<p class="LC_warning">'.              $request->print('<p class="LC_warning">'.
                 &mt('Invalid filename: ').&display($newfilename).'</p><p>'.                  &mt('Invalid filename: ').&display($newfilename).'</p><p>'.
                 &mt('The name of the new file needs to end with an appropriate file extension to indicate the type of file to create.').'<br />'.                  &mt('The name of the new file needs to end with an appropriate file extension to indicate the type of file to create.').'<br />'.
Line 896  sub NewFile1 { Line 903  sub NewFile1 {
                 '</span></form></p>'.                  '</span></form></p>'.
                 '<p><form action="'.&url($fn).                  '<p><form action="'.&url($fn).
                 '" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></form></p>');                  '" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></form></p>');
             return;          } elsif (($type ne 'warning') && ($warnings eq '') && ($result eq '')) {
               my $query = "";
               $query .= "?mode=" . $env{'form.mode'} unless (!exists($env{'form.mode'}) || !length($env{'form.mode'}));
               $request->print('
                   <script type="text/javascript">
                       window.location = "'.&url($newfilename,'js'). $query .'";
                   </script>');
           } else {
               $request->print($warnings.$result);
               $request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>');
               $request->print('</form>');
               $request->print('<form action="'.&url($newfilename).
                           '" method="post"><p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
               $request->print('<form action="'.&url($fn).
                           '" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
         }          }
   
  $request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>');  
  $request->print('</form>');  
   
  $request->print('<form action="'.&url($newfilename).  
  '" method="post"><p><input type="submit" value="'.&mt('Continue').'" /></p></form>');  
  $request->print('<form action="'.&url($fn).  
  '" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');  
     }      }
     return;      return;
 }  }
Line 961  sub phaseone { Line 974  sub phaseone {
       
     my $doingdir=0;      my $doingdir=0;
     if ($env{'form.action'} eq 'newdir') { $doingdir=1; }      if ($env{'form.action'} eq 'newdir') { $doingdir=1; }
     my ($newfilename,$error) =       my ($newfilename,$error,$warnings) = 
         &cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname,$udom);          &cleanDest($env{'form.newfilename'},$doingdir,$fn,$uname,$udom);
     unless ($error) {      unless ($error) {
         ($newfilename,$error)=&relativeDest($fn,$newfilename,$uname,$udom);          ($newfilename,$error)=&relativeDest($fn,$newfilename,$uname,$udom);
     }      }
Line 973  sub phaseone { Line 986  sub phaseone {
         } else {          } else {
             $dirlist=$fn;               $dirlist=$fn; 
         }          }
           if ($warnings) {
               $r->print($warnings);
           }
         $r->print('<div class="LC_error">'.$error.'</div>'.          $r->print('<div class="LC_error">'.$error.'</div>'.
                   '<p><a href="'.&url($dirlist).'">'.&mt('Return to Directory').                    '<p><a href="'.&url($dirlist).'">'.&mt('Return to Directory').
                   '</a></p>');                    '</a></p>');
Line 982  sub phaseone { Line 998  sub phaseone {
       '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.        '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
       '<input type="hidden" name="phase" value="two" />'.        '<input type="hidden" name="phase" value="two" />'.
       '<input type="hidden" name="action" value="'.$env{'form.action'}.'" />');        '<input type="hidden" name="action" value="'.$env{'form.action'}.'" />');
     
     if ($env{'form.action'} eq 'rename') {      if ($env{'form.action'} eq 'newfile' ||
  &Rename1($r, $uname, $udom, $fn, $newfilename, 'rename');          $env{'form.action'} eq 'newhtmlfile' ||
     } elsif ($env{'form.action'} eq 'move') {          $env{'form.action'} eq 'newproblemfile' ||
  &Rename1($r, $uname, $udom, $fn, $newfilename, 'move');          $env{'form.action'} eq 'newpagefile' ||
     } elsif ($env{'form.action'} eq 'delete') {           $env{'form.action'} eq 'newsequencefile' ||
  &Delete1($r, $uname, $udom, $fn);          $env{'form.action'} eq 'newrightsfile' ||
     } elsif ($env{'form.action'} eq 'decompress') {          $env{'form.action'} eq 'newstyfile' ||
  &Decompress1($r, $uname, $udom, $fn);          $env{'form.action'} eq 'newtaskfile' ||
     } elsif ($env{'form.action'} eq 'copy') {           $env{'form.action'} eq 'newlibraryfile' ||
  if($newfilename) {          $env{'form.action'} eq 'Select Action') {
     &Copy1($r, $uname, $udom, $fn, $newfilename);  
  } else {  
             $r->print('<p class="LC_error">'  
                      .&mt('No new filename specified.')  
                      .'</p></form>'  
             );  
  }  
     } elsif ($env{'form.action'} eq 'newdir') {  
  my $mode = '';  
  if (exists($env{'form.callingmode'}) ) {  
     $mode = $env{'form.callingmode'};  
  }     
  &NewDir1($r, $uname, $udom, $fn, $newfilename, $mode);  
     }  elsif ($env{'form.action'} eq 'newfile' ||  
       $env{'form.action'} eq 'newhtmlfile' ||  
       $env{'form.action'} eq 'newproblemfile' ||  
       $env{'form.action'} eq 'newpagefile' ||  
       $env{'form.action'} eq 'newsequencefile' ||  
       $env{'form.action'} eq 'newrightsfile' ||  
       $env{'form.action'} eq 'newstyfile' ||  
       $env{'form.action'} eq 'newtaskfile' ||  
               $env{'form.action'} eq 'newlibraryfile' ||  
       $env{'form.action'} eq 'Select Action') {  
         my $empty=&mt('Type Name Here');          my $empty=&mt('Type Name Here');
  if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) {          if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) {
     &NewFile1($r, $uname, $udom, $fn, $newfilename);              &NewFile1($r, $uname, $udom, $fn, $newfilename, $warnings);
  } else {          } else {
               if ($warnings) {
                   $r->print($warnings);
               }
             $r->print('<p class="LC_error">'              $r->print('<p class="LC_error">'
                      .&mt('No new filename specified.')                       .&mt('No new filename specified.')
                      .'</p></form>'                       .'</p></form>'
             );              );
  }          }
       } else {
           if ($warnings) {
               $r->print($warnings);
           }
           if ($env{'form.action'} eq 'rename') {
       &Rename1($r, $uname, $udom, $fn, $newfilename, 'rename');
           } elsif ($env{'form.action'} eq 'move') {
       &Rename1($r, $uname, $udom, $fn, $newfilename, 'move');
           } elsif ($env{'form.action'} eq 'delete') { 
       &Delete1($r, $uname, $udom, $fn);
           } elsif ($env{'form.action'} eq 'decompress') {
       &Decompress1($r, $uname, $udom, $fn);
           } elsif ($env{'form.action'} eq 'copy') { 
       if ($newfilename) {
           &Copy1($r, $uname, $udom, $fn, $newfilename);
       } else {
                   $r->print('<p class="LC_error">'
                            .&mt('No new filename specified.')
                            .'</p></form>'
                   );
               }
           } elsif ($env{'form.action'} eq 'newdir') {
       my $mode = '';
       if (exists($env{'form.callingmode'}) ) {
           $mode = $env{'form.callingmode'};
       }
       &NewDir1($r, $uname, $udom, $fn, $newfilename, $mode);
           }
     }      }
 }  }
   
Line 1413  sub phasetwo { Line 1437  sub phasetwo {
                      ['<a href="'.&url($dest).'">'.&mt('Return to Directory').'</a>',                       ['<a href="'.&url($dest).'">'.&mt('Return to Directory').'</a>',
                       '<a href="'.&url($dest_newname).'">'.$disp_newname.'</a>']));                        '<a href="'.&url($dest_newname).'">'.$disp_newname.'</a>']));
         } else {          } else {
     $r->print(&done(&url($dest)));      $r->print(&done($dest));
  }   }
     }      }
 }  }
Line 1422  sub handler { Line 1446  sub handler {
   
     $r=shift;      $r=shift;
   
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress','action','filename','newfilename']);      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress','action','filename','newfilename','mode']);
   
     &Debug($r, "loncfile.pm - handler entered");      &Debug($r, "loncfile.pm - handler entered");
     &Debug($r, " filename: ".$env{'form.filename'});      &Debug($r, " filename: ".$env{'form.filename'});
Removed from v.1.121  
changed lines
  Added in v.1.125

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