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

Diff for /loncom/publisher/loncfile.pm between versions 1.39 and 1.40

version 1.39, 2003/08/04 20:34:19 version 1.40, 2003/08/26 19:17:02
Line 605  sub NewFile1 { Line 605  sub NewFile1 {
   
     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('<font color="red">'.$newfilename.
         ' - Bad Filename<br />(name).(number).(extension)'.
         ' Not Allowed</font>');
       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 736  sub Rename2 { Line 744  sub Rename2 {
   &Debug($request, "Target is: ".$directory.'/'.    &Debug($request, "Target is: ".$directory.'/'.
  $newfile);   $newfile);
   if (-e $oldfile) {    if (-e $oldfile) {
   
         my $oRN=$oldfile;
         my $nRN=$newfile;
       unless (rename($oldfile,$newfile)) {        unless (rename($oldfile,$newfile)) {
   $request->print('<font color="red">Error: '.$!.'</font>');    $request->print('<font color="red">Error: '.$!.'</font>');
   return 0;    return 0;
       }        }
         ## If old name.(extension) exits, move under new name.
         ## If it doesn't exist and a new.(extension) exists  
         ## delete it (only concern when renaming over files)
         my $tmp1=$oRN.'.meta';
         my $tmp2=$nRN.'.meta';
         if(-e $tmp1){
     unless(rename($tmp1,$tmp2)){ }
         }else if(-e $tmp2){
     unlink $tmp2;
         }
         $tmp1=$oRN.'.save';
         $tmp2=$nRN.'.save';
         if(-e $tmp1){
     unless(rename($tmp1,$tmp2)){ }
         }else if(-e $tmp2){
     unlink $tmp2;
         }
         $tmp1=$oRN.'.log';
         $tmp2=$nRN.'.log';
         if(-e $tmp1){
     unless(rename($tmp1,$tmp2)){ }
         }else if(-e $tmp2){
     unlink $tmp2;
         }
         $tmp1=$oRN.'.bak';
         $tmp2=$nRN.'.bak';
         if(-e $tmp1){
     unless(rename($tmp1,$tmp2)){ }
         }else if(-e $tmp2){
     unlink $tmp2;
         }
   } else {    } else {
       $request->print("<p> No such file: ".&display($oldfile).'</p></form>');        $request->print("<p> No such file: ".&display($oldfile).'</p></form>');
       return 0;        return 0;
Removed from v.1.39  
changed lines
  Added in v.1.40

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