Diff for /loncom/publisher/loncfile.pm between versions 1.23 and 1.35

version 1.23, 2003/02/04 22:01:38 version 1.35, 2003/08/01 20:32:05
Line 7 Line 7
 #  presents a page that describes the proposed action to the user  #  presents a page that describes the proposed action to the user
 #  and requests confirmation.  The second phase commits the action  #  and requests confirmation.  The second phase commits the action
 #  and displays a page showing the results of the action.  #  and displays a page showing the results of the action.
 #   #
   
 #  #
 # $Id$  # $Id$
 #  #
Line 93  use Apache::Constants qw(:common :http : Line 92  use Apache::Constants qw(:common :http :
 use Apache::loncacc;  use Apache::loncacc;
 use Apache::Log ();  use Apache::Log ();
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::loncommon();
   
 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 173  Global References Line 173  Global References
 sub URLToPath {  sub URLToPath {
   my $Url = shift;    my $Url = shift;
   &Debug($r, "UrlToPath got: $Url");    &Debug($r, "UrlToPath got: $Url");
   $Url=~ s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;  
   $Url=~ s/^http\:\/\/[^\/]+//;    $Url=~ s/^http\:\/\/[^\/]+//;
     $Url=~ s/^\///;
     $Url=~ s/(\~|priv\/)(\w+)\//\/home\/$2\/public_html\//;
   &Debug($r, "Returning $Url \n");    &Debug($r, "Returning $Url \n");
   return $Url;    return $Url;
 }  }
Line 388  sub checksuffix { Line 389  sub checksuffix {
     }      }
     return $result;      return $result;
 }  }
   
   sub cleanDest {
       my ($request,$dest)=@_;
       #remove bad characters
       if  ($dest=~/[\#\?&]/) {
    $request->print("<p><font color=\"red\">Invalid characters in requested name have been removed.</font></p>");
    $dest=~s/[\#\?&]//g;
       }
       return $dest;
   }
   
 =pod  =pod
   
 =item CloseForm1($request, $user, $file)  =item CloseForm1($request, $user, $file)
Line 413  sub CloseForm1 { Line 425  sub CloseForm1 {
    &Debug($request, "Cancel url is: ".$cancelurl);     &Debug($request, "Cancel url is: ".$cancelurl);
    $request->print('<p><input type="submit" value="Continue" /></p></form>');     $request->print('<p><input type="submit" value="Continue" /></p></form>');
    $request->print('<form action="'.$cancelurl.     $request->print('<form action="'.$cancelurl.
    '" method="GET"><p><input type="submit" value="Cancel" /></p></form>');     '" method="POST"><p><input type="submit" value="Cancel" /></p></form>');
   
 }  }
   
Line 495  sub Rename1 { Line 507  sub Rename1 {
     if(-e $conspace) {      if(-e $conspace) {
  if($ENV{'form.newfilename'}) {   if($ENV{'form.newfilename'}) {
     my $newfilename = $ENV{'form.newfilename'};      my $newfilename = $ENV{'form.newfilename'};
       if ($newfilename =~ m|/[^\.]+$|) {
    #no extension add on orignal extension
    if ($filename =~ m|/[^\.]*\.([^\.]+)$|) {
       $newfilename.='.'.$1;
    }
       }
     $request->print(&checksuffix($filename, $newfilename));      $request->print(&checksuffix($filename, $newfilename));
       #renaming a dir, delete the trailing /
               #remove last element for current dir
       if ($filename =~ m|/$|) {
    $filename =~ s|/$||;
    $dir =~ s|/[^/]*$||;
       }
     my $return=&exists($user, $domain, $dir, $newfilename);      my $return=&exists($user, $domain, $dir, $newfilename);
     $request->print($return);      $request->print($return);
     if ($return =~/^Error:/) {      if ($return =~/^Error:/) {
Line 759  sub NewFile1 { Line 783  sub NewFile1 {
     if ($ENV{'form.action'} =~ /new(.+)file/) {      if ($ENV{'form.action'} =~ /new(.+)file/) {
  my $extension=$1;   my $extension=$1;
  if ($newfilename !~ /\Q.$extension\E$/) {   if ($newfilename !~ /\Q.$extension\E$/) {
       if ($newfilename =~ m|^[^\.]*\.([^\.]+)$|) {
    #already has an extension strip it and add in expected one
    $newfilename =~ s|.([^\.]+)$||;
       }
     $newfilename.=".$extension";      $newfilename.=".$extension";
  }   }
     }      }
Line 771  sub NewFile1 { Line 799  sub NewFile1 {
  $request->print('<p>File exists.</p></form>');   $request->print('<p>File exists.</p></form>');
     }      }
     else {      else {
  $request->print('<p>Make new file <tt>'.$newfilename.'</tt>?</p>');   $request->print('<p>Make new file <tt>'.$dir.'/'.$newfilename.'</tt>?</p>');
  my $dest=&MakeFinalUrl($request,$fullpath);   my $dest=&MakeFinalUrl($request,$fullpath);
  &Debug($request, "Cancel url is: ".$cancelurl);   &Debug($request, "Cancel url is: ".$cancelurl);
  &Debug($request, "Dest url is: ".$dest);   &Debug($request, "Dest url is: ".$dest);
  $request->print('</form>');   $request->print('</form>');
  $request->print('<form action="'.$dest.   $request->print('<form action="'.$dest.
  '" method="GET"><p><input type="submit" value="Continue" /></p></form>');   '" method="POST"><p><input type="submit" value="Continue" /></p></form>');
  $request->print('<form action="'.$cancelurl.   $request->print('<form action="'.$cancelurl.
  '" method="GET"><p><input type="submit" value="Cancel" /></p></form>');   '" method="POST"><p><input type="submit" value="Cancel" /></p></form>');
     }      }
 }  }
   
Line 821  sub phaseone { Line 849  sub phaseone {
       
   #  my $conspace=ConstructionPathFromRelative($uname, $fn);    #  my $conspace=ConstructionPathFromRelative($uname, $fn);
       
       $ENV{'form.newfilename'}=&cleanDest($r,$ENV{'form.newfilename'});
   
   $r->print('<form action="/adm/cfile" method="post">'.    $r->print('<form action="/adm/cfile" method="post">'.
     '<input type="hidden" name="filename" value="/~'.$uname.$fn.'" />'.      '<input type="hidden" name="filename" value="/~'.$uname.$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 'rename') {
             if (!defined($dir)) {
     &Rename1($r, $fn, $uname, $udom, $dir);    $fn=~m:(.*)/:;
         $dir=$1;
         }
         &Rename1($r, $fn, $uname, $udom, $dir);
   } elsif ($ENV{'form.action'} eq 'delete') {     } elsif ($ENV{'form.action'} eq 'delete') { 
           
     &Delete1($r, $uname, $fn);      &Delete1($r, $uname, $fn);
Line 846  sub phaseone { Line 877  sub phaseone {
     &NewDir1($r, $uname, $dir, $ENV{'form.newfilename'});      &NewDir1($r, $uname, $dir, $ENV{'form.newfilename'});
   }  elsif ($ENV{'form.action'} eq 'newfile' ||    }  elsif ($ENV{'form.action'} eq 'newfile' ||
     $ENV{'form.action'} eq 'newhtmlfile' ||      $ENV{'form.action'} eq 'newhtmlfile' ||
     $ENV{'form.action'} eq 'newproblemfile') {      $ENV{'form.action'} eq 'newproblemfile' ||
     if($ENV{'form.newfilename'}) {              $ENV{'form.action'} eq 'newpagefile' ||
       my $newfilename = $ENV{'form.newfilename'};              $ENV{'form.action'} eq 'newsequencefile' ||
       if (!defined($dir)) {              $ENV{'form.action'} eq 'newrightsfile' ||
   $fn=~m:(.*)/:;              $ENV{'form.action'} eq 'newstyfile' ||
   $dir=$1;              $ENV{'form.action'} eq 'Select Action') {
         if($ENV{'form.newfilename'}) {
     my $newfilename = $ENV{'form.newfilename'};
     if (!defined($dir)) {
         $fn=~m:(.*)/:;
         $dir=$1;
     }
     &NewFile1($r, $uname, $udom, $dir, $newfilename);
         } else {
     $r->print('<p>No new filename specified.</p></form>');
       }        }
       &NewFile1($r, $uname, $udom, $dir, $fn, $newfilename);  
     }else {  
       $r->print('<p>No new filename specified.</p></form>');  
     }  
   }    }
 }  }
   
Line 904  sub Rename2 { Line 940  sub Rename2 {
  $newfile);   $newfile);
   
   if(-e $oldfile) {    if(-e $oldfile) {
       unless(rename($oldfile,        my $dest;
     $directory.'/'.$newfile)) {  
         if ($oldfile =~ m|/$|) {
     #renaming a dir
     $oldfile =~ s|/$||;
     $dest=$directory;
     $dest=~s|(/)([^/]*)$|$1|;
     $dest.='/'.$newfile;
         } else {
     $dest=$directory.'/'.$newfile;
         }
   
         unless(rename($oldfile,$dest)) {
   $request->print('<font color="red">Error: '.$!.'</font>');    $request->print('<font color="red">Error: '.$!.'</font>');
   return 0;    return 0;
       } else {}        } else {}
Line 1083  sub phasetwo { Line 1130  sub phasetwo {
           
     # Break down the file into it's component pieces.      # Break down the file into it's component pieces.
           
     $fn=~/(.*)\/([^\/]+)\.(\w+)$/;      my $dir; # Directory path
     my $dir=$1; # Directory path      my $main; # Filename.
     my $main=$2; # Filename.      my $suffix; # Extension.
     my $suffix=$3; # Extension.  
           if ($fn=~m:(.*)/([^/]+)\.(\w+)$:) {
    $dir=$1; # Directory path
    $main=$2; # Filename.
    $suffix=$3; # Extension.
       }
           
     my $dest;                   # On success this is where we'll go.      my $dest;                   # On success this is where we'll go.
           
     &Debug($r,       &Debug($r, 
Line 1107  sub phasetwo { Line 1159  sub phasetwo {
           
     if ($ENV{'form.action'} eq 'rename') { # Rename.      if ($ENV{'form.action'} eq 'rename') { # Rename.
  if($ENV{'form.newfilename'}) {   if($ENV{'form.newfilename'}) {
       if (!defined($dir)) {
    $fn=~m:^(.*)/:;
    $dir=$1;
       }
     if(!&Rename2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {      if(!&Rename2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {
  return;   return;
     }      }
     # Prepend the directory to the new name to form the basis of the      # Prepend the directory to the new name to form the basis of the
     # url of the new resource.      # url of the new resource.
     #      #
       #renaming a dir
               #remove last element for current dir
       if ($fn =~ m|/$|) { $dir =~ s|/[^/]*$||; }
     $dest = $dir."/".$ENV{'form.newfilename'};      $dest = $dir."/".$ENV{'form.newfilename'};
  }   }
     } elsif ($ENV{'form.action'} eq 'delete') {       } elsif ($ENV{'form.action'} eq 'delete') { 
Line 1183  sub handler { Line 1242  sub handler {
   
   if ($ENV{'form.filename'}) {    if ($ENV{'form.filename'}) {
       $fn=&Apache::lonnet::unescape($ENV{'form.filename'});        $fn=&Apache::lonnet::unescape($ENV{'form.filename'});
       &Debug($r, "loncfile::handler - raw url: $fn");        $fn=&URLToPath($fn);
 #      $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;  
 #      $fn=~s/^http\:\/\/[^\/]+//;  
       $fn=URLToPath($fn);  
       &Debug($r, "loncfile::handler - doctored url: $fn");  
   
   } else {    } else {
       &Debug($r, "loncfile::handler - no form.filename");        &Debug($r, "loncfile::handler - no form.filename");
      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.       $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
Line 1227  sub handler { Line 1281  sub handler {
   
   $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');    $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
   
   $r->print(    $r->print(&Apache::loncommon::bodytag('File Operation'));
    '<body bgcolor="#FFFFFF"><img align="right" src="/adm/lonIcons/lonlogos.gif" />');  
   
       
   $r->print('<h1>Construction Space <tt>'.$fn.'</tt></h1>');    $r->print('<h1>Construction Space <tt>'.$fn.'</tt></h1>');
Line 1251  sub handler { Line 1304  sub handler {
       $r->print('<h3>Copy</h3>');        $r->print('<h3>Copy</h3>');
   } elsif ($ENV{'form.action'} eq 'newfile' ||    } elsif ($ENV{'form.action'} eq 'newfile' ||
    $ENV{'form.action'} eq 'newhtmlfile' ||     $ENV{'form.action'} eq 'newhtmlfile' ||
    $ENV{'form.action'} eq 'newproblemfile') {     $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 'Select Action' ) {
       $r->print('<h3>New Resource</h3>');        $r->print('<h3>New Resource</h3>');
   } else {    } else {
      $r->print('<p>Unknown Action</p></body></html>');       $r->print('<p>Unknown Action '.$ENV{'form.action'}.' </p></body></html>');
      return OK;         return OK;  
   }    }
   if ($ENV{'form.phase'} eq 'two') {    if ($ENV{'form.phase'} eq 'two') {

Removed from v.1.23  
changed lines
  Added in v.1.35


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