--- loncom/publisher/loncfile.pm 2003/08/28 20:28:33 1.41
+++ loncom/publisher/loncfile.pm 2003/11/19 14:57:32 1.44
@@ -9,7 +9,7 @@
# and displays a page showing the results of the action.
#
#
-# $Id: loncfile.pm,v 1.41 2003/08/28 20:28:33 matthew Exp $
+# $Id: loncfile.pm,v 1.44 2003/11/19 14:57:32 taceyjo1 Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -73,7 +73,7 @@ use Apache::Log ();
use Apache::lonnet;
use Apache::loncommon();
-my $DEBUG=0;
+my $DEBUG=2;
my $r; # Needs to be global for some stuff RF.
=pod
@@ -110,12 +110,31 @@ sub Debug {
# Put out the indicated message butonly if DEBUG is true.
if ($DEBUG) {
- $log->debug($message);
+ $r->log_reason($message);
}
}
=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
+
+=cut
+
+=pod
+
=item URLToPath($url)
Convert a URL to a file system path.
@@ -168,7 +187,7 @@ sub url {
sub display {
my $fn=shift;
- $fn=~s/^\/home\/(\w+)\/public\_html//;
+ $fn=~s-^/home/(\w+)/public_html-/priv/$1-;
return ''.$fn.'';
}
@@ -387,6 +406,10 @@ sub Rename1 {
if(-e $fn) {
if($newfilename) {
+ # is dest a dir
+ if (-d $newfilename) {
+ if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; }
+ }
if ($newfilename =~ m|/[^\.]+$|) {
#no extension add on original extension
if ($fn =~ m|/[^\.]*\.([^\.]+)$|) {
@@ -399,6 +422,10 @@ sub Rename1 {
if (-d $fn) {
$newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/;
}
+ $newfilename=~s://+:/:g; # remove duplicate /
+ while ($newfilename=~m:/\.\./:) {
+ $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
+ }
my $return=&exists($user, $domain, $newfilename);
$request->print($return);
if ($return =~/^Error:/) {
@@ -485,24 +512,36 @@ Parameters:
=cut
sub Copy1 {
- my ($request, $user, $domain, $fn, $newfilename) = @_;
+ my ($request, $user, $domain, $fn, $newfilename) = @_;
- if(-e $fn) {
- $request->print(&checksuffix($fn,$newfilename));
- my $return=&exists($user, $domain, $newfilename);
- $request->print($return);
- if ($return =~/^Error:/) {
- $request->print('
Cancel');
- return;
+ if(-e $fn) {
+ # is dest a dir
+ if (-d $newfilename) {
+ if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; }
+ }
+ if ($newfilename =~ m|/[^\.]+$|) {
+ #no extension add on original extension
+ if ($fn =~ m|/[^\.]*\.([^\.]+)$|) { $newfilename.='.'.$1; }
+ }
+ $newfilename=~s://+:/:g; # remove duplicate /
+ while ($newfilename=~m:/\.\./:) {
+ $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
+ }
+ $request->print(&checksuffix($fn,$newfilename));
+ my $return=&exists($user, $domain, $newfilename);
+ $request->print($return);
+ if ($return =~/^Error:/) {
+ $request->print('
Cancel');
+ return;
+ }
+ $request->print('
Copy '.&display($fn).'
to '.
+ &display($newfilename).'?
No such file: '.&display($fn).'
'); } - $request->print('Copy '.&display($fn).'
to '.
- &display($newfilename).'?
No such file: '.&display($fn).'
'); - } } =pod @@ -559,6 +598,17 @@ sub NewDir1 } } + +sub Decompress1 { + my ($request, $user, $domain, $fn) = @_; + if( -e $fn) { + $request->print(''); + $request->print('Decompress '.&display($fn).'?
'); + &CloseForm1($request, $fn); + } else { + $request->print('No such file: '.&display($fn).'
'); + } +} =pod =item NewFile1 @@ -667,7 +717,7 @@ sub phaseone { my $newfilename=&cleanDest($r,$ENV{'form.newfilename'}); $newfilename=&relativeDest($fn,$newfilename,$uname); - + &Debug($r, "Newfile: $newfilename"); $r->print('