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

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

version 1.82, 2007/04/20 20:55:01 version 1.83, 2007/04/26 21:17:16
Line 239  Returns: Line 239  Returns:
   
 =over 4  =over 4
   
   =item  string - Either undef, 'warning' or 'error' depending on the
                   type of problem
   
 =item  string - Either where the resource exists as an html string that can  =item  string - Either where the resource exists as an html string that can
            be embedded in a dialog or an empty string if the resource             be embedded in a dialog or an empty string if the resource
            does not exist.             does not exist.
Line 251  sub exists { Line 254  sub exists {
     my ($user, $domain, $construct) = @_;      my ($user, $domain, $construct) = @_;
     my $published=$construct;      my $published=$construct;
     $published=~      $published=~
  s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//;   s{^/home/$user/public_html/}{/home/httpd/html/res/$domain/$user/};
     my $result='';          my ($type,$result);
     if ( -d $construct ) {      if ( -d $construct ) {
  return &mt('Error: destination for operation is an existing directory.');   return ('error','<p><span class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</span></p>');
   
     }      }
   
     if ( -e $published) {      if ( -e $published) {
  $result.='<p><font color="red">'.&mt('Warning: target file exists, and has been published!').'</font></p>';   if ( -e $construct ) {
       $type = 'warning';
       $result.='<p><span class="LC_warning">'.&mt('Warning: target file exists, and has been published!').'</span></p>';
    } else {
       $type = 'warning';
       $result.='<p><span class="LC_warning">'.&mt('Warning: a published file of this names exists.').'</span></p>';
    }
     } elsif ( -e $construct) {      } elsif ( -e $construct) {
  $result.='<p><font color="red">'.&mt('Warning: target file exists!').'</font></p>';   $type = 'warning';
    $result.='<p><span class="LC_warning">'.&mt('Warning: target file exists!').'</span></p>';
     }      }
     return $result;  
       return ($type,$result);
 }  }
   
 =pod  =pod
Line 323  sub cleanDest { Line 336  sub cleanDest {
  my ($newpath)=($dest=~m|(.*)/|);   my ($newpath)=($dest=~m|(.*)/|);
  $newpath=&relativeDest($fn,$newpath,$uname);   $newpath=&relativeDest($fn,$newpath,$uname);
  if (! -d "$newpath") {   if (! -d "$newpath") {
     $request->print("<p><font color=\"red\">".&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>"')."</font></p>");      $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>");
     $dest=~s|.*/||;      $dest=~s|.*/||;
  }   }
     }      }
     if ($foundbad) {      if ($foundbad) {
  $request->print("<p><font color=\"red\">".&mt('Invalid characters in requested name have been removed.')."</font></p>");   $request->print("<p><span class=\"LC_error\">".&mt('Invalid characters in requested name have been removed.')."</span></p>");
     }      }
     return $dest;      return $dest;
 }  }
Line 475  sub Rename1 { Line 488  sub Rename1 {
     while ($newfilename=~m:/\.\./:) {      while ($newfilename=~m:/\.\./:) {
  $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..   $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
     }      }
     my $return=&exists($user, $domain, $newfilename);      my ($type, $return)=&exists($user, $domain, $newfilename);
     $request->print($return);      $request->print($return);
     if ($return =~/^Error:/) {      if ($type eq 'error') {
  $request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');   $request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
  return;   return;
     }      }
Line 603  sub Copy1 { Line 616  sub Copy1 {
     $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..      $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
  }   }
  $request->print(&checksuffix($fn,$newfilename));   $request->print(&checksuffix($fn,$newfilename));
  my $return=&exists($user, $domain, $newfilename);   my ($type,$return)=&exists($user, $domain, $newfilename);
  $request->print($return);   $request->print($return);
  if ($return =~/^Error:/) {   if ($type eq 'error') {
     $request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');      $request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
     return;      return;
  }   }
Line 661  causes the newdir operation to transitio Line 674  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 $result=&exists($username,$domain,$newfilename);      my ($type, $result)=&exists($username,$domain,$newfilename);
       $request->print($result);
     if ($result) {      if ($result) {
  $request->print('<font color="red">'.$result.'</font></form>');   $request->print('</form>');
     } else {      } else {
  if ($mode eq 'testbank') {   if ($mode eq 'testbank') {
     $request->print('<input type="hidden" name="callingmode" value="testbank">');      $request->print('<input type="hidden" name="callingmode" value="testbank">');
Line 737  sub NewFile1 { Line 751  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('<span class="LC_error">'.$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>');        ' '.&mt('Not Allowed').'</span>');
     return;      return;
  }   }
  if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){   if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){
     $r->print('<font color="red">'.$newfilename.      $r->print('<span class="LC_error">'.$newfilename.
       ' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '.        ' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '.
       ' '.&mt('Not Allowed').'</font>');        ' '.&mt('Not Allowed').'</span>');
     return;      return;
  }   }
  if ($newfilename !~ /\Q.$extension\E$/) {   if ($newfilename !~ /\Q.$extension\E$/) {
Line 756  sub NewFile1 { Line 770  sub NewFile1 {
     $newfilename.=".$extension";      $newfilename.=".$extension";
  }   }
     }      }
     my $result=&exists($user,$domain,$newfilename);      my ($type, $result)=&exists($user,$domain,$newfilename);
     if($result) {      $request->print($result);
  $request->print('<span class="LC_error">'.$result.'</span></form>');      if ($type eq 'error') {
    $request->print('</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>');
  $request->print('<form action="'.&url($newfilename).   $request->print('<form action="'.&url($newfilename).
Line 894  sub Rename2 { Line 910  sub Rename2 {
  my $oRN=$oldfile;   my $oRN=$oldfile;
  my $nRN=$newfile;   my $nRN=$newfile;
  unless (rename($oldfile,$newfile)) {   unless (rename($oldfile,$newfile)) {
     $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');      $request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
     return 0;      return 0;
  }   }
  ## If old name.(extension) exits, move under new name.   ## If old name.(extension) exits, move under new name.
Line 968  sub Delete2 { Line 984  sub Delete2 {
     my ($request, $user, $filename) = @_;      my ($request, $user, $filename) = @_;
     if (-d $filename) {       if (-d $filename) { 
  unless (&empty_directory($filename,'Delete2')) {    unless (&empty_directory($filename,'Delete2')) { 
     $request->print('<font color="red"> '.&mt('Error: Directory Non Empty').'</font>');       $request->print('<span class="LC_error">'.&mt('Error: Directory Non Empty').'</span>'); 
     return 0;      return 0;
  } else {      } else {   
     if(-e $filename) {      if(-e $filename) {
  unless(rmdir($filename)) {   unless(rmdir($filename)) {
     $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');      $request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
     return 0;      return 0;
  }   }
     } else {      } else {
Line 984  sub Delete2 { Line 1000  sub Delete2 {
     } else {      } else {
  if(-e $filename) {   if(-e $filename) {
     unless(unlink($filename)) {      unless(unlink($filename)) {
  $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');   $request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
  return 0;   return 0;
     }      }
  } else {   } else {
Line 1028  sub Copy2 { Line 1044  sub Copy2 {
     &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) {          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>');              $request->print('<span class="LC_error">'.&mt('Warning').': '.&mt('Name of new file is the same as name of old file').' - '.&mt('no action taken').'.</span>');
             return 1;              return 1;
         }          }
  unless (copy($oldfile, $newfile)) {   unless (copy($oldfile, $newfile)) {
     $request->print('<font color="red"> '.&mt('copy Error').': '.$!.'</font>');      $request->print('<span class="LC_error">'.&mt('copy Error').': '.$!.'</span>');
     return 0;      return 0;
  } elsif (!chmod(0660, $newfile)) {   } elsif (!chmod(0660, $newfile)) {
     $request->print('<font color="red"> '.&mt('chmod error').': '.$!.'</font>');      $request->print('<span class="LC_error">'.&mt('chmod error').': '.$!.'</span>');
     return 0;      return 0;
  } elsif (-e $oldfile.'.meta' &&    } elsif (-e $oldfile.'.meta' && 
  !copy($oldfile.'.meta', $newfile.'.meta') &&   !copy($oldfile.'.meta', $newfile.'.meta') &&
  !chmod(0660, $newfile.'.meta')) {   !chmod(0660, $newfile.'.meta')) {
     $request->print('<font color="red"> '.&mt('copy metadata error').      $request->print('<span class="LC_error">'.&mt('copy metadata error').
     ': '.$!.'</font>');      ': '.$!.'</span>');
     return 0;      return 0;
  } else {   } else {
     return 1;      return 1;
Line 1079  sub NewDir2 { Line 1095  sub NewDir2 {
     my ($request, $user, $newdirectory) = @_;      my ($request, $user, $newdirectory) = @_;
       
     unless(mkdir($newdirectory, 02770)) {      unless(mkdir($newdirectory, 02770)) {
  $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');   $request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
  return 0;   return 0;
     }      }
     unless(chmod(02770, ($newdirectory))) {      unless(chmod(02770, ($newdirectory))) {
  $request->print('<font color="red"> '.&mt('Error').': '.$!.'</font>');   $request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
  return 0;   return 0;
     }      }
     return 1;      return 1;
Line 1310  function writeDone() { Line 1326  function writeDone() {
     $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><font color="red">'.&mt('Co-Author').': '.$uname.' at '.$udom.   $r->print('<h3><span class="LC_error">'.&mt('Co-Author').': '.$uname.' at '.$udom.
   '</font></h3>');    '</span></h3>');
     }      }
   
   
Removed from v.1.82  
changed lines
  Added in v.1.83

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