Diff for /loncom/publisher/loncfile.pm between versions 1.84 and 1.113

version 1.84, 2007/07/10 23:34:54 version 1.113, 2011/11/02 19:12:40
Line 109  sub Debug { Line 109  sub Debug {
     }      }
 }  }
   
   sub done {
      my ($url)=@_;
      my $done=&mt("Done");
      return(<<ENDDONE);
   <a href="$url">$done</a>
   <script type="text/javascript">
   location.href="$url";
   </script>
   ENDDONE
   }
   
 =pod  =pod
   
 =item URLToPath($url)  =item URLToPath($url)
Line 147  Global References Line 158  Global References
 sub URLToPath {  sub URLToPath {
     my $Url = shift;      my $Url = shift;
     &Debug($r, "UrlToPath got: $Url");      &Debug($r, "UrlToPath got: $Url");
     $Url=~ s/\/+/\//g;      $Url=~ s{^https?\://[^/]+}{};
     $Url=~ s/^http\:\/\/[^\/]+//;      $Url=~ s{//+}{/}g;
     $Url=~ s/^\///;      $Url=~ s{^/}{};
     $Url=~ s/(\~|priv\/)($match_username)\//\/home\/$2\/public_html\//;      $Url=$Apache::lonnet::perlvar{'lonDocRoot'}."/$Url";
     &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\/($match_username)\/public\_html/\/priv\/$1/;      my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
       $fn=~ s/^\Q$londocroot\E//;
       $fn=~s{/\./}{/}g;
     $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/($match_username)/public_html-/priv/$1-;      my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     return '<tt>'.$fn.'</tt>';      $fn=~s/^\Q$londocroot\E//;
       $fn=~s{/\./}{/}g;
       return '<span class="LC_filename">'.$fn.'</span>';
 }  }
   
   
Line 175  sub display { Line 190  sub display {
   
 sub obsolete_unpub {  sub obsolete_unpub {
     my ($user,$domain,$construct)=@_;      my ($user,$domain,$construct)=@_;
       my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     my $published=$construct;      my $published=$construct;
     $published=~      $published=~s{^\Q$londocroot/priv/\E}{$londocroot/res/};
  s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//;  
     if (-e $published) {      if (-e $published) {
  if (&Apache::lonnet::metadata($published,'obsolete')) {   if (&Apache::lonnet::metadata($published,'obsolete')) {
     return 1;      return 1;
Line 226  sub empty_directory { Line 241  sub empty_directory {
   
 =over 4  =over 4
   
 =item  $user   - string [in] - Name of the user for which to check.  =item  $user     - string [in] - Name of the user for which to check.
   
 =item  $domain - string [in] - Name of the domain in which the resource  =item  $domain   - string [in] - Name of the domain in which the resource
                           might have been published.                            might have been published.
   
 =item  $file   - string [in] - Name of the file.  =item  $file     - string [in] - Name of the file.
   
   =item  $creating - string [in] - optional, type of object being created,
                                  either 'directory' or 'file'. Defaults to
                                  'file' if unspecified.
   
 =back  =back
   
Line 251  Returns: Line 270  Returns:
 =cut  =cut
   
 sub exists {  sub exists {
     my ($user, $domain, $construct) = @_;      my ($user, $domain, $construct, $creating) = @_;
       $creating ||= 'file';
   
       my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
     my $published=$construct;      my $published=$construct;
     $published=~      $published=~s{^\Q$londocroot/priv/\E}{$londocroot/res/};
  s{^/home/$user/public_html/}{/home/httpd/html/res/$domain/$user/};  
     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><span class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</span></p>');
Line 266  sub exists { Line 287  sub exists {
     $type = 'warning';      $type = 'warning';
     $result.='<p><span class="LC_warning">'.&mt('Warning: target file exists, and has been published!').'</span></p>';      $result.='<p><span class="LC_warning">'.&mt('Warning: target file exists, and has been published!').'</span></p>';
  } else {   } else {
     $type = 'warning';      my $published_type = (-d $published) ? 'directory' : 'file';
     $result.='<p><span class="LC_warning">'.&mt('Warning: a published file of this names exists.').'</span></p>';  
       if ($published_type eq $creating) {
    $type = 'warning';
    $result.='<p><span class="LC_warning">'.&mt("Warning: a published $published_type of this name exists.").'</span></p>';
       } else {
    $type = 'error';
    $result.='<p><span class="LC_error">'.&mt("Error: a published $published_type of this name exists.").'</span></p>';
       }
  }   }
     } elsif ( -e $construct) {      } elsif ( -e $construct) {
  $type = 'warning';   $type = 'warning';
Line 321  sub checksuffix { Line 349  sub checksuffix {
 }  }
   
 sub cleanDest {  sub cleanDest {
     my ($request,$dest,$subdir,$fn,$uname)=@_;      my ($request,$dest,$subdir,$fn,$uname,$udom)=@_;
     #remove bad characters      #remove bad characters
     my $foundbad=0;      my $foundbad=0;
       my $error='';
     if ($subdir && $dest =~/\./) {      if ($subdir && $dest =~/\./) {
  $foundbad=1;   $foundbad=1;
  $dest=~s/\.//g;   $dest=~s/\.//g;
     }      }
       $dest =~ s/(\s+$|^\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|(.*)/|);
  $newpath=&relativeDest($fn,$newpath,$uname);   ($newpath,$error)=&relativeDest($fn,$newpath,$uname,$udom);
  if (! -d "$newpath") {   if (! -d "$newpath") {
     $request->print("<p><span class=\"LC_error\">".&mt('You have requested to create file in directory [_1] which doesn\'t exist. The requested directory path has been removed from the requested file name.','"<tt>'.$newpath.'</tt>"')."</span></p>");      $request->print('<p><span 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 file name."
                                  ,&display($newpath))
                              .'</span></p>');
     $dest=~s|.*/||;      $dest=~s|.*/||;
  }   }
     }      }
     if ($dest =~ /\.(\d+)\.(\w+)$/){      if ($dest =~ /\.(\d+)\.(\w+)$/){
  $request->print('<span class="LC_error">'   $request->print('<p><span class="LC_warning">'
  .&mt('Bad filename [_1].<br /> <tt>(name).(number).(extension)</tt> not allowed. <br /> Removing the <tt>.number.</tt> from requested filename.',$dest)   .&mt('Bad filename [_1]',&display($dest))
  .'</span>');                          .'<br />'
                           .&mt('[_1](name).(number).(extension)[_2] not allowed.','<tt>','</tt>')
                           .'<br />'
                           .&mt('Removing the [_1].number.[_2] from requested filename.','<tt>','</tt>')
    .'</span></p>');
  $dest =~ s/\.(\d+)(\.\w+)$/$2/;   $dest =~ s/\.(\d+)(\.\w+)$/$2/;
     }      }
     if ($foundbad) {      if ($foundbad) {
  $request->print("<p><span class=\"LC_error\">".&mt('Invalid characters in requested name have been removed.')."</span></p>");          $request->print('<p><span class="LC_warning">'
                          .&mt('Invalid characters in requested name have been removed.')
                           .'</span></p>'
           );
     }      }
     return $dest;      return ($dest,$error);
 }  }
   
 sub relativeDest {  sub relativeDest {
     my ($fn,$newfilename,$uname)=@_;      my ($fn,$newfilename,$uname,$udom)=@_;
       my $error = '';
     if ($newfilename=~/^\//) {      if ($newfilename=~/^\//) {
 # absolute, simply add path  # absolute, simply add path
  $newfilename='/home/'.$uname.'/public_html/';          my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
    $newfilename="$londocroot/res/$udom/$uname/";
     } else {      } else {
  my $dir=$fn;   my $dir=$fn;
  $dir=~s/\/[^\/]+$//;   $dir=~s{/[^/]+$}{};
  $newfilename=$dir.'/'.$newfilename;   $newfilename=$dir.'/'.$newfilename;
     }      }
     $newfilename=~s://+:/:g; # remove duplicate /      $newfilename=~s{//+}{/}g; # remove duplicate /
     while ($newfilename=~m:/\.\./:) {      while ($newfilename=~m{/\.\./}) {
  $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..   $newfilename=~ s{/[^/]+/\.\./}{/}g; #remove dir/..
       }
       my ($authorname,$authordom)=&Apache::loncacc::constructaccess($newfilename);
       unless (($authorname) && ($authordom)) {
          my $otherdir = &display($newfilename);
          $error = &mt('Access denied to [_1]',$otherdir);
     }      }
     return $newfilename;      return ($newfilename,$error);
 }  }
   
 =pod  =pod
Line 391  sub CloseForm1 { Line 438  sub CloseForm1 {
     my ($request,  $fn) = @_;      my ($request,  $fn) = @_;
     $request->print('<p><input type="submit" value="'.&mt('Continue').'" /></p></form>');      $request->print('<p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
     $request->print('<form action="'.&url($fn).      $request->print('<form action="'.&url($fn).
     '" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');      '" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
 }  }
   
   
Line 421  Parameters: Line 468  Parameters:
   
 sub CloseForm2 {  sub CloseForm2 {
     my ($request, $user, $fn) = @_;      my ($request, $user, $fn) = @_;
     $request->print('<h3><a href="'.&url($fn).'/">'.&mt('Done').'</a></h3>');      $request->print(&done(&url($fn)));
 }  }
   
 =pod  =pod
Line 482  sub Rename1 { Line 529  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 /><span classr="LC_warning">'.      $request->print('<p><span class="LC_error">'.
     &mt('Cannot change MIME type of a directory').      &mt('Cannot change MIME type of a directory.').
     '</span>'.      '</span>'.
     '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');      '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>');
     return;      return;
  }   }
  $newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/;   $newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/;
Line 501  sub Rename1 { Line 548  sub Rename1 {
  return;   return;
     }      }
     unless (&obsolete_unpub($user,$domain,$fn)) {      unless (&obsolete_unpub($user,$domain,$fn)) {
  $request->print('<h3>'.&mt('Cannot rename or move non-obsolete published file').'</h3>'.                  $request->print('<p><span class="LC_error">'
  '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');                                 .&mt('Cannot rename or move non-obsolete published file.')
                                  .'</span><br />'
                                  .'<a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>'
                   );
  return;   return;
     }      }
     my $action;      my $action;
     if ($style eq 'rename') {      if ($style eq 'rename') {
  $action=&mt('Rename');   $action='Rename';
     } else {      } else {
  $action=&mt('Move');   $action='Move';
     }      }
     $request->print('<input type="hidden" name="newfilename" value="'.              $request->print('<input type="hidden" name="newfilename" value="'
     $newfilename.                             .$newfilename.'" />'
     '" /><p>'.$action.' '.&display($fn).                             .'<p>'
     '</tt><br />to '.&display($newfilename).'?</p>');                             .&mt($action.' [_1] to [_2]?',
                                   &display($fn),
                                   &display($newfilename))
                              .'</p>'
           );
     &CloseForm1($request, $fn);      &CloseForm1($request, $fn);
  } else {   } else {
     $request->print('<p>'.&mt('No new filename specified.').'</p></form>');      $request->print('<p class="LC_error">'.&mt('No new filename specified.').'</p></form>');
     return;      return;
  }   }
     } else {      } else {
  $request->print('<p> '.&mt('No such file').': '.&display($fn).'</p></form>');          $request->print('<p class="LC_error">'
                          .&mt('No such file: [_1]',
                               &display($fn))
                          .'</p></form>'
           );
  return;   return;
     }      }
           
Line 556  sub Delete1 { Line 614  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.'" />');
         if (-d $fn) {          if (-d $fn) {
             unless (&empty_directory($fn,'Delete1')) {              unless (&empty_directory($fn,'Delete1')) {
                 $request->print('<h3>'.&mt('Only empty directories may be deleted.').'</h3>'.                  $request->print('<p>'
                             'You must delete the contents of the directory first.<br />'.                                 .'<span class="LC_error">'
                             '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');                                 .&mt('Only empty directories may be deleted.')
                                  .'</span><br />'
                                  .&mt('You must delete the contents of the directory first.')
                                  .'</p>'
                                  .'<p><a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>'
                   );
                 return;                  return;
             }              }
         } else {           } else { 
     unless (&obsolete_unpub($user,$domain,$fn)) {      unless (&obsolete_unpub($user,$domain,$fn)) {
         $request->print('<h3>'.&mt('Cannot delete non-obsolete published file').'</h3>'.                  $request->print('<p><span class="LC_error">'
     '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');                                 .&mt('Cannot delete non-obsolete published file.')
                                  .'</span><br />'
                                  .'<a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>'
                   );
         return;          return;
     }      }
         }          }
  $request->print('<p>'.&mt('Delete').' '.&display($fn).'?</p>');          $request->print('<p>'
                          .&mt('Delete [_1]?',
                               &display($fn))
                          .'</p>'
           );
  &CloseForm1($request, $fn);   &CloseForm1($request, $fn);
     } else {      } else {
  $request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');          $request->print('<p class="LC_error">'
                          .&mt('No such file: [_1]',
                               &display($fn))
                          .'</p></form>'
           );
     }      }
 }  }
   
Line 628  sub Copy1 { Line 702  sub Copy1 {
     $request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');      $request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
     return;      return;
  }   }
  $request->print('<input type="hidden" name="newfilename" value="'.      $request->print(
  $newfilename.          '<input type="hidden" name="newfilename"'
  '" /><p>'.&mt('Copy').' '.&display($fn).'<br />to '.         .' value="'.$newfilename.'" />'
  &display($newfilename).'?</p>');         .'<p>'
          .&mt('Copy [_1] to [_2]?',
               &display($fn),
               &display($newfilename))
          .'</p>'
           );
  &CloseForm1($request, $fn);   &CloseForm1($request, $fn);
     } else {      } else {
  $request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');          $request->print('<p class="LC_error">'
                          .&mt('No such file: [_1]',
                               &display($fn))
                          .'</p></form>'
           );
     }      }
 }  }
   
Line 680  causes the newdir operation to transitio Line 763  causes the newdir operation to transitio
 sub NewDir1 {  sub NewDir1 {
     my ($request, $username, $domain, $fn, $newfilename, $mode) = @_;      my ($request, $username, $domain, $fn, $newfilename, $mode) = @_;
   
     my ($type, $result)=&exists($username,$domain,$newfilename);      my ($type, $result)=&exists($username,$domain,$newfilename,'directory');
     $request->print($result);      $request->print($result);
     if ($result) {      if ($type eq 'error') {
  $request->print('</form>');   $request->print('</form>');
     } else {      } else {
  if ($mode eq 'testbank') {   if (($mode eq 'testbank') || ($mode eq 'imsimport')) {
     $request->print('<input type="hidden" name="callingmode" value="testbank">');      $request->print('<input type="hidden" name="callingmode" value="'.$mode.'" />'."\n".
  } elsif ($mode eq 'imsimport') {                              '<input type="hidden" name="inhibitmenu" value="yes" />');
     $request->print('<input type="hidden" name="callingmode" value="imsimport">');   }
  }          $request->print('<input type="hidden" name="newfilename" value="'
  $request->print('<input type="hidden" name="newfilename" value="'.                         .$newfilename.'" />'
  $newfilename.'" /><p>'.&mt('Make new directory').' '.                         .'<p>'
  &display($newfilename).'?</p>');                         .&mt('Make new directory [_1]?',
                               &display($newfilename))
                          .'</p>'
           );
  &CloseForm1($request, $fn);   &CloseForm1($request, $fn);
     }      }
 }  }
Line 701  sub NewDir1 { Line 787  sub NewDir1 {
 sub Decompress1 {  sub Decompress1 {
     my ($request, $user, $domain, $fn) = @_;      my ($request, $user, $domain, $fn) = @_;
     if( -e $fn) {      if( -e $fn) {
     $request->print('<input type="hidden" name="newfilename" value="'.$fn.'"/>');      $request->print('<input type="hidden" name="newfilename" value="'.$fn.'" />');
     $request->print('<p>'.&mt('Decompress').' '.&display($fn).'?</p>');      $request->print('<p>'
                      .&mt('Decompress [_1]?',
                           &display($fn))
                      .'</p>'
       );
     &CloseForm1($request, $fn);      &CloseForm1($request, $fn);
     } else {      } else {
  $request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');          $request->print('<p class="LC_error">'
                          .&mt('No such file: [_1]',
                               &display($fn))
                          .'</p></form>'
           );
     }      }
 }  }
   
Line 751  button which returns you to the driector Line 845  button which returns you to the driector
   
 sub NewFile1 {  sub NewFile1 {
     my ($request, $user, $domain, $fn, $newfilename) = @_;      my ($request, $user, $domain, $fn, $newfilename) = @_;
       return if (&filename_check($newfilename) ne 'ok');
   
     if ($env{'form.action'} =~ /new(.+)file/) {      if ($env{'form.action'} =~ /new(.+)file/) {
  my $extension=$1;   my $extension=$1;
   
         ##Informs User (name).(number).(extension) not allowed   
  if($newfilename =~ /\.(\d+)\.(\w+)$/){  
     $r->print('<span class="LC_error">'.$newfilename.  
       ' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').') '.  
       ' '.&mt('Not Allowed').'</span>');  
     return;  
  }  
  if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){  
     $r->print('<span class="LC_error">'.$newfilename.  
       ' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '.  
       ' '.&mt('Not Allowed').'</span>');  
     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
Line 781  sub NewFile1 { Line 862  sub NewFile1 {
     if ($type eq 'error') {      if ($type eq 'error') {
  $request->print('</form>');   $request->print('</form>');
     } else {      } else {
           my $extension;
   
           if ($newfilename =~ m{[^/.]+\.([^/.]+)$}) {
               $extension = $1;
           }
   
           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))) {
               my $validexts = '.'.join(', .',@okexts);
               $request->print('<p class="LC_warning">'.
                   &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 following are valid extensions: [_1].',$validexts).
                   '</p></form><p>'.
    '<form name="fileaction" action="/adm/cfile" method="post">'.
                   '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
    '<input type="hidden" name="action" value="newfile" />'.
           '<span class ="LC_nobreak">'.&mt('Enter a file name: ').'<input type="text" name="newfilename" value="Type Name Here" onfocus="if (this.value == '."'Type Name Here') this.value=''".'" />&nbsp;<input type="submit" value="Go" />'.
                   '</span></form></p>'.
                   '<p><form action="'.&url($fn).
                   '" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></form></p>');
               return;
           }
   
  $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>');
   
  $request->print('<form action="'.&url($newfilename).   $request->print('<form action="'.&url($newfilename).
  '" method="POST"><p><input type="submit" value="'.&mt('Continue').'" /></p></form>');   '" method="post"><p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
  $request->print('<form action="'.&url($fn).   $request->print('<form action="'.&url($fn).
  '" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');   '" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
     }      }
       return;
   }
   
   sub filename_check {
       my ($newfilename) = @_;
       ##Informs User (name).(number).(extension) not allowed
       if($newfilename =~ /\.(\d+)\.(\w+)$/){
           $r->print('<span class="LC_error">'.$newfilename.
                     ' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').') '.
                     ' '.&mt('Not Allowed').'</span>');
           return;
       }
       if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){
           $r->print('<span class="LC_error">'.$newfilename.
                     ' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '.
                     ' '.&mt('Not Allowed').'</span>');
           return;
       }
       return 'ok'; 
 }  }
   
 =pod  =pod
Line 824  sub phaseone { Line 948  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=&cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname);      my ($newfilename,$error) = 
     $newfilename=&relativeDest($fn,$newfilename,$uname);          &cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname,$udom);
       unless ($error) {
           ($newfilename,$error)=&relativeDest($fn,$newfilename,$uname,$udom);
       }
       if ($error) {
           my $dirlist;
           if ($fn=~m{^(.*/)[^/]+$}) {
               $dirlist=$1;
           } else {
               $dirlist=$fn; 
           }
           $r->print('<div class="LC_error">'.$error.'</div>'.
                     '<h3><a href="'.&url($dirlist).'">'.&mt('Return to Directory').
                     '</a></h3>');
           return;
       }
     $r->print('<form action="/adm/cfile" method="post">'.      $r->print('<form action="/adm/cfile" method="post">'.
       '<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" />'.
Line 843  sub phaseone { Line 982  sub phaseone {
  if($newfilename) {   if($newfilename) {
     &Copy1($r, $uname, $udom, $fn, $newfilename);      &Copy1($r, $uname, $udom, $fn, $newfilename);
  } else {   } else {
     $r->print('<p>'.&mt('No new filename specified.').'</p></form>');              $r->print('<p class="LC_error">'
                        .&mt('No new filename specified.')
                        .'</p></form>'
               );
  }   }
     } elsif ($env{'form.action'} eq 'newdir') {      } elsif ($env{'form.action'} eq 'newdir') {
  my $mode = '';   my $mode = '';
Line 858  sub phaseone { Line 1000  sub phaseone {
       $env{'form.action'} eq 'newsequencefile' ||        $env{'form.action'} eq 'newsequencefile' ||
       $env{'form.action'} eq 'newrightsfile' ||        $env{'form.action'} eq 'newrightsfile' ||
       $env{'form.action'} eq 'newstyfile' ||        $env{'form.action'} eq 'newstyfile' ||
         $env{'form.action'} eq 'newtaskfile' ||
               $env{'form.action'} eq 'newlibraryfile' ||                $env{'form.action'} eq 'newlibraryfile' ||
       $env{'form.action'} eq 'Select Action') {        $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);
  } else {   } else {
     $r->print('<p>'.&mt('No new filename specified.').'</p></form>');              $r->print('<p class="LC_error">'
                        .&mt('No new filename specified.')
                        .'</p></form>'
               );
  }   }
     }      }
 }  }
Line 951  sub Rename2 { Line 1097  sub Rename2 {
     unlink $tmp2;      unlink $tmp2;
  }   }
     } else {      } else {
  $request->print("<p> ".&mt('No such file').": ".&display($oldfile).'</p></form>');          $request->print(
               '<p>'
              .&mt('No such file: [_1]',
                   &display($oldfile))
              .'</p></form>'
           );
  return 0;   return 0;
     }      }
     return 1;      return 1;
Line 999  sub Delete2 { Line 1150  sub Delete2 {
     return 0;      return 0;
  }   }
     } else {      } else {
  $request->print('<p> '.&mt('No such file').'. </p></form>');          $request->print('<p class="LC_error">'.&mt('No such file').'</p></form>');
  return 0;   return 0;
     }      }
  }   }
Line 1010  sub Delete2 { Line 1161  sub Delete2 {
  return 0;   return 0;
     }      }
  } else {   } else {
     $request->print('<p> '.&mt('No such file').'. </p></form>');              $request->print('<p class="LC_error">'.&mt('No such file').'</p></form>');
     return 0;      return 0;
  }   }
     }      }
Line 1069  sub Copy2 { Line 1220  sub Copy2 {
     return 1;      return 1;
  }   }
     } else {      } else {
  $request->print('<p> '.&mt('No such file').' </p>');          $request->print('<p class="LC_error">'.&mt('No such file').'</p>');
  return 0;   return 0;
     }      }
     return 1;      return 1;
Line 1113  sub NewDir2 { Line 1264  sub NewDir2 {
   
 sub decompress2 {  sub decompress2 {
     my ($r, $user, $dir, $file) = @_;      my ($r, $user, $dir, $file) = @_;
     &Apache::lonnet::appenv('cgi.file' => $file);      &Apache::lonnet::appenv({'cgi.file' => $file});
     &Apache::lonnet::appenv('cgi.dir' => $dir);      &Apache::lonnet::appenv({'cgi.dir' => $dir});
     my $result=&Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');      my $result=&Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
     $r->print($result);      $r->print($result);
     &Apache::lonnet::delenv('cgi.file');      &Apache::lonnet::delenv('cgi.file');
Line 1223  sub phasetwo { Line 1374  sub phasetwo {
     }      }
     $dest = $env{'form.newfilename'};      $dest = $env{'form.newfilename'};
       } else {        } else {
     $r->print('<p>'.&mt('No New filename specified').'</p></form>');              $r->print('<p class="LC_error">'.&mt('No New filename specified').'</p></form>');
     return;      return;
  }   }
   
Line 1241  sub phasetwo { Line 1392  sub phasetwo {
             $r->print('<h3><a href="'.&url($dest).'">'.&mt('Return to Directory').'</a></h3>');              $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>');              $r->print('<h3><a href="'.&url($dest_newname).'">'.$disp_newname.'</a></h3>');
         } else {          } else {
     $r->print('<h3><a href="'.&url($dest).'">'.&mt('Done').'</a></h3>');      $r->print(&done(&url($dest)));
  }   }
     }      }
 }  }
Line 1289  sub handler { Line 1440  sub handler {
     }       } 
   
 # ----------------------------------------------------------- Start page output  # ----------------------------------------------------------- Start page output
     my $uname;  
     my $udom;  
   
     ($uname,$udom)=      my ($uname,$udom) = &Apache::loncacc::constructaccess($fn);
  &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));  
     &Debug($r,       &Debug($r, 
    "loncfile::handler constructaccess uname = $uname domain = $udom");     "loncfile::handler constructaccess uname = $uname domain = $udom");
     unless (($uname) && ($udom)) {      if (($uname eq '') || ($udom eq '')) {
  $r->log_reason($uname.' at '.$udom.   $r->log_reason($uname.' at '.$udom.
        ' trying to manipulate file '.$env{'form.filename'}.         ' trying to manipulate file '.$env{'form.filename'}.
        ' ('.$fn.') - not authorized',          ' ('.$fn.') - not authorized', 
Line 1315  sub handler { Line 1463  sub handler {
  $js = qq|   $js = qq|
 <script type="text/javascript">  <script type="text/javascript">
 function writeDone() {  function writeDone() {
     var winName = window.opener  
     window.focus();      window.focus();
     winName.document.dataForm.newdir.value = "$newdirname"      opener.document.info.newdir.value = "$newdirname";
     setTimeout("self.close()",10000)      setTimeout("self.close()",10000);
 }  }
   </script>    </script>
 |;  |;
  $loaditem{'onload'} = "writeDone()";   $loaditem{'onload'} = "writeDone()";
     }      }
   
       my $londocroot = $r->dir_config('lonDocRoot');
       my $trailfile = $fn;
       $trailfile =~ s{^/(priv/)}{$londocroot/$1};
           
       # Breadcrumbs
       &Apache::lonhtmlcommon::clear_breadcrumbs();
       &Apache::lonhtmlcommon::add_breadcrumb({
           'text'  => 'Construction Space',
           'href'  => &Apache::loncommon::authorspace(),
       });
       &Apache::lonhtmlcommon::add_breadcrumb({
           'text'  => 'File Operation',
           'title' => 'Construction Space File Operation',
           'href'  => '',
       });
   
     $r->print(&Apache::loncommon::start_page('Construction Space File Operation',      $r->print(&Apache::loncommon::start_page('Construction Space File Operation',
      $js,       $js,
      {'add_entries' => \%loaditem,}));       {'add_entries' => \%loaditem,})
                .&Apache::lonhtmlcommon::breadcrumbs()
                .&Apache::loncommon::head_subbox(
                     &Apache::loncommon::CSTR_pageheader($trailfile))
       );
       
     $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');      $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');
       
     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {      if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
  $r->print('<h3><span class="LC_error">'.&mt('Co-Author').': '.$uname.' at '.$udom.          $r->print('<p class="LC_info">'
   '</span></h3>');                   .&mt('Co-Author [_1]',$uname.':'.$udom)
                    .'</p>'
           );
     }      }
   
   
Line 1357  function writeDone() { Line 1526  function writeDone() {
      $env{'form.action'} eq 'newsequencefile' ||       $env{'form.action'} eq 'newsequencefile' ||
      $env{'form.action'} eq 'newrightsfile' ||       $env{'form.action'} eq 'newrightsfile' ||
      $env{'form.action'} eq 'newstyfile' ||       $env{'form.action'} eq 'newstyfile' ||
        $env{'form.action'} eq 'newtaskfile' ||
              $env{'form.action'} eq 'newlibraryfile' ||               $env{'form.action'} eq 'newlibraryfile' ||
      $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>'.          $r->print('<p class="LC_error">'
   &Apache::loncommon::end_page());                   .&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') {

Removed from v.1.84  
changed lines
  Added in v.1.113


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