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

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

version 1.38, 2003/08/04 20:08:23 version 1.39, 2003/08/04 20:34:19
Line 174  sub display { Line 174  sub display {
   
 =pod  =pod
   
 =item PublicationPath($domain, $user, $dir, $file)  =item exists($user, $domain, $file)
   
    Determines the filesystem path corresponding to a published resource  
    specification.  The returned value is the path.  
 Parameters:  
   
 =over 4  
   
 =item   $domain - string [in] Name of the domain within which the resource is   
              stored.  
   
 =item   $user   - string [in] Name of the user asking about the resource.  
   
 =item   $dir    - Directory path relative to the top of the resource space.  
   
 =item   $file   - name of the resource file itself without path info.  
   
 =back  
   
 =over 4  
   
 Returns:  
   
 =item  string - full path to the file if it exists in publication space.  
   
 =back  
        
 =cut  
   
 sub PublicationPath  
 {  
   my ($domain, $user, $dir, $file)=@_;  
   
   return '/home/httpd/html/res/'.$domain.'/'.$user.'/'.$dir.'/'.  
  $file;  
 }  
   
 =pod  
   
 =item ConstructionPath($domain, $user, $dir, $file)  
   
    Determines the filesystem path corresponding to a construction space  
    resource specification.  The returned value is the path  
 Parameters:  
   
 =over 4  
   
 =item   $user   - string [in] Name of the user asking about the resource.  
   
 =item   $dir    - Directory path relative to the top of the resource space.  
   
 =item   $file   - name of the resource file itself without path info.  
   
 Returns:  
   
 =item  string - full path to the file if it exists in Construction space.  
   
 =back  
        
 =cut  
   
 sub ConstructionPath {  
   my ($user, $dir, $file) = @_;  
   
   return '/home/'.$user.'/public_html/'.$dir.'/'.$file;  
   
 }  
   
 =pod  
   
 =item exists($user, $domain, $directory, $file)  
   
    Determine if a resource file name has been published or exists     Determine if a resource file name has been published or exists
    in the construction space.     in the construction space.
Line 258  sub ConstructionPath { Line 188  sub ConstructionPath {
 =item  $domain - string [in] - Name of the domain in which the resource  =item  $domain - string [in] - Name of the domain in which the resource
                           might have been published.                            might have been published.
   
 =item  $dir    - string [in] - Path relative to construction or resource space  
                           in which the resource might live.  
   
 =item  $file   - string [in] - Name of the file.  =item  $file   - string [in] - Name of the file.
   
 =back  =back
Line 278  Returns: Line 205  Returns:
 =cut  =cut
   
 sub exists {  sub exists {
   my ($user, $domain, $dir, $file) = @_;    my ($user, $domain, $construct) = @_;
     my $published=$construct;
   # Create complete paths in publication and construction space.    $published=~
   my $relativedir=$dir;  s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//;
   $relativedir=s|/home/\Q$user\E/public_html||;    my $result='';    
   my $published = &PublicationPath($domain, $user, $relativedir, $file);  
   my $construct = &ConstructionPath($user, $relativedir, $file);  
   
   # If the resource exists in either space indicate this fact.  
   # Note that the check for existence in resource space is stricter.  
   
   my $result;      
   if ( -d $construct ) {    if ( -d $construct ) {
       return 'Error: destination for operation is a directory.';        return 'Error: destination for operation is an existing 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 476  sub Rename1 { Line 395  sub Rename1 {
     }      }
     $request->print(&checksuffix($fn, $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 second to last element for current dir
     my $dir=$fn;      if (-d $fn) {
     if ($fn =~ m|/$|) {   $newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/;
  $fn =~ s|/$||;  
  $dir =~ s|/[^/]*$||;  
     }      }
     my $return=&exists($user, $domain, $dir, $newfilename);      my $return=&exists($user, $domain, $newfilename);
     $request->print($return);      $request->print($return);
     if ($return =~/^Error:/) {      if ($return =~/^Error:/) {
  $request->print('<br /><a href="'.&url($fn).'">Cancel</a>');   $request->print('<br /><a href="'.&url($fn).'">Cancel</a>');
Line 572  sub Copy1 { Line 489  sub Copy1 {
   
   if(-e $fn) {    if(-e $fn) {
     $request->print(&checksuffix($fn,$newfilename));      $request->print(&checksuffix($fn,$newfilename));
     my $return=&exists($user, $domain, $fn, $newfilename);      my $return=&exists($user, $domain, $newfilename);
     $request->print($return);      $request->print($return);
     if ($return =~/^Error:/) {      if ($return =~/^Error:/) {
  $request->print('<br /><a href="'.&url($fn).'">Cancel</a>');   $request->print('<br /><a href="'.&url($fn).'">Cancel</a>');
Line 631  sub NewDir1 Line 548  sub NewDir1
 {  {
   my ($request, $username, $domain, $fn, $newfilename) = @_;    my ($request, $username, $domain, $fn, $newfilename) = @_;
   
   if(-e $newfilename) {    my $result=&exists($username,$domain,$newfilename);
     $request->print('<p>Directory exists.</p></form>');    if ($result) {
   }      $request->print('<font color="red">'.$result.'</font></form>');
   else {    } else {
     $request->print('<input type="hidden" name="newfilename" value="'.      $request->print('<input type="hidden" name="newfilename" value="'.
     $newfilename.'" /><p>Make new directory '.      $newfilename.'" /><p>Make new directory '.
     &display($newfilename).'?</p>');      &display($newfilename).'?</p>');
Line 696  sub NewFile1 { Line 613  sub NewFile1 {
     $newfilename.=".$extension";      $newfilename.=".$extension";
  }   }
     }      }
       my $result=&exists($user,$domain,$newfilename);
     if(-e $newfilename) {      if($result) {
  $request->print('<p>File exists.</p></form>');   $request->print('<font color="red">'.$result.'</font></form>');
     }      } else {
     else {  
  $request->print('<p>Make new file '.&display($newfilename).'?</p>');   $request->print('<p>Make new file '.&display($newfilename).'?</p>');
  $request->print('</form>');   $request->print('</form>');
  $request->print('<form action="'.&url($newfilename).   $request->print('<form action="'.&url($newfilename).
Removed from v.1.38  
changed lines
  Added in v.1.39

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