version 1.77, 2006/05/30 12:47:41
|
version 1.82, 2007/04/20 20:55:01
|
Line 72 use Apache::loncacc;
|
Line 72 use Apache::loncacc;
|
use Apache::lonnet; |
use Apache::lonnet; |
use Apache::loncommon(); |
use Apache::loncommon(); |
use Apache::lonlocal; |
use Apache::lonlocal; |
use lib '/home/httpd/lib/perl/'; |
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA; |
|
|
|
|
|
my $DEBUG=0; |
my $DEBUG=0; |
my $r; # Needs to be global for some stuff RF. |
my $r; # Needs to be global for some stuff RF. |
Line 151 sub URLToPath {
|
Line 150 sub URLToPath {
|
$Url=~ s/\/+/\//g; |
$Url=~ s/\/+/\//g; |
$Url=~ s/^http\:\/\/[^\/]+//; |
$Url=~ s/^http\:\/\/[^\/]+//; |
$Url=~ s/^\///; |
$Url=~ s/^\///; |
$Url=~ s/(\~|priv\/)(\w+)\//\/home\/$2\/public_html\//; |
$Url=~ s/(\~|priv\/)($match_username)\//\/home\/$2\/public_html\//; |
&Debug($r, "Returning $Url \n"); |
&Debug($r, "Returning $Url \n"); |
return $Url; |
return $Url; |
} |
} |
|
|
sub url { |
sub url { |
my $fn=shift; |
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,'<>"&'); |
$fn=&HTML::Entities::encode($fn,'<>"&'); |
return $fn; |
return $fn; |
} |
} |
|
|
sub display { |
sub display { |
my $fn=shift; |
my $fn=shift; |
$fn=~s-^/home/(\w+)/public_html-/priv/$1-; |
$fn=~s-^/home/($match_username)/public_html-/priv/$1-; |
return '<tt>'.$fn.'</tt>'; |
return '<tt>'.$fn.'</tt>'; |
} |
} |
|
|
Line 301 sub checksuffix {
|
Line 300 sub checksuffix {
|
my $newsuffix; |
my $newsuffix; |
if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; } |
if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; } |
if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; } |
if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; } |
if ($oldsuffix ne $newsuffix) { |
if (lc($oldsuffix) ne lc($newsuffix)) { |
$result.= |
$result.= |
'<p><font color="red">'.&mt('Warning: change of MIME type!').'</font></p>'; |
'<p><span class="LC_warning">'.&mt('Warning: change of MIME type!').'</span></p>'; |
} |
} |
return $result; |
return $result; |
} |
} |
Line 464 sub Rename1 {
|
Line 463 sub Rename1 {
|
if (-d $fn) { |
if (-d $fn) { |
$newfilename=~/\.(\w+)$/; |
$newfilename=~/\.(\w+)$/; |
if (&Apache::loncommon::fileembstyle($1) eq 'ssi') { |
if (&Apache::loncommon::fileembstyle($1) eq 'ssi') { |
$request->print('<br /><font color="red">'. |
$request->print('<br /><span classr="LC_warning">'. |
&mt('Cannot change MIME type of a directory'). |
&mt('Cannot change MIME type of a directory'). |
'</font>'. |
'</span>'. |
'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
return; |
return; |
} |
} |
Line 750 sub NewFile1 {
|
Line 749 sub NewFile1 {
|
return; |
return; |
} |
} |
if ($newfilename !~ /\Q.$extension\E$/) { |
if ($newfilename !~ /\Q.$extension\E$/) { |
if ($newfilename =~ m|^[^\.]*\.([^\.]+)$|) { |
if ($newfilename =~ m|/[^/.]*\.(?:[^/.]+)$|) { |
#already has an extension strip it and add in expected one |
#already has an extension strip it and add in expected one |
$newfilename =~ s|.([^\.]+)$||; |
$newfilename =~ s|(/[^./])\.(?:[^.]+)$|$1|; |
} |
} |
$newfilename.=".$extension"; |
$newfilename.=".$extension"; |
} |
} |
} |
} |
my $result=&exists($user,$domain,$newfilename); |
my $result=&exists($user,$domain,$newfilename); |
if($result) { |
if($result) { |
$request->print('<font color="red">'.$result.'</font></form>'); |
$request->print('<span class="LC_error">'.$result.'</span></form>'); |
} else { |
} else { |
$request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>'); |
$request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>'); |
$request->print('</form>'); |
$request->print('</form>'); |
Line 1138 sub phasetwo {
|
Line 1137 sub phasetwo {
|
|
|
&Debug($r, "loncfile - Entering phase 2 for $fn"); |
&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 $dir; # Directory path |
my $main; # Filename. |
my $main; # Filename. |
Line 1151 sub phasetwo {
|
Line 1150 sub phasetwo {
|
$suffix=$1; #This is the actually filename extension if it exists |
$suffix=$1; #This is the actually filename extension if it exists |
$main=~s/\.\w+$//; #strip the extension |
$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,"loncfile::phase2 dir = $dir main = $main suffix = $suffix"); |
&Debug($r," newfilename = ".$env{'form.newfilename'}); |
&Debug($r," newfilename = ".$env{'form.newfilename'}); |
|
|
Line 1179 sub phasetwo {
|
Line 1180 sub phasetwo {
|
if(!&Rename2($r, $uname, $dir, $fn, $env{'form.newfilename'})) { |
if(!&Rename2($r, $uname, $dir, $fn, $env{'form.newfilename'})) { |
return; |
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') { |
} elsif ($env{'form.action'} eq 'delete') { |
if(!&Delete2($r, $uname, $env{'form.newfilename'})) { |
if(!&Delete2($r, $uname, $env{'form.newfilename'})) { |
Line 1210 sub phasetwo {
|
Line 1215 sub phasetwo {
|
if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) { |
if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) { |
$r->print('<h3><a href="javascript:self.close()">'.&mt('Done').'</a></h3>'); |
$r->print('<h3><a href="javascript:self.close()">'.&mt('Done').'</a></h3>'); |
} else { |
} else { |
$r->print('<h3><a href="'.&url($dest).'">'.&mt('Done').'</a></h3>'); |
if ($env{'form.action'} eq 'rename') { |
|
$r->print('<h3><a href="'.&url($dest).'">'.&mt('Return to Directory').'</a></h3>'); |
|
$r->print('<h3><a href="'.&url($dest_newname).'">'.$disp_newname.'</a></h3>'); |
|
} else { |
|
$r->print('<h3><a href="'.&url($dest).'">'.&mt('Done').'</a></h3>'); |
|
} |
} |
} |
} |
} |
|
|