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

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

version 1.35, 2003/08/01 20:32:05 version 1.36, 2003/08/03 00:40:00
Line 33 Line 33
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 #  
 # (Handler to retrieve an old version of a file  
 #  
 # (Publication Handler  
 #   
 # (TeX Content Handler  
 #  
 # 05/29/00,05/30,10/11 Gerd Kortemeyer)  
 #  
 # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer  
 # 03/23 Guy Albertelli  
 # 03/24,03/29 Gerd Kortemeyer)  
 #  
 # 03/31,04/03,05/02,05/09,06/23,06/24 Gerd Kortemeyer)  
 #  
 # 06/23 Gerd Kortemeyer  
 # 05/07/02 Ron Fox:  
 #           - Added Debug log output so that I can trace what the heck this  
 #             undocumented thingy does.  
 # 05/28/02  Ron Fox:  
 #           - Started putting in pod in standard format.  
 =pod  =pod
   
 =head1 NAME  =head1 NAME
Line 180  sub URLToPath { Line 159  sub URLToPath {
   return $Url;    return $Url;
 }  }
   
   sub url {
       my $fn=shift;
       $fn=~s/^\/home\/(\w+)\/public\_html/\/priv\/$1/;
       return $fn;
   }
   
   sub display {
       my $fn=shift;
       $fn=~s/^\/home\/(\w+)\/public\_html//;
       return '<tt>'.$fn.'</tt>';
   }
   
 =pod  =pod
   
 =item PublicationPath($domain, $user, $dir, $file)  =item PublicationPath($domain, $user, $dir, $file)
Line 249  sub ConstructionPath { Line 240  sub ConstructionPath {
   return '/home/'.$user.'/public_html/'.$dir.'/'.$file;    return '/home/'.$user.'/public_html/'.$dir.'/'.$file;
   
 }  }
 =pod  
   
 =item  ConstructionPathFromRelative($user, $relname)  
   
    Determines the path to a construction space file given  
 the username and the path relative to the root of construction space.  
   
 Parameters:  
   
 =over 4  
   
 =item  $user  - string [in] Name of the user in whose construction space the  
            file [will] live.  
   
 =item  $relname - string[in] Path to the file relative to the root of the  
             construction space.  
   
 =back  
   
 Returns:  
   
 =over 4     
   
 =item  string - Full path to the file.  
   
 =back  
   
 =cut  
   
 sub ConstructionPathFromRelative {  
   
   my ($user, $relname) = @_;  
   return '/home/'.$user.'/public_html'.$relname;  
   
 }  
   
 =pod  =pod
   
Line 338  sub exists { Line 294  sub exists {
   }    }
   if ( -e $published) {    if ( -e $published) {
       $result.='<p><font color="red">Warning: target file exists, and has been published!</font></p>';        $result.='<p><font color="red">Warning: target file exists, and has been published!</font></p>';
   }    } elsif ( -e $construct) {
   elsif ( -e $construct) {  
       $result.='<p><font color="red">Warning: target file exists!</font></p>';        $result.='<p><font color="red">Warning: target file exists!</font></p>';
   }    }
   
Line 400  sub cleanDest { Line 355  sub cleanDest {
     return $dest;      return $dest;
 }  }
   
   sub relativeDest {
       my ($fn,$newfilename,$uname)=@_;
       if ($newfilename=~/^\//) {
   # absolute, simply add path
    $newfilename='/home/'.$uname.'/public_html/';
       } else {
    my $dir=$fn;
    $dir=~s/\/[^\/]+$//;
    $newfilename=$dir.'/'.$newfilename;
       }
       $newfilename=~s://+:/:g; # remove duplicate /
       while ($newfilename=~m:/\.\./:) {
    $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
       }
       return $newfilename;
   }
   
 =pod  =pod
   
 =item CloseForm1($request, $user, $file)  =item CloseForm1($request, $user, $file)
Line 419  Parameters: Line 391  Parameters:
 =cut  =cut
   
 sub CloseForm1 {  sub CloseForm1 {
    my ($request,  $cancelurl) = @_;     my ($request,  $fn) = @_;
   
   
    &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="'.&url($fn).
    '" method="POST"><p><input type="submit" value="Cancel" /></p></form>');       '" method="POST"><p><input type="submit" value="Cancel" /></p></form>');
   
 }  }
   
   
Line 455  Parameters: Line 423  Parameters:
 =cut  =cut
   
 sub CloseForm2 {  sub CloseForm2 {
   my ($request, $user, $directory) = @_;    my ($request, $user, $fn) = @_;
     $request->print('<h3><a href="'.&url($fn).'/">Done</a></h3>');
   $request->print('<h3><a href="/priv/'.$user.$directory.'/">Done </a> </h3>');  
 }  }
   
 =pod  =pod
Line 496  new filename relative to the current dir Line 463  new filename relative to the current dir
 =cut    =cut  
   
 sub Rename1 {  sub Rename1 {
     my ($request, $filename, $user, $domain, $dir) = @_;      my ($request, $user, $domain, $fn, $newfilename) = @_;
     &Debug($request, "Username - ".$user." filename: ".$filename."\n");  
     my $conspace = $filename;      if(-e $fn) {
    if($newfilename) {
     my $cancelurl = "/priv/".$filename;  
     $cancelurl    =~ s/\/home\///;  
     $cancelurl    =~ s/\/public_html//;  
       
     if(-e $conspace) {  
  if($ENV{'form.newfilename'}) {  
     my $newfilename = $ENV{'form.newfilename'};  
     if ($newfilename =~ m|/[^\.]+$|) {      if ($newfilename =~ m|/[^\.]+$|) {
  #no extension add on orignal extension   #no extension add on original extension
  if ($filename =~ m|/[^\.]*\.([^\.]+)$|) {   if ($fn =~ m|/[^\.]*\.([^\.]+)$|) {
     $newfilename.='.'.$1;      $newfilename.='.'.$1;
  }   }
     }      }
     $request->print(&checksuffix($filename, $newfilename));      $request->print(&checksuffix($fn, $newfilename));
     #renaming a dir, delete the trailing /      #renaming a dir, delete the trailing /
             #remove last element for current dir              #remove last element for current dir
     if ($filename =~ m|/$|) {      my $dir=$fn;
  $filename =~ s|/$||;      if ($fn =~ m|/$|) {
    $fn =~ s|/$||;
  $dir =~ 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:/) {
  $request->print('<br /><a href="'.$cancelurl.'">Cancel</a>');   $request->print('<br /><a href="'.&url($fn).'">Cancel</a>');
  return;   return;
     }      }
     my $dest=&SimplifyDir($dir,$newfilename);  
     $request->print('<input type="hidden" name="newfilename" value="'.      $request->print('<input type="hidden" name="newfilename" value="'.
     $newfilename.      $newfilename.
     '" /><p>Rename <tt>'.$filename.      '" /><p>Rename '.&display($fn).
     '</tt><br /> to <tt>'.      '</tt><br />to '.&display($newfilename).'?</p>');
     $dest.'</tt>?</p>');      &CloseForm1($request, $fn);
     &CloseForm1($request, $cancelurl);  
  } else {   } else {
     $request->print('<p>No new filename specified</p></form>');      $request->print('<p>No new filename specified.</p></form>');
     return;      return;
  }   }
     } else {      } else {
  $request->print('<p> No such File </p> </form>');   $request->print('<p> No such file: '.&display($fn).'</p></form>');
  return;   return;
     }      }
           
Line 554  Parameters: Line 513  Parameters:
   
 =over 4  =over 4
   
 =item   $request   - Apache Request Object [in] request object for the current  =item   $request   - Apache Request Object [in] request object for the current 
                 request.                  request.
   
 =item   $user      - string [in] Name of session user.  =item   $user      - string [in]  Name of the user initiating the request.
   
   =item   $domain    - string [in]  Domain the initiating user is logged in as
   
 =item   $filename  - string [in] Name fo the file to be deleted:  =item   $filename  - string [in]  Source filename.
                 Filename is the full filesystem path to the file.  
   
 =back  =back
   
 =cut  =cut
   
 sub Delete1 {  sub Delete1 {
   my ($request, $user,  $filename) = @_;    my ($request, $user, $domain, $fn) = @_;
   
   my $cancelurl = '/priv/'.$filename;  
   $cancelurl    =~ s/\/home\///;  
   $cancelurl    =~ s/\/public_html//;  
     
   
   if( -e $filename) {    if( -e $fn) {
     $request->print('<input type="hidden" name="newfilename" value="'.      $request->print('<input type="hidden" name="newfilename" value="'.
     $filename.'"/>');      $fn.'"/>');
     $request->print('<p> Delete <tt>'.$filename.'</tt>?</p>');      $request->print('<p>Delete '.&display($fn).'?</p>');
     &CloseForm1($request, $cancelurl);      &CloseForm1($request, $fn);
   } else {    } else {
     $request->print('<p> No Such file: <tt>'.$filename.'</tt></p></form>');      $request->print('<p>No such file: '.&display($fn).'</p></form>');
   }    }
 }  }
   
Line 604  Parameters: Line 558  Parameters:
   
 =item   $domain    - string [in]  Domain the initiating user is logged in as  =item   $domain    - string [in]  Domain the initiating user is logged in as
   
 =item   $dir       - string [in]  Directory path.  =item   $fn  - string [in]  Source filename.
   
 =item   $filename  - string [in]  Source filename.  
   
 =item   $newfilename-string [in]  Destination filename.  =item   $newfilename-string [in]  Destination filename.
   
Line 615  Parameters: Line 567  Parameters:
 =cut  =cut
   
 sub Copy1 {  sub Copy1 {
   my ($request, $user, $domain, $dir, $filename, $newfilename) = @_;    my ($request, $user, $domain, $fn, $newfilename) = @_;
   
   my $cancelurl = "/priv/".$filename;    if(-e $fn) {
   $cancelurl    =~ s/\/home\///;      $request->print(&checksuffix($fn,$newfilename));
   $cancelurl    =~ s/\/public_html//;      my $return=&exists($user, $domain, $fn, $newfilename);
       
   
   if(-e $filename) {  
     $request->print(&checksuffix($filename,$newfilename));  
     my $return=&exists($user, $domain, $dir, $newfilename);  
     $request->print($return);      $request->print($return);
     if ($return =~/^Error:/) {      if ($return =~/^Error:/) {
  $request->print('<br /><a href="'.$cancelurl.'">Cancel</a>');   $request->print('<br /><a href="'.&url($fn).'">Cancel</a>');
  return;   return;
     }      }
     my $dest=&SimplifyDir($dir,$newfilename);  
     $request->print('<input type = "hidden" name = "newfilename" value = "'.      $request->print('<input type = "hidden" name = "newfilename" value = "'.
     $dir.'/'.$newfilename.      $newfilename.
     '" /><p>Copy <tt>'.$filename.'</tt><br />  to '.      '" /><p>Copy '.&display($fn).'<br />to '.
     '<tt>'.$dest.'</tt>?</p>');      &display($newfilename).'?</p>');
     &CloseForm1($request, $cancelurl);      &CloseForm1($request, $fn);
   } else {    } else {
     $request->print('<p>No such file <tt>'.$filename.'</p></form>');      $request->print('<p>No such file: '.&display($fn).'</p></form>');
   }    }
 }  }
   
 =pod  =pod
   
 =item SimplifyDir  
   
   Removes all extra / and all .. references  
   
 Parameters:  
   
 =over 4  
   
 =item $dir - string [in] a directory name  
   
 =item $file - string [in] a file reference relative to $dir  
   
 =back  
   
 Results: the concatenated path.  
   
 =cut  
   
 sub SimplifyDir {  
     my ($dir,$file) = @_;  
     my $location = $dir. '/'.$file;  
     $location=~s://+:/:g; # remove duplicate /  
     while ($location=~m:/\.\./:) {$location=~s:/[^/]+/\.\./:/:g;}#remove dir/..  
     return $location;  
 }  
   
 =pod  
   
 =item NewDir1  =item NewDir1
     
   Does all phase 1 processing of directory creation:    Does all phase 1 processing of directory creation:
Line 686  Parameters: Line 604  Parameters:
   
 =item   $username - Name of the user that is requesting the directory creation.  =item   $username - Name of the user that is requesting the directory creation.
   
 =item   $path     - current directory relative to construction space.  =item $domain - Domain user is in
   
   =item   $fn     - source file.
   
 =item   $newdir   - Name of the directory to be created; path relative to the   =item   $newdir   - Name of the directory to be created; path relative to the 
                top level of construction space.                 top level of construction space.
Line 708  causes the newdir operation to transitio Line 628  causes the newdir operation to transitio
   
 sub NewDir1  sub NewDir1
 {  {
   my ($request, $username, $path, $newdir) = @_;    my ($request, $username, $domain, $fn, $newfilename) = @_;
   
   my $fullpath = '/home/'.$username.'/public_html/'.  
     $path.'/'.$newdir;  
   
   my $cancelurl = '/priv/'.$username.'/'.$path;  
   
   &Debug($request, "Full path is : ".$fullpath);  
   
   if(-e $fullpath) {    if(-e $newfilename) {
     $request->print('<p>Directory exists.</p></form>');      $request->print('<p>Directory exists.</p></form>');
   }    }
   else {    else {
     $request->print('<input type="hidden" name="newfilename" value="'.      $request->print('<input type="hidden" name="newfilename" value="'.
     $newdir.'" /><p>Make new directory <tt>'.      $newfilename.'" /><p>Make new directory '.
     $path."/".$newdir.'</tt>?</p>');      &display($newfilename).'?</p>');
     &CloseForm1($request, $cancelurl);      &CloseForm1($request, $fn);
   
   }    }
 }  }
   
Line 750  Parameters: Line 662  Parameters:
   
 =item   $domain   - Name of the domain of the user  =item   $domain   - Name of the domain of the user
   
 =item   $dir      - current absolute diretory  =item   $fn      - Source file name
   
 =item   $newfilename  =item   $newfilename
                   - Name of the file to be created; no path information                    - Name of the file to be created; no path information
Line 762  Side Effects: Line 674  Side Effects:
   
 =item 2 new forms are displayed.  Clicking on the confirmation button  =item 2 new forms are displayed.  Clicking on the confirmation button
 causes the browser to attempt to load the specfied URL, allowing the  causes the browser to attempt to load the specfied URL, allowing the
 proper handler to take care of file creation. There is also a Cancle  proper handler to take care of file creation. There is also a Cancel
 button which returns you to the driectory listing you came from  button which returns you to the driectory listing you came from
   
 =back  =back
Line 771  button which returns you to the driector Line 683  button which returns you to the driector
   
   
 sub NewFile1 {  sub NewFile1 {
     my ($request, $user, $domain, $dir, $newfilename) = @_;      my ($request, $user, $domain, $fn, $newfilename) = @_;
   
     &Debug($request, "Dir is : ".$dir);  
     &Debug($request, "Newfile is : ".$newfilename);  
   
     my $cancelurl = "/priv/".$dir;  
     $cancelurl    =~ s/\/home\///;  
     $cancelurl    =~ s/\/public_html//;  
   
     if ($ENV{'form.action'} =~ /new(.+)file/) {      if ($ENV{'form.action'} =~ /new(.+)file/) {
  my $extension=$1;   my $extension=$1;
Line 791  sub NewFile1 { Line 696  sub NewFile1 {
  }   }
     }      }
   
     my $fullpath = $dir.'/'.$newfilename;      if(-e $newfilename) {
   
     &Debug($request, "Full path is : ".$fullpath);  
   
     if(-e $fullpath) {  
  $request->print('<p>File exists.</p></form>');   $request->print('<p>File exists.</p></form>');
     }      }
     else {      else {
  $request->print('<p>Make new file <tt>'.$dir.'/'.$newfilename.'</tt>?</p>');   $request->print('<p>Make new file '.&display($newfilename).'?</p>');
  my $dest=&MakeFinalUrl($request,$fullpath);  
  &Debug($request, "Cancel url is: ".$cancelurl);  
  &Debug($request, "Dest url is: ".$dest);  
  $request->print('</form>');   $request->print('</form>');
  $request->print('<form action="'.$dest.   $request->print('<form action="'.&url($newfilename).
  '" method="POST"><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="'.&url($fn).
  '" method="POST"><p><input type="submit" value="Cancel" /></p></form>');   '" method="POST"><p><input type="submit" value="Cancel" /></p></form>');
     }      }
 }  }
Line 842  performed and reported to the user. Line 740  performed and reported to the user.
 sub phaseone {  sub phaseone {
   my ($r,$fn,$uname,$udom)=@_;    my ($r,$fn,$uname,$udom)=@_;
       
   $fn=~m:(.*)/([^/]+)\.(\w+)$:;    my $newfilename=&cleanDest($r,$ENV{'form.newfilename'});
   my $dir=$1;    $newfilename=&relativeDest($fn,$newfilename,$uname);
   my $main=$2;  
   my $suffix=$3;  
     
   #  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="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 'rename') {
       if (!defined($dir)) {        &Rename1($r, $uname, $udom, $fn, $newfilename);
   $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, $udom, $fn);
     &Delete1($r, $uname, $fn);  
       
   } elsif ($ENV{'form.action'} eq 'copy') {     } elsif ($ENV{'form.action'} eq 'copy') { 
     if($ENV{'form.newfilename'}) {        if($newfilename) {
       my $newfilename = $ENV{'form.newfilename'};    &Copy1($r, $uname, $udom, $fn, $newfilename);
       &Copy1($r, $uname, $udom, $dir, $fn, $newfilename);        } else {
     }else {    $r->print('<p>No new filename specified.</p></form>');
       $r->print('<p>No new filename specified.</p></form>');        }
     }  
   } elsif ($ENV{'form.action'} eq 'newdir') {    } elsif ($ENV{'form.action'} eq 'newdir') {
     &NewDir1($r, $uname, $dir, $ENV{'form.newfilename'});        &NewDir1($r, $uname, $udom, $fn, $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' ||
Line 883  sub phaseone { Line 768  sub phaseone {
             $ENV{'form.action'} eq 'newrightsfile' ||              $ENV{'form.action'} eq 'newrightsfile' ||
             $ENV{'form.action'} eq 'newstyfile' ||              $ENV{'form.action'} eq 'newstyfile' ||
             $ENV{'form.action'} eq 'Select Action') {              $ENV{'form.action'} eq 'Select Action') {
       if($ENV{'form.newfilename'}) {        if ($newfilename) {
   my $newfilename = $ENV{'form.newfilename'};    &NewFile1($r, $uname, $udom, $fn, $newfilename);
   if (!defined($dir)) {  
       $fn=~m:(.*)/:;  
       $dir=$1;  
   }  
   &NewFile1($r, $uname, $udom, $dir, $newfilename);  
       } else {        } else {
   $r->print('<p>No new filename specified.</p></form>');    $r->print('<p>No new filename specified.</p></form>');
       }        }
Line 1237  sub handler { Line 1117  sub handler {
   &Debug($r, "loncfile.pm - handler entered");    &Debug($r, "loncfile.pm - handler entered");
   &Debug($r, " filename: ".$ENV{'form.filename'});    &Debug($r, " filename: ".$ENV{'form.filename'});
   &Debug($r, " newfilename: ".$ENV{'form.newfilename'});    &Debug($r, " newfilename: ".$ENV{'form.newfilename'});
   #
   # Determine the root filename
   # This could come in as "filename", which actually is a URL, or
   # as "qualifiedfilename", which is indeed a real filename in filesystem
   #
   my $fn;    my $fn;
   
   if ($ENV{'form.filename'}) {    if ($ENV{'form.filename'}) {
       $fn=&Apache::lonnet::unescape($ENV{'form.filename'});        $fn=&Apache::lonnet::unescape($ENV{'form.filename'});
       $fn=&URLToPath($fn);        $fn=&URLToPath($fn);
     } elsif ($ENV{'form.qualifiedfilename'}) {
         $fn=$ENV{'form.qualifiedfilename'};
   } 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 1273  sub handler { Line 1159  sub handler {
      return HTTP_NOT_ACCEPTABLE;       return HTTP_NOT_ACCEPTABLE;
   }    }
   
   $fn=~s/\/\~(\w+)//;  
   &Debug($r, "loncfile::handler ~ removed filename: $fn");  
   
   $r->content_type('text/html');    $r->content_type('text/html');
   $r->send_http_header;    $r->send_http_header;
   
   $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');    $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
   
   $r->print(&Apache::loncommon::bodytag('File Operation'));    $r->print(&Apache::loncommon::bodytag('Construction Space File Operation'));
   
       
   $r->print('<h1>Construction Space <tt>'.$fn.'</tt></h1>');    $r->print('<h3>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">Co-Author: '.$uname.' at '.$udom.            $r->print('<h3><font color="red">Co-Author: '.$uname.' at '.$udom.
Removed from v.1.35  
changed lines
  Added in v.1.36

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