Diff for /loncom/publisher/loncfile.pm between versions 1.18 and 1.21

version 1.18, 2002/09/10 02:31:26 version 1.21, 2003/01/09 22:11:52
Line 323  sub exists { Line 323  sub exists {
   my ($user, $domain, $dir, $file) = @_;    my ($user, $domain, $dir, $file) = @_;
   
   # Create complete paths in publication and construction space.    # Create complete paths in publication and construction space.
     my $relativedir=$dir;
   my $published = &PublicationPath($domain, $user, $dir, $file);    $relativedir=s|/home/\Q$user\E/public_html||;
   my $construct = &ConstructionPath($user, $dir, $file);    my $published = &PublicationPath($domain, $user, $relativedir, $file);
     my $construct = &ConstructionPath($user, $relativedir, $file);
   
   # If the resource exists in either space indicate this fact.    # If the resource exists in either space indicate this fact.
   # Note that the check for existence in resource space is stricter.    # Note that the check for existence in resource space is stricter.
   
   my $result;        my $result;    
     if ( -d $construct ) {
         return 'Error: destination for operation is a directory.';
     }
   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>';
    }    }
   
   return $result;    return $result;
   
Line 492  sub Rename1 { Line 496  sub Rename1 {
  if($ENV{'form.newfilename'}) {   if($ENV{'form.newfilename'}) {
     my $newfilename = $ENV{'form.newfilename'};      my $newfilename = $ENV{'form.newfilename'};
     $request->print(&checksuffix($filename, $newfilename));      $request->print(&checksuffix($filename, $newfilename));
     $request->print(&exists($user, $domain, $dir, $newfilename));      my $return=&exists($user, $domain, $dir, $newfilename);
       $request->print($return);
       if ($return =~/^Error:/) {
    $request->print('<br /><a href="'.$cancelurl.'">Cancel</a>');
    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.'</tt> to <tt>'.      '"><p>Rename <tt>'.$filename.'</tt><br /> to <tt>'.
     $dir.'/'.$newfilename.'</tt>?</p>');      $dest.'</tt>?</p>');
     &CloseForm1($request, $cancelurl);      &CloseForm1($request, $cancelurl);
  } else {   } else {
     $request->print('<p>No new filename specified</p></form>');      $request->print('<p>No new filename specified</p></form>');
Line 587  sub Copy1 { Line 597  sub Copy1 {
   $cancelurl    =~ s/\/public_html//;    $cancelurl    =~ s/\/public_html//;
           
   
   
   if(-e $filename) {    if(-e $filename) {
     $request->print(&checksuffix($filename,$newfilename));      $request->print(&checksuffix($filename,$newfilename));
     $request->print(&exists($user, $domain, $dir, $newfilename));      my $return=&exists($user, $domain, $dir, $newfilename);
       $request->print($return);
       if ($return =~/^Error:/) {
    $request->print('<br /><a href="'.$cancelurl.'">Cancel</a>');
    return;
       }
       my $dest=&SimplifyDir($dir,$newfilename);
     $request->print('<input type = hidden name = newfilename value = "'.      $request->print('<input type = hidden name = newfilename value = "'.
     $dir.'/'.$newfilename.      $dir.'/'.$newfilename.
     '"><p>Copy <tt>'.$filename.'</tt> to'.      '"><p>Copy <tt>'.$filename.'</tt><br />  to '.
     '<tt>'.$dir.'/'.$newfilename.'</tt>/?</p>');      '<tt>'.$dest.'</tt>?</p>');
     &CloseForm1($request, $cancelurl);      &CloseForm1($request, $cancelurl);
   } else {    } else {
     $request->print('<p>No such file <tt>'.$filename.'</p></form>');      $request->print('<p>No such file <tt>'.$filename.'</p></form>');
Line 603  sub Copy1 { Line 618  sub Copy1 {
   
 =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 988  sub phasetwo { Line 1031  sub phasetwo {
  # Once a resource is deleted, we just list the directory that   # Once a resource is deleted, we just list the directory that
  # previously held it.   # previously held it.
  #   #
  $dest = $dir."/"; # Parent dir.   $dest = $dir."/."; # Parent dir.
     } elsif ($ENV{'form.action'} eq 'copy') {       } elsif ($ENV{'form.action'} eq 'copy') { 
  if($ENV{'form.newfilename'}) {   if($ENV{'form.newfilename'}) {
     if(!&Copy2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {      if(!&Copy2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {
Line 1017  sub phasetwo { Line 1060  sub phasetwo {
     # construction space path.      # construction space path.
     #      #
     &Debug($r, "Final url is: $dest");      &Debug($r, "Final url is: $dest");
     $dest =~ s/\/home\//\/priv\//;      $dest =~ s|/home/|/priv/|;
     $dest =~ s/\/public_html//;      $dest =~ s|/public_html||;
           
     my $base = &File::Basename::basename($dest);      my $base = &File::Basename::basename($dest);
     my $dpath= &File::Basename::dirname($dest);      my $dpath= &File::Basename::dirname($dest);
       if ($base eq '.') { $base=''; }
     $dest = &HTML::Entities::encode($dpath.'/'.$base);      $dest = &HTML::Entities::encode($dpath.'/'.$base);
   
   

Removed from v.1.18  
changed lines
  Added in v.1.21


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