[LON-CAPA-cvs] cvs: loncom /publisher loncfile.pm
foxr
lon-capa-cvs@mail.lon-capa.org
Sun, 28 Jul 2002 02:16:59 -0000
This is a MIME encoded message
--foxr1027822619
Content-Type: text/plain
foxr Sat Jul 27 22:16:59 2002 EDT
Modified files:
/loncom/publisher loncfile.pm
Log:
Complete rewrite:
- Break out functionality.
- Integrate pod as per proposed commenting standard to see how that works.
NOTE: Work still to be done:
- Test cancel code paths.
- Ensure that bugs: 52, 115, 158, 195, 259, 443, 457, 540 get addressed.
- Figure out how to address bugs 442, 516 543
--foxr1027822619
Content-Type: text/plain
Content-Disposition: attachment; filename="foxr-20020727221659.txt"
Index: loncom/publisher/loncfile.pm
diff -u loncom/publisher/loncfile.pm:1.11 loncom/publisher/loncfile.pm:1.12
--- loncom/publisher/loncfile.pm:1.11 Thu Jun 6 21:35:48 2002
+++ loncom/publisher/loncfile.pm Sat Jul 27 22:16:59 2002
@@ -10,7 +10,7 @@
#
#
-# $Id: loncfile.pm,v 1.11 2002/06/07 01:35:48 albertel Exp $
+# $Id: loncfile.pm,v 1.12 2002/07/28 02:16:59 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -53,6 +53,34 @@
# 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
+
+=head1 NAME
+
+Apache::loncfile - Construction space file management.
+
+=head1 SYNOPSIS
+
+ Content handler for buttons on the top frame of the construction space
+directory.
+
+=head1 INTRODUCTION
+
+ loncfile is invoked when buttons in the top frame of the construction
+space directory listing are clicked. All operations procede in two phases.
+The first phase describes to the user exactly what will be done. If the user
+confirms the operation, the second phase commits the operation and indicates
+completion. When the user dismisses the output of phase2, they are returned to
+an "appropriate" directory listing in general.
+
+ This is part of the LearningOnline Network with CAPA project
+described at http://www.lon-capa.org.
+
+=head2 Subroutines
+
+=cut
package Apache::loncfile;
@@ -65,59 +93,281 @@
my $DEBUG=0;
my $r; # Needs to be global for some stuff RF.
-#
-# Debug
-# If debugging is enabled puts out a debuggin message determined by the
-# caller. The debug message goes to the Apache error log file.
-#
-# Parameters:
-# r - Apache request [in]
-# message - String [in]
-# Returns:
-# nothing.
+
+=pod
+
+=item Debug($request, $message)
+
+ If debugging is enabled puts out a debuggin message determined by the
+ caller. The debug message goes to the Apache error log file. Debugging
+ is enabled by ssetting the module global DEBUG variable to nonzero (TRUE).
+
+ Parameters:
+
+=over 4
+
+=item $request - The curretn request operation.
+
+=item $message - The message to put inthe log file.
+
+=back
+
+ Returns:
+ nothing.
+
+=cut
+
sub Debug {
- my $r = shift;
- my $log = $r->log;
- my $message = shift;
- if ($DEBUG) {
- $log->debug($message);
- }
+
+ # Marshall the parameters.
+
+ my $r = shift;
+ my $log = $r->log;
+ my $message = shift;
+
+ # Put out the indicated message butonly if DEBUG is false.
+
+ if ($DEBUG) {
+ $log->debug($message);
+ }
}
-#
-# URLToPath
-# Convert a URL to a file system path.
-#
-# In order to manipulate the construction space objects, it's necessary
-# to access url identified objects a filespace objects. This function
-# translates a construction space URL to a file system path.
-# Parameters:
-# Url - string [in] The url to convert.
-# Returns:
-# The corresponing file system path.
-sub URLToPath
+
+=pod
+
+=item URLToPath($url)
+
+ Convert a URL to a file system path.
+
+ In order to manipulate the construction space objects, it is necessary
+ to access url identified objects a filespace objects. This function
+ translates a construction space URL to a file system path.
+ Parameters:
+
+=over 4
+
+=item Url - string [in] The url to convert.
+
+=back
+
+ Returns:
+
+=over 4
+
+=item The corresponing file system path.
+
+=back
+
+Global References
+
+=over 4
+
+=item $r - Request object [in] Referenced in the &Debug calls.
+
+=back
+
+=cut
+
+sub URLToPath {
+ my $Url = shift;
+ &Debug($r, "UrlToPath got: $Url");
+ $Url=~ s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
+ $Url=~ s/^http\:\/\/[^\/]+//;
+ &Debug($r, "Returning $Url \n");
+ return $Url;
+}
+
+=pod
+
+=item PublicationPath($domain, $user, $dir, $file)
+
+ Determines the filesystem path corersponding 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 pathr elatvie to the top of the resource space0
+
+=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 $Url = shift;
- &Debug($r, "UrlToPath got: $Url");
- $Url=~ s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
- $Url=~ s/^http\:\/\/[^\/]+//;
- &Debug($r, "Returning $Url \n");
- return $Url;
+ 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 corersponding 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 relatvie 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 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
+
+=item exists($user, $domain, $directory, $file)
+
+ Determine if a resource file name has been publisehd or exists
+ in the construction space.
+
+ Parameters:
+
+=over 4
+
+=item $user - string [in] - Name of the user for which to check.
+
+=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
+
+Returns:
+
+=over 4
+
+=item string - Either where the resource exists as an html string that can
+ be embedded in a dialog or an empty string if the resource
+ does not exist.
+
+=back
+
+=cut
+
sub exists {
- my ($uname,$udom,$dir,$newfile)=@_;
- my $published='/home/httpd/html/res/'.$udom.'/'.$uname.'/'.$dir.'/'.
- $ENV{'form.newfilename'};
- my $construct='/home/'.$uname.'/public_html/'.$dir.'/'.
- $ENV{'form.newfilename'};
- my $result;
- 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;
+ my ($user, $domain, $dir, $file) = @_;
+
+ # Create complete paths in publication and construction space.
+
+ my $published = &PublicationPath($domain, $user, $dir, $file);
+ my $construct = &ConstructionPath($user, $dir, $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 ( -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;
+
}
+=pod
+
+=item checksuffix($old, $new)
+
+ Determine if a resource filename suffix (the stuff after the .) would change
+as a result of this operation.
+
+ Parameters:
+
+=over 4
+
+=item $old = string [in] Previous filename.
+
+=item $new = string [in] Resultant filename.
+
+=back
+
+ Returns:
+
+=over 4
+
+=item Empty string if everythikng worked.
+
+=item String containing an error message if there was a problem.
+
+=back
+
+=cut
+
sub checksuffix {
my ($old,$new) = @_;
my $result;
@@ -126,166 +376,634 @@
if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; }
if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }
if ($oldsuffix ne $newsuffix) {
- $result.='<p><font color=red>Warning: change of MIME type!</font></p>';
+ $result.=
+ '<p><font color=red>Warning: change of MIME type!</font></p>';
}
return $result;
}
+=pod
-sub phaseone {
- my ($r,$fn,$uname,$udom)=@_;
+=item CloseForm1($request, $user, $file)
+
+ Close of a form on the successful completion of phase 1 processing
+
+Parameters:
+
+=over 4
- $fn=~m:(.*)/([^/]+)\.(\w+)$:;
- my $dir=$1;
- my $main=$2;
- my $suffix=$3;
-
- my $conspace;
- if ($fn =~ m-^/home/-) {
- $conspace=$fn;
+=item $request - Apache Request Object [in] - Apache server request object.
+
+=item $user - string [in] - Name of the user initiating the request.
+
+=item $file - A filename.
+
+=back
+
+=cut
+
+sub CloseForm1 {
+ my ($request, $user, $file) = @_;
+ my $url = "/priv/".$file;
+
+
+ $url =~ s/public_html\///;
+ $url =~ s/\/home//;
+ $url =~ s/\/\//\//;
+
+ $request->print('<p><input type=submit value=Continue></p></form>');
+ $request->print('<form action="'.$url.
+ '" method=GET"><p><input type=submit value=Cancel><p></form>');
+
+}
+
+
+=pod
+
+=item CloseForm2($request, $user, $directory)
+
+ Successfully close off the phase 2 form.
+
+Parameters:
+
+=over 4
+
+=item $request - Apache Request object [in] - The request that is being
+ executed.
+
+=item $user - string [in] - Name of the user that is initiating the
+ request.
+
+=item $directory - string [in] - Directory in which the operation is
+ being done relative to the top level construction space
+ directory.
+
+=back
+
+=cut
+
+sub CloseForm2 {
+ my ($request, $user, $directory) = @_;
+
+ $request->print('<h3><a=href="/priv/'.$user.$directory.'/">Done </a> </h3>');
+}
+
+=pod
+
+=item Rename1($request, $filename, $user, $domain, $dir)
+
+ Perform phase 1 processing of the file rename operation.
+
+Parameters:
+
+=over 4
+
+=item $request - Apache Request Object [in] The request object for the
+current request.
+
+=item $filename - The filename relative to construction space.
+
+=item $user - Name of the user making the request.
+
+=item $domain - User login domain.
+
+=item $dir - Directory specification of the path to the file.
+
+=back
+
+Side effects:
+
+=over 4
+
+=item A new form is displayed prompting for confirmation. The newfilename
+hidden field of this form is loaded with
+new filename relative to the current directory ($dir).
+
+=back
+
+=cut
+
+sub Rename1 {
+ my ($request, $filename, $user, $domain, $dir) = @_;
+ &Debug($request, "Username - ".$user." filename: ".$filename."\n");
+ my $conspace = $filename;
+
+
+ if(-e $conspace) {
+ if($ENV{'form.newfilename'}) {
+ my $newfilename = $ENV{'form.newfilename'};
+ $request->print(&checksuffix($filename, $newfilename));
+ $request->print(&exists($user, $domain, $dir, $newfilename));
+ $request->print('<input type=hidden name=newfilename value="'.
+ $newfilename.
+ '"><p>Rename <tt>'.$filename.'</tt> to <tt>'.
+ $dir.'/'.$newfilename.'</tt>?</p>');
+ &CloseForm1($request, $user, $filename);
+ } else {
+ $request->print('<p>No new filename specified</p></form>');
+ return;
+ }
} else {
- $conspace='/home/'.$uname.'/public_html'.$fn;
+ $request->print('<p> No such File </p> </form>');
+ return;
}
+
+}
+=pod
- $r->print('<form action=/adm/cfile method=post>'.
- '<input type=hidden name=filename value="/~'.$uname.$fn.'">'.
- '<input type=hidden name=phase value=two>'.
- '<input type=hidden name=action value='.$ENV{'form.action'}.'>');
-
- if ($ENV{'form.action'} eq 'rename') {
- if (-e $conspace) {
- if ($ENV{'form.newfilename'}) {
- $r->print(&checksuffix($fn,$ENV{'form.newfilename'}));
- $r->print(&exists($uname,$udom,$dir,$ENV{'form.newfilename'}));
- $r->print('<input type=hidden name=newfilename value="'.
- $ENV{'form.newfilename'}.
- '"><p>Rename <tt>'.$fn.'</tt> to <tt>'.
- $dir.'/'.$ENV{'form.newfilename'}.'</tt>?</p>');
- } else {
- $r->print('<p>No new filename specified.</p></form>');
- return;
- }
- } else {
- $r->print('<p>No such file.</p></form>');
- return;
- }
- } elsif ($ENV{'form.action'} eq 'delete') {
- if (-e $conspace) {
- $r->print('<p>Delete <tt>'.$fn.'</tt>?</p>');
- } else {
- $r->print('<p>No such file.</p></form>');
- return;
- }
- } elsif ($ENV{'form.action'} eq 'copy') {
- if (-e $conspace) {
- if ($ENV{'form.newfilename'}) {
- $r->print(&checksuffix($fn,$ENV{'form.newfilename'}));
- $r->print(&exists($uname,$udom,$dir,$ENV{'form.newfilename'}));
- $r->print('<input type=hidden name=newfilename value="'.
- $ENV{'form.newfilename'}.
- '"><p>Copy <tt>'.$fn.'</tt> to <tt>'.
- $dir.'/'.$ENV{'form.newfilename'}.'</tt>?</p>');
- } else {
- $r->print('<p>No new filename specified.</p></form>');
- return;
- }
- } else {
- $r->print('<p>No such file.</p></form>');
- return;
- }
- } elsif ($ENV{'form.action'} eq 'newdir') {
- my $newdir='/home/'.$uname.'/public_html/'.
- $fn.$ENV{'form.newfilename'};
- if (-e $newdir) {
- $r->print('<p>Directory exists.</p></form>');
- return;
- }
- $r->print('<input type=hidden name=newfilename value="'.
- $ENV{'form.newfilename'}.
- '"><p>Make new directory <tt>'.
- $fn.$ENV{'form.newfilename'}.'</tt>?</p>');
-
+=item Delete1
+
+ Performs phase 1 processing of the delete operation. In phase one
+ we just check to be sure the file exists.
+
+Parameters:
+
+=over 4
+
+=item $request - Apache Request Object [in] request object for the current
+ request.
+
+=item $user - string [in] Name of session user.
+
+=item $filename - string [in] Name fo the file to be deleted:
+ Filename is the full filesystem path to the file.
+
+=back
+
+=cut
+
+sub Delete1 {
+ my ($request, $user, $filename) = @_;
+
+ if( -e $filename) {
+ $request->print('<input type=hidden name=newfilename value="'.
+ $filename.'">');
+ $request->print('<p> Delete <tt>'.$filename.'</tt>?</p>');
+ &CloseForm1($request, $user, $filename);
+ } else {
+ $request->print('<p> No Such file: <tt>'.$filename.'</tt></p></form>');
+ }
+}
+
+=pod
+
+=item Copy1($request, $user, $domain, $filename, $newfilename)
+
+ Performs phase 1 processing of the construction space copy command.
+ Ensure that the source fil eexists. Ensure that a destination exists,
+ also warn if the detination already exists.
+
+Parameters:
+
+=over 4
+
+=item $request - Apache Request Object [in] request object for the current
+ request.
+
+=item $user - string [in] Name of the user initiating the request.
+
+=item $domain - string [in] Domain the initiating user is logged in as
+
+=item $dir - string [in] Directory path.
+
+=item $filename - string [in] Source filename.
+
+=item $newfilename-string [in] Destination filename.
+
+=back
+
+=cut
+
+sub Copy1 {
+ my ($request, $user, $domain, $dir, $filename, $newfilename) = @_;
+
+
+ if(-e $filename) {
+ $request->print(&checksuffix($filename,$newfilename));
+ $request->print(&exists($user, $domain, $dir, $newfilename));
+ $request->print('<input type = hidden name = newfilename value = "'.
+ $dir.'/'.$newfilename.
+ '"><p>Copy <tt>'.$filename.'</tt> to'.
+ '<tt>'.$dir.'/'.$newfilename.'</tt>/?</p>');
+ &CloseForm1($request, $user, $filename);
+ } else {
+ $request->print('<p>No such file <tt>'.$filename.'</p></form>');
+ }
+}
+
+=pod
+
+=item NewDir1
+
+ Does all phase 1 processing of directory creation:
+ Ensures that the user provides a new directory name,
+ and that the directory does not already exist.
+
+Parameters:
+
+=over 4
+
+=item $request - Apache Request Object [in] - Server request object for the
+ current url..
+
+=item $username - Name of the user that is requesting the directory creation.
+
+=item $path - current directory relative to construction spacee.
+
+=item $newdir - Name of the directory to be created; path relative to the
+ top level of construction space.
+=back
+
+Side Effects:
+
+=over 4
+
+=item A new form is displayed. Clicking on the confirmation button
+causes the newdir operation to transition into phase 2. The hidden field
+"newfilename" is set with the construction space path to the new directory.
+
+
+=back
+
+=cut
+
+
+sub NewDir1
+{
+ my ($request, $username, $path, $newdir) = @_;
+
+ my $fullpath = '/home/'.$username.'/public_html/'.
+ $path.'/'.$newdir;
+ Debug($request, "Full path is : ".$fullpath);
+
+ if(-e $fullpath) {
+ $request->print('<p>Directory exists.</p></form>');
+ }
+ else {
+ $request->print('<input type=hidden name=newfilename value="'.
+ $newdir.'"><p>Make new directory <tt>'.
+ $path."/".$newdir.'</tt>?</p>');
+ &CloseForm1($request, $username, $newdir);
+
+ }
+}
+
+=pod
+
+=item phaseone($r, $fn, $uname, $udom)
+
+ Peforms phase one processing of the request. In phase one, error messages
+are returned if the request cannot be performed (e.g. attempts to manipulate
+files that are nonexistent). If the operation can be performed, what is
+about to be done will be presented to the user for confirmation. If the
+user confirms the request, then phase two is executed, the action
+performed and reported to the user.
+
+ Parameters:
+
+=over 4
+
+=item $r - request object [in] - The Apache request being executed.
+
+=item $fn = string [in] - The filename being manipulated by the
+ request.
+
+=item $uname - string [in] Name of user logged in and doing this action.
+
+=item $udom - string [in] Domain nmae under which the user logged in.
+
+=back
+
+=cut
+
+sub phaseone {
+ my ($r,$fn,$uname,$udom)=@_;
+
+ $fn=~m:(.*)/([^/]+)\.(\w+)$:;
+ my $dir=$1;
+ my $main=$2;
+ my $suffix=$3;
+
+ # my $conspace=ConstructionPathFromRelative($uname, $fn);
+
+
+ $r->print('<form action=/adm/cfile method=post>'.
+ '<input type=hidden name=filename value="/~'.$uname.$fn.'">'.
+ '<input type=hidden name=phase value=two>'.
+ '<input type=hidden name=action value='.$ENV{'form.action'}.'>');
+
+ if ($ENV{'form.action'} eq 'rename') {
+
+ &Rename1($r, $fn, $uname, $udom, $dir);
+
+ } elsif ($ENV{'form.action'} eq 'delete') {
+
+ &Delete1($r, $uname, $fn);
+
+ } elsif ($ENV{'form.action'} eq 'copy') {
+ if($ENV{'form.newfilename'}) {
+ my $newfilename = $ENV{'form.newfilename'};
+ &Copy1($r, $uname, $udom, $dir, $fn, $newfilename);
+ }else {
+ $r->print('<p>No new filename specified.</p></form>');
+ }
+ } elsif ($ENV{'form.action'} eq 'newdir') {
+ &NewDir1($r, $uname, $dir, $ENV{'form.newfilename'});
+ }
+
+}
+
+=pod
+
+=item Rename2($request, $user, $directory, $oldfile, $newfile)
+
+Performs phase 2 procesing of a rename reequest. This is where the
+actual rename is performed.
+
+Parameters
+
+=over 4
+
+=item $request - Apache request object [in] The request being processed.
+
+=item $user - string [in] The name of the user initiating the request.
+
+=item $directory - string [in] The name of the directory relative to the
+ construction space top level of the renamed file.
+
+=item $oldfile - Name of the file.
+
+=item $newfile - Name of the new file.
+
+=back
+
+Returns:
+
+=over 4
+
+=item 1 Success.
+
+=item 0 Failure.
+
+=cut
+
+sub Rename2 {
+
+ my ($request, $user, $directory, $oldfile, $newfile) = @_;
+
+ &Debug($request, "Rename2 directory: ".$directory." old file: ".$oldfile.
+ " new file ".$newfile."\n");
+ &Debug($request, "Target is: ".$directory.'/'.
+ $newfile);
+
+ if(-e $oldfile) {
+ unless(rename($oldfile,
+ $directory.'/'.$newfile)) {
+ $request->print('<font color=red>Error: '.$!.'</font>');
+ return 0;
+ } else {}
+ } else {
+ $request->print("<p> No such file: /home".$user.'/public_html'.
+ $oldfile.' </p></form>');
+ return 0;
+ }
+ return 1;
+}
+=pod
+
+=item Delete2($request, $user, $filename)
+
+ Performs phase two of a delete. The user has confirmed that they want
+to delete the selected file. The file is deleted and the results of the
+delete attempt are indicated.
+
+Parameters:
+
+=over 4
+
+=item $request - Apache Request object [in] the request object for the current
+ delete operation.
+
+=item $user - string [in] The name of the user initiating the delete
+ request.
+
+=item $filename - string [in] The name of the file, relative to construction space,
+ to delete.
+
+=back
+
+Returns:
+ 1 - success.
+ 0 - Failure.
+
+=cut
+
+sub Delete2 {
+ my ($request, $user, $filename) = @_;
+
+ if(-e $filename) {
+ unless(unlink($filename)) {
+ $request->print('<font color=red>Error: '.$!.'</font>');
+ return 0;
}
- $r->print('<p><input type=submit value=Continue></p></form>');
- $r->print('<form action="/priv/'.$uname.$fn.
- '" method="GET"><p><input type=submit value=Cancel></p></form>');
+ } else {
+ $request->print('<p> No such file. </form');
+ return 0;
+ }
+ return 1;
+}
+
+=pod
+
+=item Copy2($request, $username, $dir, $oldfile, $newfile)
+
+ Performs phase 2 of a copy. The file is copied and the status
+ of that copy is reported back to the user.
+
+=over 4
+=item $request - Apache request object [in]; the apache request currently
+ being executed.
+
+=item $username - string [in] Name of the user who is requesting the copy.
+
+=item $dir - string [in] Directory path relative to the construction space
+ of the destination file.
+
+=item $oldfile - string [in] Name of the source file.
+
+=item $newfile - string [in] Name of the destination file.
+
+
+=back
+
+Returns 0 failure, and 0 successs.
+
+=cut
+
+sub Copy2 {
+ my ($request, $username, $dir, $oldfile, $newfile) = @_;
+ &Debug($request ,"Will try to copy $oldfile to $newfile");
+ if(-e $oldfile) {
+ unless (copy($oldfile, $newfile)) {
+ $request->print('<font color=red> Error: '.$!.'</font>');
+ return 0;
+ } else {
+ return 1;
+ }
+ } else {
+ $request->print('<p> No such file </p>');
+ return 0;
+ }
+ return 1;
+}
+=pod
+
+=item NewDir2($request, $user, $newdirectory)
+
+ Performs phase 2 processing of directory creation. This involves creating the directory and
+ reporting the results of that creation to the user.
+
+Parameters:
+=over 4
+
+=item $request - Apache request object [in]. Object representing the current HTTP request.
+
+=item $user - string [in] The name of the user that is initiating the request.
+
+=item $newdirectory - string [in] The full path of the directory being created.
+
+=back
+
+Returns 0 - failure 1 - success.
+
+=cut
+
+sub NewDir2 {
+ my ($request, $user, $newdirectory) = @_;
+
+ unless(mkdir($newdirectory, 02770)) {
+ $request->print('<font color=red>Error: '.$!.'</font>');
+ return 0;
+ }
+ unless(chmod(02770, ($newdirectory))) {
+ $request->print('<font color=red> Error: '.$!.'</font>');
+ return 0;
+ }
+ return 1;
}
+=pod
+
+=item phasetwo($r, $fn, $uname, $udom)
+
+ Controls the phase 2 processing of file management
+ requests for construction space. In phase one, the user
+ was asked to confirm the operation. In phase 2, the operation
+ is performed and the result is shown.
+
+ The strategy is to break out the processing into specific action processors
+ named action2 where action is the requested action and the 2 denotes
+ phase 2 processing.
+
+Parameters:
+
+=over 4
+
+=item $r - Apache Request object [in] The request object for this httpd
+ transaction.
+
+=item $fn - string [in] A filename indicating the object that is being
+ manipulated.
+
+=item $uname - string [in] The name of the user initiating the file management
+ request.
+
+=item $udom - string [in] The login domain of the user initiating the
+ file management request.
+=back
+
+=cut
+
sub phasetwo {
my ($r,$fn,$uname,$udom)=@_;
-
+
&Debug($r, "loncfile - Entering phase 2 for $fn");
-
+
+ # Break down the file into it's component pieces.
+
$fn=~/(.*)\/([^\/]+)\.(\w+)$/;
- my $dir=$1;
- my $main=$2;
- my $suffix=$3;
- $dir =~ s-^/[^/]*/[^/]*/[^/]*--;
+ my $dir=$1; # Directory path
+ my $main=$2; # Filename.
+ my $suffix=$3; # Extension.
+ my $dest; # On success this is where we'll go.
- &Debug($r, "loncfile::phase2 dir = $dir main = $main suffix = $suffix");
+ &Debug($r,
+ "loncfile::phase2 dir = $dir main = $main suffix = $suffix");
+ &Debug($r,
+ " newfilename = ".$ENV{'form.newfilename'});
my $conspace=$fn;
-
- &Debug($r, "loncfile::phase2 Full construction space name: $conspace");
-
- &Debug($r, "loncfie::phase2 action is $ENV{'form.action'}");
-
- if ($ENV{'form.action'} eq 'rename') {
- if (-e $conspace) {
- if ($ENV{'form.newfilename'}) {
- unless (rename($fn,
- '/home/'.$uname.'/public_html'.$dir.'/'.$ENV{'form.newfilename'})) {
- $r->print('<font color=red>Error: '.$!.'</font>');
- }
- }
- } else {
- $r->print('<p>No such file.</form>');
- return;
- }
+
+ &Debug($r,
+ "loncfile::phase2 Full construction space name: $conspace");
+
+ &Debug($r,
+ "loncfie::phase2 action is $ENV{'form.action'}");
+
+ # Select the appropriate processing sub.
+
+ if ($ENV{'form.action'} eq 'rename') { # Rename.
+ if($ENV{'form.newfilename'}) {
+ if(!&Rename2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {
+ return;
+ }
+ # Prepend the directory to the new name to form the basis of the
+ # url of the new resource.
+ #
+ $dest = $dir."/".$ENV{'form.newfilename'};
+ }
} elsif ($ENV{'form.action'} eq 'delete') {
- if (-e $conspace) {
- unless (unlink($fn)) {
- $r->print('<font color=red>Error: '.$!.'</font>');
- }
- } else {
- $r->print('<p>No such file.</form>');
- return;
- }
+ if(!&Delete2($r, $uname, $ENV{'form.newfilename'})) {
+ return ;
+ }
+ # Once a resource is deleted, we just list the directory that
+ # previously held it.
+ #
+ $dest = $dir."/"; # Parent dir.
} elsif ($ENV{'form.action'} eq 'copy') {
- if (-e $conspace) {
- if ($ENV{'form.newfilename'}) {
- unless (copy($fn,
- '/home/'.$uname.'/public_html'.$dir.'/'.$ENV{'form.newfilename'})) {
- $r->print('<font color=red>Error: '.$!.'</font>');
- }
- } else {
- $r->print('<p>No new filename specified.</form>');
- return;
- }
- } else {
- $r->print('<p>No such file.</form>');
- return;
- }
+ if($ENV{'form.newfilename'}) {
+ if(!&Copy2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {
+ return
+ }
+ $dest = $ENV{'form.newfilename'};
+
+ } else {
+ $r->print('<p>No New filename specified</form>');
+ return;
+ }
+
} elsif ($ENV{'form.action'} eq 'newdir') {
+ #
+ # Since the newfilename form field is construction space
+ # relative, ew need to prepend the current path; now in $fn.
+ #
my $newdir= $fn.$ENV{'form.newfilename'};
-
- &Debug($r, "loncfile::phasetwo - new directory name: $newdir");
-
- unless (mkdir($newdir,0770)) {
- $r->print('<font color=red>Error: '.$!.'</font>');
- &Debug($r, "loncfile::phasetwo - mkdir failed $!");
- }
- &Debug($r, "Done button: uname = $uname, dir = $dir, fn = $fn");
- my $url = '/priv/'.$uname.$newdir.'/';
- &Debug($r, "URL[1] = ".$url);
- $url =~ s/\/home\/$uname\/public_html//o;
- &Debug($r, "URL = ".$url);
-
- $r->print('<h3><a href="'.$url.'">Done</a></h3>');
- return;
+ if(!&NewDir2($r, $uname, $newdir)) {
+ return;
+ }
+ $dest = $newdir."/"
}
- $r->print('<h3><a href="/priv/'.$uname.$dir.'/">Done</a></h3>');
+ #
+ # Substitute for priv for the first home in $dir to get our
+ # construction space path.
+ #
+ &Debug($r, "Final url is: $dest");
+ $dest =~ s/\/home\//\/priv\//;
+ $dest =~ s/\/public_html//;
+ &Debug($r, "Final url after rewrite: $dest");
+
+ $r->print('<h3><a href="'.$dest.'">Done</a></h3>');
}
sub handler {
@@ -294,6 +1012,8 @@
&Debug($r, "loncfile.pm - handler entered");
+ &Debug($r, " filename: ".$ENV{'form.filename'});
+ &Debug($r, " newfilename: ".$ENV{'form.newfilename'});
my $fn;
--foxr1027822619--