--- loncom/publisher/loncfile.pm 2005/05/30 16:56:46 1.69
+++ loncom/publisher/loncfile.pm 2007/03/30 20:37:31 1.81
@@ -9,7 +9,7 @@
# and displays a page showing the results of the action.
#
#
-# $Id: loncfile.pm,v 1.69 2005/05/30 16:56:46 www Exp $
+# $Id: loncfile.pm,v 1.81 2007/03/30 20:37:31 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -69,10 +69,11 @@ use File::Copy;
use HTML::Entities();
use Apache::Constants qw(:common :http :methods);
use Apache::loncacc;
-use Apache::Log ();
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonlocal;
+use LONCAPA qw(:DEFAULT :match);
+
my $DEBUG=0;
my $r; # Needs to be global for some stuff RF.
@@ -101,16 +102,9 @@ my $r; # Needs to be global for some
=cut
sub Debug {
-
- # Marshall the parameters.
-
- my $r = shift;
- my $log = $r->log;
- my $message = shift;
-
# Put out the indicated message butonly if DEBUG is true.
-
if ($DEBUG) {
+ my ($r,$message) = @_;
$r->log_reason($message);
}
}
@@ -156,21 +150,21 @@ sub URLToPath {
$Url=~ s/\/+/\//g;
$Url=~ s/^http\:\/\/[^\/]+//;
$Url=~ s/^\///;
- $Url=~ s/(\~|priv\/)(\w+)\//\/home\/$2\/public_html\//;
+ $Url=~ s/(\~|priv\/)($match_username)\//\/home\/$2\/public_html\//;
&Debug($r, "Returning $Url \n");
return $Url;
}
sub url {
my $fn=shift;
- $fn=~s/^\/home\/(\w+)\/public\_html/\/priv\/$1/;
+ $fn=~s/^\/home\/($match_username)\/public\_html/\/priv\/$1/;
$fn=&HTML::Entities::encode($fn,'<>"&');
return $fn;
}
sub display {
my $fn=shift;
- $fn=~s-^/home/(\w+)/public_html-/priv/$1-;
+ $fn=~s-^/home/($match_username)/public_html-/priv/$1-;
return ''.$fn.'';
}
@@ -194,7 +188,32 @@ sub obsolete_unpub {
}
}
-
+# see if directory is empty
+# ignores any .meta, .save, .bak, and .log files created for a previously
+# published file, which has since been marked obsolete and deleted.
+sub empty_directory {
+ my ($dirname,$phase) = @_;
+ if (opendir DIR, $dirname) {
+ my @files = grep(!/^\.\.?$/, readdir(DIR)); # ignore . and ..
+ if (@files) {
+ my @orphans = grep(/\.(meta|save|log|bak)$/,@files);
+ if (scalar(@files) - scalar(@orphans) > 0) {
+ return 0;
+ } else {
+ if (($phase eq 'Delete2') && (@orphans > 0)) {
+ foreach my $file (@orphans) {
+ if ($file =~ /\.(meta|save|log|bak)$/) {
+ unlink($dirname.$file);
+ }
+ }
+ }
+ }
+ }
+ closedir(DIR);
+ return 1;
+ }
+ return 0;
+}
=pod
@@ -296,9 +315,9 @@ sub cleanDest {
$foundbad=1;
$dest=~s/\.//g;
}
- if ($dest=~/[\#\?&%\"]/) {
+ if ($dest=~/[\#\?&%\":]/) {
$foundbad=1;
- $dest=~s/[\#\?&%\"]//g;
+ $dest=~s/[\#\?&%\":]//g;
}
if ($dest=~m|/|) {
my ($newpath)=($dest=~m|(.*)/|);
@@ -519,11 +538,20 @@ sub Delete1 {
if( -e $fn) {
$request->print('');
- unless (&obsolete_unpub($user,$domain,$fn)) {
- $request->print(''.&mt('Cannot delete non-obsolete published file').'
'.
+ if (-d $fn) {
+ unless (&empty_directory($fn,'Delete1')) {
+ $request->print(''.&mt('Only empty directories may be deleted.').'
'.
+ 'You must delete the contents of the directory first.
'.
+ '
'.&mt('Cancel').'');
+ return;
+ }
+ } else {
+ unless (&obsolete_unpub($user,$domain,$fn)) {
+ $request->print(''.&mt('Cannot delete non-obsolete published file').'
'.
'
'.&mt('Cancel').'');
- return;
- }
+ return;
+ }
+ }
$request->print(''.&mt('Delete').' '.&display($fn).'?
');
&CloseForm1($request, $fn);
} else {
@@ -721,16 +749,16 @@ sub NewFile1 {
return;
}
if ($newfilename !~ /\Q.$extension\E$/) {
- if ($newfilename =~ m|^[^\.]*\.([^\.]+)$|) {
+ if ($newfilename =~ m|/[^/.]*\.(?:[^/.]+)$|) {
#already has an extension strip it and add in expected one
- $newfilename =~ s|.([^\.]+)$||;
+ $newfilename =~ s|(/[^./])\.(?:[^.]+)$|$1|;
}
$newfilename.=".$extension";
}
}
my $result=&exists($user,$domain,$newfilename);
if($result) {
- $request->print(''.$result.'');
+ $request->print(''.$result.'');
} else {
$request->print(''.&mt('Make new file').' '.&display($newfilename).'?
');
$request->print('');
@@ -938,10 +966,8 @@ Returns:
sub Delete2 {
my ($request, $user, $filename) = @_;
- if(opendir DIR, $filename) {
- my @files=readdir(DIR);
- shift @files; shift @files; # takes off . and ..
- if(@files) {
+ if (-d $filename) {
+ unless (&empty_directory($filename,'Delete2')) {
$request->print(' '.&mt('Error: Directory Non Empty').'');
return 0;
} else {
@@ -993,7 +1019,7 @@ sub Delete2 {
=back
-Returns 0 failure, and 0 successs.
+Returns 0 failure, and 1 successs.
=cut
@@ -1001,6 +1027,10 @@ sub Copy2 {
my ($request, $username, $dir, $oldfile, $newfile) = @_;
&Debug($request ,"Will try to copy $oldfile to $newfile");
if(-e $oldfile) {
+ if ($oldfile eq $newfile) {
+ $request->print(' '.&mt('Warning').': '.&mt('Name of new file is the same as name of old file').' - '.&mt('no action taken').'.');
+ return 1;
+ }
unless (copy($oldfile, $newfile)) {
$request->print(' '.&mt('copy Error').': '.$!.'');
return 0;
@@ -1107,7 +1137,7 @@ sub phasetwo {
&Debug($r, "loncfile - Entering phase 2 for $fn");
- # Break down the file into it's component pieces.
+ # Break down the file into its component pieces.
my $dir; # Directory path
my $main; # Filename.
@@ -1120,8 +1150,10 @@ sub phasetwo {
$suffix=$1; #This is the actually filename extension if it exists
$main=~s/\.\w+$//; #strip the extension
}
- my $dest; # On success this is where we'll go.
-
+ my $dest; #
+ my $dest_dir; # On success this is where we'll go.
+ my $disp_newname; #
+ my $dest_newname; #
&Debug($r,"loncfile::phase2 dir = $dir main = $main suffix = $suffix");
&Debug($r," newfilename = ".$env{'form.newfilename'});
@@ -1148,7 +1180,11 @@ sub phasetwo {
if(!&Rename2($r, $uname, $dir, $fn, $env{'form.newfilename'})) {
return;
}
- $dest = $env{'form.newfilename'};
+ $dest = $dir."/";
+ $dest_newname = $env{'form.newfilename'};
+ $env{'form.newfilename'} =~ /.+(\/.+$)/;
+ $disp_newname = $1;
+ $disp_newname =~ s/\///;
}
} elsif ($env{'form.action'} eq 'delete') {
if(!&Delete2($r, $uname, $env{'form.newfilename'})) {
@@ -1179,7 +1215,12 @@ sub phasetwo {
if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) {
$r->print('');
} else {
- $r->print('');
+ if ($env{'form.action'} eq 'rename') {
+ $r->print('');
+ $r->print('');
+ } else {
+ $r->print('');
+ }
}
}
@@ -1201,12 +1242,12 @@ sub handler {
if ($env{'form.filename'}) {
&Debug($r, "test: $env{'form.filename'}");
- $fn=&Apache::lonnet::unescape($env{'form.filename'});
+ $fn=&unescape($env{'form.filename'});
$fn=&URLToPath($fn);
} elsif($ENV{'QUERY_STRING'} && $env{'form.phase'} ne 'two') {
#Just hijack the script only the first time around to inject the
#correct information for further processing
- $fn=&Apache::lonnet::unescape($env{'form.decompress'});
+ $fn=&unescape($env{'form.decompress'});
$fn=&URLToPath($fn);
$env{'form.action'}="decompress";
} elsif ($env{'form.qualifiedfilename'}) {
@@ -1245,10 +1286,12 @@ sub handler {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
+ my (%loaditem,$js);
+
if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) {
my $newdirname = $env{'form.newfilename'};
- $r->print('LON-CAPA Construction Space
- |);
- my $loaditem = 'onLoad="writeDone()"';
- $r->print(&Apache::loncommon::bodytag('Construction Space File Operation','',$loaditem));
- } else {
- $r->print('LON-CAPA Construction Space');
- $r->print(&Apache::loncommon::bodytag('Construction Space File Operation'));
+|;
+ $loaditem{'onload'} = "writeDone()";
}
-
+
+ $r->print(&Apache::loncommon::start_page('Construction Space File Operation',
+ $js,
+ {'add_entries' => \%loaditem,}));
$r->print(''.&mt('Location').': '.&display($fn).'
');
@@ -1297,7 +1339,8 @@ function writeDone() {
$env{'form.action'} eq 'Select Action' ) {
$r->print(''.&mt('New Resource').'
');
} else {
- $r->print(''.&mt('Unknown Action').' '.$env{'form.action'}.'
');
+ $r->print(''.&mt('Unknown Action').' '.$env{'form.action'}.'
'.
+ &Apache::loncommon::end_page());
return OK;
}
if ($env{'form.phase'} eq 'two') {
@@ -1308,7 +1351,7 @@ function writeDone() {
&phaseone($r,$fn,$uname,$udom);
}
- $r->print('