[LON-CAPA-cvs] cvs: loncom /publisher loncfile.pm

www lon-capa-cvs@mail.lon-capa.org
Mon, 04 Aug 2003 20:34:19 -0000


www		Mon Aug  4 16:34:19 2003 EDT

  Modified files:              
    /loncom/publisher	loncfile.pm 
  Log:
  Bug #2018: fix &exists() and use it.
  
  
Index: loncom/publisher/loncfile.pm
diff -u loncom/publisher/loncfile.pm:1.38 loncom/publisher/loncfile.pm:1.39
--- loncom/publisher/loncfile.pm:1.38	Mon Aug  4 16:08:23 2003
+++ loncom/publisher/loncfile.pm	Mon Aug  4 16:34:19 2003
@@ -9,7 +9,7 @@
 #  and displays a page showing the results of the action.
 #
 #
-# $Id: loncfile.pm,v 1.38 2003/08/04 20:08:23 www Exp $
+# $Id: loncfile.pm,v 1.39 2003/08/04 20:34:19 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -174,77 +174,7 @@
 
 =pod
 
-=item PublicationPath($domain, $user, $dir, $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)
+=item exists($user, $domain, $file)
 
    Determine if a resource file name has been published or exists
    in the construction space.
@@ -258,9 +188,6 @@
 =item  $domain - string [in] - Name of the domain in which the resource
                           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.
 
 =back
@@ -278,27 +205,19 @@
 =cut
 
 sub exists {
-  my ($user, $domain, $dir, $file) = @_;
-
-  # Create complete paths in publication and construction space.
-  my $relativedir=$dir;
-  $relativedir=s|/home/\Q$user\E/public_html||;
-  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;    
+  my ($user, $domain, $construct) = @_;
+  my $published=$construct;
+  $published=~
+s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//;
+  my $result='';    
   if ( -d $construct ) {
-      return 'Error: destination for operation is a directory.';
+      return 'Error: destination for operation is an existing directory.';
   }
   if ( -e $published) {
       $result.='<p><font color="red">Warning: target file exists, and has been published!</font></p>';
   } elsif ( -e $construct) {
       $result.='<p><font color="red">Warning: target file exists!</font></p>';
   }
-
   return $result;
 
 }
@@ -476,13 +395,11 @@
 	    }
 	    $request->print(&checksuffix($fn, $newfilename));
 	    #renaming a dir, delete the trailing /
-            #remove last element for current dir
-	    my $dir=$fn;
-	    if ($fn =~ m|/$|) {
-		$fn =~ s|/$||;
-		$dir =~ s|/[^/]*$||;
+            #remove second to last element for current dir
+	    if (-d $fn) {
+		$newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/;
 	    }
-	    my $return=&exists($user, $domain, $dir, $newfilename);
+	    my $return=&exists($user, $domain, $newfilename);
 	    $request->print($return);
 	    if ($return =~/^Error:/) {
 		$request->print('<br /><a href="'.&url($fn).'">Cancel</a>');
@@ -572,7 +489,7 @@
 
   if(-e $fn) {
     $request->print(&checksuffix($fn,$newfilename));
-    my $return=&exists($user, $domain, $fn, $newfilename);
+    my $return=&exists($user, $domain, $newfilename);
     $request->print($return);
     if ($return =~/^Error:/) {
 	$request->print('<br /><a href="'.&url($fn).'">Cancel</a>');
@@ -631,10 +548,10 @@
 {
   my ($request, $username, $domain, $fn, $newfilename) = @_;
 
-  if(-e $newfilename) {
-    $request->print('<p>Directory exists.</p></form>');
-  }
-  else {
+  my $result=&exists($username,$domain,$newfilename);
+  if ($result) {
+    $request->print('<font color="red">'.$result.'</font></form>');
+  } else {
     $request->print('<input type="hidden" name="newfilename" value="'.
 		    $newfilename.'" /><p>Make new directory '.
 		    &display($newfilename).'?</p>');
@@ -696,11 +613,10 @@
 	    $newfilename.=".$extension";
 	}
     }
-
-    if(-e $newfilename) {
-	$request->print('<p>File exists.</p></form>');
-    }
-    else {
+    my $result=&exists($user,$domain,$newfilename);
+    if($result) {
+	$request->print('<font color="red">'.$result.'</font></form>');
+    } else {
 	$request->print('<p>Make new file '.&display($newfilename).'?</p>');
 	$request->print('</form>');
 	$request->print('<form action="'.&url($newfilename).