[LON-CAPA-cvs] cvs: loncom /publisher loncfile.pm
www
lon-capa-cvs@mail.lon-capa.org
Sun, 03 Aug 2003 00:40:01 -0000
This is a MIME encoded message
--www1059871201
Content-Type: text/plain
www Sat Aug 2 20:40:01 2003 EDT
Modified files:
/loncom/publisher loncfile.pm
Log:
Just saving my work. This is hard.
Really, there are always only two relevant filenames:
$fn: where we are right now
$newfilename: any second fileparameter (copy, rename, etc)
Make sure that these are now *always* full *file*-paths, e.g.
/home/author/public_html/bar/foo.html
--www1059871201
Content-Type: text/plain
Content-Disposition: attachment; filename="www-20030802204001.txt"
Index: loncom/publisher/loncfile.pm
diff -u loncom/publisher/loncfile.pm:1.35 loncom/publisher/loncfile.pm:1.36
--- loncom/publisher/loncfile.pm:1.35 Fri Aug 1 16:32:05 2003
+++ loncom/publisher/loncfile.pm Sat Aug 2 20:40:00 2003
@@ -9,7 +9,7 @@
# and displays a page showing the results of the action.
#
#
-# $Id: loncfile.pm,v 1.35 2003/08/01 20:32:05 www Exp $
+# $Id: loncfile.pm,v 1.36 2003/08/03 00:40:00 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -33,27 +33,6 @@
#
# 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
=head1 NAME
@@ -180,6 +159,18 @@
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
=item PublicationPath($domain, $user, $dir, $file)
@@ -249,41 +240,6 @@
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
@@ -338,8 +294,7 @@
}
if ( -e $published) {
$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>';
}
@@ -400,6 +355,23 @@
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
=item CloseForm1($request, $user, $file)
@@ -419,14 +391,10 @@
=cut
sub CloseForm1 {
- my ($request, $cancelurl) = @_;
-
-
- &Debug($request, "Cancel url is: ".$cancelurl);
+ my ($request, $fn) = @_;
$request->print('<p><input type="submit" value="Continue" /></p></form>');
- $request->print('<form action="'.$cancelurl.
- '" method="POST"><p><input type="submit" value="Cancel" /></p></form>');
-
+ $request->print('<form action="'.&url($fn).
+ '" method="POST"><p><input type="submit" value="Cancel" /></p></form>');
}
@@ -455,9 +423,8 @@
=cut
sub CloseForm2 {
- my ($request, $user, $directory) = @_;
-
- $request->print('<h3><a href="/priv/'.$user.$directory.'/">Done </a> </h3>');
+ my ($request, $user, $fn) = @_;
+ $request->print('<h3><a href="'.&url($fn).'/">Done</a></h3>');
}
=pod
@@ -496,49 +463,41 @@
=cut
sub Rename1 {
- my ($request, $filename, $user, $domain, $dir) = @_;
- &Debug($request, "Username - ".$user." filename: ".$filename."\n");
- my $conspace = $filename;
-
- my $cancelurl = "/priv/".$filename;
- $cancelurl =~ s/\/home\///;
- $cancelurl =~ s/\/public_html//;
-
- if(-e $conspace) {
- if($ENV{'form.newfilename'}) {
- my $newfilename = $ENV{'form.newfilename'};
+ my ($request, $user, $domain, $fn, $newfilename) = @_;
+
+ if(-e $fn) {
+ if($newfilename) {
if ($newfilename =~ m|/[^\.]+$|) {
- #no extension add on orignal extension
- if ($filename =~ m|/[^\.]*\.([^\.]+)$|) {
+ #no extension add on original extension
+ if ($fn =~ m|/[^\.]*\.([^\.]+)$|) {
$newfilename.='.'.$1;
}
}
- $request->print(&checksuffix($filename, $newfilename));
+ $request->print(&checksuffix($fn, $newfilename));
#renaming a dir, delete the trailing /
#remove last element for current dir
- if ($filename =~ m|/$|) {
- $filename =~ s|/$||;
+ my $dir=$fn;
+ if ($fn =~ m|/$|) {
+ $fn =~ s|/$||;
$dir =~ s|/[^/]*$||;
}
my $return=&exists($user, $domain, $dir, $newfilename);
$request->print($return);
if ($return =~/^Error:/) {
- $request->print('<br /><a href="'.$cancelurl.'">Cancel</a>');
+ $request->print('<br /><a href="'.&url($fn).'">Cancel</a>');
return;
}
- my $dest=&SimplifyDir($dir,$newfilename);
$request->print('<input type="hidden" name="newfilename" value="'.
$newfilename.
- '" /><p>Rename <tt>'.$filename.
- '</tt><br /> to <tt>'.
- $dest.'</tt>?</p>');
- &CloseForm1($request, $cancelurl);
+ '" /><p>Rename '.&display($fn).
+ '</tt><br />to '.&display($newfilename).'?</p>');
+ &CloseForm1($request, $fn);
} else {
- $request->print('<p>No new filename specified</p></form>');
+ $request->print('<p>No new filename specified.</p></form>');
return;
}
} else {
- $request->print('<p> No such File </p> </form>');
+ $request->print('<p> No such file: '.&display($fn).'</p></form>');
return;
}
@@ -554,34 +513,29 @@
=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.
-=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:
- Filename is the full filesystem path to the file.
+=item $filename - string [in] Source filename.
=back
=cut
sub Delete1 {
- my ($request, $user, $filename) = @_;
-
- my $cancelurl = '/priv/'.$filename;
- $cancelurl =~ s/\/home\///;
- $cancelurl =~ s/\/public_html//;
-
+ my ($request, $user, $domain, $fn) = @_;
- if( -e $filename) {
+ if( -e $fn) {
$request->print('<input type="hidden" name="newfilename" value="'.
- $filename.'"/>');
- $request->print('<p> Delete <tt>'.$filename.'</tt>?</p>');
- &CloseForm1($request, $cancelurl);
+ $fn.'"/>');
+ $request->print('<p>Delete '.&display($fn).'?</p>');
+ &CloseForm1($request, $fn);
} else {
- $request->print('<p> No Such file: <tt>'.$filename.'</tt></p></form>');
+ $request->print('<p>No such file: '.&display($fn).'</p></form>');
}
}
@@ -604,9 +558,7 @@
=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 $fn - string [in] Source filename.
=item $newfilename-string [in] Destination filename.
@@ -615,62 +567,28 @@
=cut
sub Copy1 {
- my ($request, $user, $domain, $dir, $filename, $newfilename) = @_;
+ my ($request, $user, $domain, $fn, $newfilename) = @_;
- my $cancelurl = "/priv/".$filename;
- $cancelurl =~ s/\/home\///;
- $cancelurl =~ s/\/public_html//;
-
-
- if(-e $filename) {
- $request->print(&checksuffix($filename,$newfilename));
- my $return=&exists($user, $domain, $dir, $newfilename);
+ if(-e $fn) {
+ $request->print(&checksuffix($fn,$newfilename));
+ my $return=&exists($user, $domain, $fn, $newfilename);
$request->print($return);
if ($return =~/^Error:/) {
- $request->print('<br /><a href="'.$cancelurl.'">Cancel</a>');
+ $request->print('<br /><a href="'.&url($fn).'">Cancel</a>');
return;
}
- my $dest=&SimplifyDir($dir,$newfilename);
$request->print('<input type = "hidden" name = "newfilename" value = "'.
- $dir.'/'.$newfilename.
- '" /><p>Copy <tt>'.$filename.'</tt><br /> to '.
- '<tt>'.$dest.'</tt>?</p>');
- &CloseForm1($request, $cancelurl);
+ $newfilename.
+ '" /><p>Copy '.&display($fn).'<br />to '.
+ &display($newfilename).'?</p>');
+ &CloseForm1($request, $fn);
} else {
- $request->print('<p>No such file <tt>'.$filename.'</p></form>');
+ $request->print('<p>No such file: '.&display($fn).'</p></form>');
}
}
=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
Does all phase 1 processing of directory creation:
@@ -686,7 +604,9 @@
=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
top level of construction space.
@@ -708,24 +628,16 @@
sub NewDir1
{
- my ($request, $username, $path, $newdir) = @_;
-
- my $fullpath = '/home/'.$username.'/public_html/'.
- $path.'/'.$newdir;
-
- my $cancelurl = '/priv/'.$username.'/'.$path;
-
- &Debug($request, "Full path is : ".$fullpath);
+ my ($request, $username, $domain, $fn, $newfilename) = @_;
- if(-e $fullpath) {
+ if(-e $newfilename) {
$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, $cancelurl);
-
+ $newfilename.'" /><p>Make new directory '.
+ &display($newfilename).'?</p>');
+ &CloseForm1($request, $fn);
}
}
@@ -750,7 +662,7 @@
=item $domain - Name of the domain of the user
-=item $dir - current absolute diretory
+=item $fn - Source file name
=item $newfilename
- Name of the file to be created; no path information
@@ -762,7 +674,7 @@
=item 2 new forms are displayed. Clicking on the confirmation button
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
=back
@@ -771,14 +683,7 @@
sub NewFile1 {
- my ($request, $user, $domain, $dir, $newfilename) = @_;
-
- &Debug($request, "Dir is : ".$dir);
- &Debug($request, "Newfile is : ".$newfilename);
-
- my $cancelurl = "/priv/".$dir;
- $cancelurl =~ s/\/home\///;
- $cancelurl =~ s/\/public_html//;
+ my ($request, $user, $domain, $fn, $newfilename) = @_;
if ($ENV{'form.action'} =~ /new(.+)file/) {
my $extension=$1;
@@ -791,22 +696,15 @@
}
}
- my $fullpath = $dir.'/'.$newfilename;
-
- &Debug($request, "Full path is : ".$fullpath);
-
- if(-e $fullpath) {
+ if(-e $newfilename) {
$request->print('<p>File exists.</p></form>');
}
else {
- $request->print('<p>Make new file <tt>'.$dir.'/'.$newfilename.'</tt>?</p>');
- my $dest=&MakeFinalUrl($request,$fullpath);
- &Debug($request, "Cancel url is: ".$cancelurl);
- &Debug($request, "Dest url is: ".$dest);
+ $request->print('<p>Make new file '.&display($newfilename).'?</p>');
$request->print('</form>');
- $request->print('<form action="'.$dest.
+ $request->print('<form action="'.&url($newfilename).
'" 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>');
}
}
@@ -842,39 +740,26 @@
sub phaseone {
my ($r,$fn,$uname,$udom)=@_;
- $fn=~m:(.*)/([^/]+)\.(\w+)$:;
- my $dir=$1;
- my $main=$2;
- my $suffix=$3;
-
- # my $conspace=ConstructionPathFromRelative($uname, $fn);
-
- $ENV{'form.newfilename'}=&cleanDest($r,$ENV{'form.newfilename'});
+ my $newfilename=&cleanDest($r,$ENV{'form.newfilename'});
+ $newfilename=&relativeDest($fn,$newfilename,$uname);
$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'}.'" />');
+ '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
+ '<input type="hidden" name="phase" value="two" />'.
+ '<input type="hidden" name="action" value="'.$ENV{'form.action'}.'" />');
if ($ENV{'form.action'} eq 'rename') {
- if (!defined($dir)) {
- $fn=~m:(.*)/:;
- $dir=$1;
- }
- &Rename1($r, $fn, $uname, $udom, $dir);
+ &Rename1($r, $uname, $udom, $fn, $newfilename);
} elsif ($ENV{'form.action'} eq 'delete') {
-
- &Delete1($r, $uname, $fn);
-
+ &Delete1($r, $uname, $udom, $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>');
- }
+ if($newfilename) {
+ &Copy1($r, $uname, $udom, $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'});
+ &NewDir1($r, $uname, $udom, $fn, $newfilename);
} elsif ($ENV{'form.action'} eq 'newfile' ||
$ENV{'form.action'} eq 'newhtmlfile' ||
$ENV{'form.action'} eq 'newproblemfile' ||
@@ -883,13 +768,8 @@
$ENV{'form.action'} eq 'newrightsfile' ||
$ENV{'form.action'} eq 'newstyfile' ||
$ENV{'form.action'} eq 'Select Action') {
- if($ENV{'form.newfilename'}) {
- my $newfilename = $ENV{'form.newfilename'};
- if (!defined($dir)) {
- $fn=~m:(.*)/:;
- $dir=$1;
- }
- &NewFile1($r, $uname, $udom, $dir, $newfilename);
+ if ($newfilename) {
+ &NewFile1($r, $uname, $udom, $fn, $newfilename);
} else {
$r->print('<p>No new filename specified.</p></form>');
}
@@ -1237,12 +1117,18 @@
&Debug($r, "loncfile.pm - handler entered");
&Debug($r, " filename: ".$ENV{'form.filename'});
&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;
if ($ENV{'form.filename'}) {
$fn=&Apache::lonnet::unescape($ENV{'form.filename'});
$fn=&URLToPath($fn);
+ } elsif ($ENV{'form.qualifiedfilename'}) {
+ $fn=$ENV{'form.qualifiedfilename'};
} else {
&Debug($r, "loncfile::handler - no form.filename");
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
@@ -1273,18 +1159,16 @@
return HTTP_NOT_ACCEPTABLE;
}
- $fn=~s/\/\~(\w+)//;
- &Debug($r, "loncfile::handler ~ removed filename: $fn");
$r->content_type('text/html');
$r->send_http_header;
$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'})) {
$r->print('<h3><font color="red">Co-Author: '.$uname.' at '.$udom.
--www1059871201--