--- loncom/publisher/loncfile.pm 2006/11/22 22:10:58 1.78
+++ loncom/publisher/loncfile.pm 2007/04/26 21:17:16 1.83
@@ -9,7 +9,7 @@
# and displays a page showing the results of the action.
#
#
-# $Id: loncfile.pm,v 1.78 2006/11/22 22:10:58 banghart Exp $
+# $Id: loncfile.pm,v 1.83 2007/04/26 21:17:16 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -72,9 +72,8 @@ use Apache::loncacc;
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonlocal;
-use lib '/home/httpd/lib/perl/';
-use LONCAPA;
-
+use LONCAPA qw(:DEFAULT :match);
+
my $DEBUG=0;
my $r; # Needs to be global for some stuff RF.
@@ -151,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.'';
}
@@ -240,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.
@@ -252,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
@@ -301,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;
}
@@ -324,12 +336,12 @@ 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 ($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;
}
@@ -464,9 +476,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;
}
@@ -476,9 +488,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;
}
@@ -604,9 +616,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;
}
@@ -662,9 +674,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('');
@@ -738,29 +751,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).'?