--- loncom/publisher/loncfile.pm 2005/08/26 19:44:16 1.72
+++ loncom/publisher/loncfile.pm 2007/07/10 23:34:54 1.84
@@ -9,7 +9,7 @@
# and displays a page showing the results of the action.
#
#
-# $Id: loncfile.pm,v 1.72 2005/08/26 19:44:16 albertel Exp $
+# $Id: loncfile.pm,v 1.84 2007/07/10 23:34:54 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.'';
}
@@ -195,20 +189,20 @@ sub obsolete_unpub {
}
# see if directory is empty
-# ignores any .meta, .save and .log files created for a previously
+# 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)$/,@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)$/) {
+ if ($file =~ /\.(meta|save|log|bak)$/) {
unlink($dirname.$file);
}
}
@@ -245,6 +239,9 @@ Returns:
=over 4
+=item string - Either undef, 'warning' or 'error' depending on the
+ type of problem
+
=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.
@@ -257,17 +254,27 @@ sub exists {
my ($user, $domain, $construct) = @_;
my $published=$construct;
$published=~
- s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//;
- my $result='';
+ s{^/home/$user/public_html/}{/home/httpd/html/res/$domain/$user/};
+ my ($type,$result);
if ( -d $construct ) {
- return &mt('Error: destination for operation is an existing directory.');
+ return ('error','
'.&mt('Error: destination for operation is an existing directory.').'
');
+
}
+
if ( -e $published) {
- $result.='
'.&mt('Warning: target file exists, and has been published!').'
'.&mt('Warning: target file exists, and has been published!').'
';
+ } else {
+ $type = 'warning';
+ $result.='
'.&mt('Warning: a published file of this names exists.').'
';
+ }
} elsif ( -e $construct) {
- $result.='
'.&mt('Warning: target file exists!').'
';
+ $type = 'warning';
+ $result.='
'.&mt('Warning: target file exists!').'
';
}
- return $result;
+
+ return ($type,$result);
}
=pod
@@ -306,9 +313,9 @@ sub checksuffix {
my $newsuffix;
if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; }
if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }
- if ($oldsuffix ne $newsuffix) {
+ if (lc($oldsuffix) ne lc($newsuffix)) {
$result.=
- '
'.&mt('Warning: change of MIME type!').'
';
+ '
'.&mt('Warning: change of MIME type!').'
';
}
return $result;
}
@@ -329,12 +336,18 @@ sub cleanDest {
my ($newpath)=($dest=~m|(.*)/|);
$newpath=&relativeDest($fn,$newpath,$uname);
if (! -d "$newpath") {
- $request->print("
".&mt('You have requested to create file in directory [_1] which doesn\'t exist. The requested directory path has been removed from the requested file name.','"'.$newpath.'"')."
");
+ $request->print("
".&mt('You have requested to create file in directory [_1] which doesn\'t exist. The requested directory path has been removed from the requested file name.','"'.$newpath.'"')."
");
$dest=~s|.*/||;
}
}
+ if ($dest =~ /\.(\d+)\.(\w+)$/){
+ $request->print(''
+ .&mt('Bad filename [_1]. (name).(number).(extension) not allowed. Removing the .number. from requested filename.',$dest)
+ .'');
+ $dest =~ s/\.(\d+)(\.\w+)$/$2/;
+ }
if ($foundbad) {
- $request->print("
".&mt('Invalid characters in requested name have been removed.')."
");
+ $request->print("
".&mt('Invalid characters in requested name have been removed.')."
");
}
return $dest;
}
@@ -469,9 +482,9 @@ sub Rename1 {
if (-d $fn) {
$newfilename=~/\.(\w+)$/;
if (&Apache::loncommon::fileembstyle($1) eq 'ssi') {
- $request->print(' '.
+ $request->print(' '.
&mt('Cannot change MIME type of a directory').
- ''.
+ ''.
' '.&mt('Cancel').'');
return;
}
@@ -481,9 +494,9 @@ sub Rename1 {
while ($newfilename=~m:/\.\./:) {
$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
}
- my $return=&exists($user, $domain, $newfilename);
+ my ($type, $return)=&exists($user, $domain, $newfilename);
$request->print($return);
- if ($return =~/^Error:/) {
+ if ($type eq 'error') {
$request->print(' '.&mt('Cancel').'');
return;
}
@@ -609,9 +622,9 @@ sub Copy1 {
$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
}
$request->print(&checksuffix($fn,$newfilename));
- my $return=&exists($user, $domain, $newfilename);
+ my ($type,$return)=&exists($user, $domain, $newfilename);
$request->print($return);
- if ($return =~/^Error:/) {
+ if ($type eq 'error') {
$request->print(' '.&mt('Cancel').'');
return;
}
@@ -667,9 +680,10 @@ causes the newdir operation to transitio
sub NewDir1 {
my ($request, $username, $domain, $fn, $newfilename, $mode) = @_;
- my $result=&exists($username,$domain,$newfilename);
+ my ($type, $result)=&exists($username,$domain,$newfilename);
+ $request->print($result);
if ($result) {
- $request->print(''.$result.'');
+ $request->print('');
} else {
if ($mode eq 'testbank') {
$request->print('');
@@ -743,29 +757,31 @@ sub NewFile1 {
##Informs User (name).(number).(extension) not allowed
if($newfilename =~ /\.(\d+)\.(\w+)$/){
- $r->print(''.$newfilename.
+ $r->print(''.$newfilename.
' - '.&mt('Bad Filename').' ('.&mt('name').').('.&mt('number').').('.&mt('extension').') '.
- ' '.&mt('Not Allowed').'');
+ ' '.&mt('Not Allowed').'');
return;
}
if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){
- $r->print(''.$newfilename.
+ $r->print(''.$newfilename.
' - '.&mt('Bad Filename').' ('.&mt('Must not include').' '.$1.') '.
- ' '.&mt('Not Allowed').'');
+ ' '.&mt('Not Allowed').'');
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.'');
+ my ($type, $result)=&exists($user,$domain,$newfilename);
+ $request->print($result);
+ if ($type eq 'error') {
+ $request->print('');
} else {
+
$request->print('
'.&mt('Make new file').' '.&display($newfilename).'?