[LON-CAPA-cvs] cvs: loncom /publisher loncfile.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Wed, 26 May 2004 22:25:39 -0000
This is a MIME encoded message
--albertel1085610339
Content-Type: text/plain
albertel Wed May 26 18:25:39 2004 EDT
Modified files:
/loncom/publisher loncfile.pm
Log:
- style police woke up on the wrong side of the vbed and noticed this mess
--albertel1085610339
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20040526182539.txt"
Index: loncom/publisher/loncfile.pm
diff -u loncom/publisher/loncfile.pm:1.54 loncom/publisher/loncfile.pm:1.55
--- loncom/publisher/loncfile.pm:1.54 Wed May 26 18:15:19 2004
+++ loncom/publisher/loncfile.pm Wed May 26 18:25:38 2004
@@ -9,7 +9,7 @@
# and displays a page showing the results of the action.
#
#
-# $Id: loncfile.pm,v 1.54 2004/05/26 22:15:19 albertel Exp $
+# $Id: loncfile.pm,v 1.55 2004/05/26 22:25:38 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -102,17 +102,17 @@
sub Debug {
- # Marshall the parameters.
+ # Marshall the parameters.
- my $r = shift;
- my $log = $r->log;
- my $message = shift;
+ my $r = shift;
+ my $log = $r->log;
+ my $message = shift;
- # Put out the indicated message butonly if DEBUG is true.
+ # Put out the indicated message butonly if DEBUG is true.
- if ($DEBUG) {
- $r->log_reason($message);
- }
+ if ($DEBUG) {
+ $r->log_reason($message);
+ }
}
=pod
@@ -151,14 +151,14 @@
=cut
sub URLToPath {
- my $Url = shift;
- &Debug($r, "UrlToPath got: $Url");
- $Url=~ s/\/+/\//g;
- $Url=~ s/^http\:\/\/[^\/]+//;
- $Url=~ s/^\///;
- $Url=~ s/(\~|priv\/)(\w+)\//\/home\/$2\/public_html\//;
- &Debug($r, "Returning $Url \n");
- return $Url;
+ my $Url = shift;
+ &Debug($r, "UrlToPath got: $Url");
+ $Url=~ s/\/+/\//g;
+ $Url=~ s/^http\:\/\/[^\/]+//;
+ $Url=~ s/^\///;
+ $Url=~ s/(\~|priv\/)(\w+)\//\/home\/$2\/public_html\//;
+ &Debug($r, "Returning $Url \n");
+ return $Url;
}
sub url {
@@ -228,21 +228,20 @@
=cut
sub exists {
- my ($user, $domain, $construct) = @_;
- my $published=$construct;
- $published=~
-s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//;
- my $result='';
- if ( -d $construct ) {
- return &mt('Error: destination for operation is an existing directory.');
- }
- if ( -e $published) {
- $result.='<p><font color="red">'.&mt('Warning: target file exists, and has been published!').'</font></p>';
- } elsif ( -e $construct) {
- $result.='<p><font color="red">'.&mt('Warning: target file exists!').'</font></p>';
- }
- return $result;
-
+ my ($user, $domain, $construct) = @_;
+ my $published=$construct;
+ $published=~
+ s/^\/home\/$user\/public\_html\//\/home\/httpd\/html\/res\/$domain\/$user\//;
+ my $result='';
+ if ( -d $construct ) {
+ return &mt('Error: destination for operation is an existing directory.');
+ }
+ if ( -e $published) {
+ $result.='<p><font color="red">'.&mt('Warning: target file exists, and has been published!').'</font></p>';
+ } elsif ( -e $construct) {
+ $result.='<p><font color="red">'.&mt('Warning: target file exists!').'</font></p>';
+ }
+ return $result;
}
=pod
@@ -334,10 +333,10 @@
=cut
sub CloseForm1 {
- my ($request, $fn) = @_;
- $request->print('<p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
- $request->print('<form action="'.&url($fn).
- '" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
+ my ($request, $fn) = @_;
+ $request->print('<p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
+ $request->print('<form action="'.&url($fn).
+ '" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
}
@@ -366,8 +365,8 @@
=cut
sub CloseForm2 {
- my ($request, $user, $fn) = @_;
- $request->print('<h3><a href="'.&url($fn).'/">'.&mt('Done').'</a></h3>');
+ my ($request, $user, $fn) = @_;
+ $request->print('<h3><a href="'.&url($fn).'/">'.&mt('Done').'</a></h3>');
}
=pod
@@ -429,9 +428,9 @@
$newfilename=~/\.(\w+)$/;
if (&Apache::loncommon::fileembstyle($1) eq 'ssi') {
$request->print('<br /><font color="red">'.
- &mt('Cannot change MIME type of a directory').
+ &mt('Cannot change MIME type of a directory').
'</font>'.
- '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
+ '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
return;
}
$newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/;
@@ -472,6 +471,7 @@
}
}
+
=pod
=item Delete1
@@ -497,21 +497,21 @@
=cut
sub Delete1 {
- my ($request, $user, $domain, $fn) = @_;
+ my ($request, $user, $domain, $fn) = @_;
- if( -e $fn) {
- $request->print('<input type="hidden" name="newfilename" value="'.
- $fn.'"/>');
- unless (&obsolete_unpub($user,$domain,$fn)) {
- $request->print('<h3>'.&mt('Cannot delete non-obsolete published file').'</h3>'.
- '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
- return;
+ if( -e $fn) {
+ $request->print('<input type="hidden" name="newfilename" value="'.
+ $fn.'"/>');
+ unless (&obsolete_unpub($user,$domain,$fn)) {
+ $request->print('<h3>'.&mt('Cannot delete non-obsolete published file').'</h3>'.
+ '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
+ return;
+ }
+ $request->print('<p>'.&mt('Delete').' '.&display($fn).'?</p>');
+ &CloseForm1($request, $fn);
+ } else {
+ $request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
}
- $request->print('<p>'.&mt('Delete').' '.&display($fn).'?</p>');
- &CloseForm1($request, $fn);
- } else {
- $request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
- }
}
=pod
@@ -613,37 +613,37 @@
=cut
-sub NewDir1
-{
- my ($request, $username, $domain, $fn, $newfilename, $mode) = @_;
-
- my $result=&exists($username,$domain,$newfilename);
- if ($result) {
- $request->print('<font color="red">'.$result.'</font></form>');
- } else {
- if ($mode eq 'testbank') {
- $request->print('<input type="hidden" name="callingmode" value="testbank">');
- } elsif ($mode eq 'imsimport') {
- $request->print('<input type="hidden" name="callingmode" value="imsimport">');
- }
- $request->print('<input type="hidden" name="newfilename" value="'.
- $newfilename.'" /><p>'.&mt('Make new directory').' '.
- &display($newfilename).'?</p>');
- &CloseForm1($request, $fn);
- }
+sub NewDir1 {
+ my ($request, $username, $domain, $fn, $newfilename, $mode) = @_;
+
+ my $result=&exists($username,$domain,$newfilename);
+ if ($result) {
+ $request->print('<font color="red">'.$result.'</font></form>');
+ } else {
+ if ($mode eq 'testbank') {
+ $request->print('<input type="hidden" name="callingmode" value="testbank">');
+ } elsif ($mode eq 'imsimport') {
+ $request->print('<input type="hidden" name="callingmode" value="imsimport">');
+ }
+ $request->print('<input type="hidden" name="newfilename" value="'.
+ $newfilename.'" /><p>'.&mt('Make new directory').' '.
+ &display($newfilename).'?</p>');
+ &CloseForm1($request, $fn);
+ }
}
sub Decompress1 {
- my ($request, $user, $domain, $fn) = @_;
- if( -e $fn) {
+ my ($request, $user, $domain, $fn) = @_;
+ if( -e $fn) {
$request->print('<input type="hidden" name="newfilename" value="'.$fn.'"/>');
$request->print('<p>'.&mt('Decompress').' '.&display($fn).'?</p>');
&CloseForm1($request, $fn);
- } else {
- $request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
- }
+ } else {
+ $request->print('<p>'.&mt('No such file').': '.&display($fn).'</p></form>');
+ }
}
+
=pod
=item NewFile1
@@ -684,7 +684,6 @@
=cut
-
sub NewFile1 {
my ($request, $user, $domain, $fn, $newfilename) = @_;
@@ -748,49 +747,49 @@
=cut
sub phaseone {
- my ($r,$fn,$uname,$udom)=@_;
+ my ($r,$fn,$uname,$udom)=@_;
- my $newfilename=&cleanDest($r,$ENV{'form.newfilename'});
- $newfilename=&relativeDest($fn,$newfilename,$uname);
- $r->print('<form action="/adm/cfile" method="post">'.
- '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
- '<input type="hidden" name="phase" value="two" />'.
- '<input type="hidden" name="action" value="'.$ENV{'form.action'}.'" />');
+ my $newfilename=&cleanDest($r,$ENV{'form.newfilename'});
+ $newfilename=&relativeDest($fn,$newfilename,$uname);
+ $r->print('<form action="/adm/cfile" method="post">'.
+ '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
+ '<input type="hidden" name="phase" value="two" />'.
+ '<input type="hidden" name="action" value="'.$ENV{'form.action'}.'" />');
- if ($ENV{'form.action'} eq 'rename') {
- &Rename1($r, $uname, $udom, $fn, $newfilename, 'rename');
- } elsif ($ENV{'form.action'} eq 'move') {
- &Rename1($r, $uname, $udom, $fn, $newfilename, 'move');
- } elsif ($ENV{'form.action'} eq 'delete') {
- &Delete1($r, $uname, $udom, $fn);
- } elsif ($ENV{'form.action'} eq 'decompress') {
- &Decompress1($r, $uname, $udom, $fn);
- } elsif ($ENV{'form.action'} eq 'copy') {
- if($newfilename) {
- &Copy1($r, $uname, $udom, $fn, $newfilename);
- } else {
- $r->print('<p>'.&mt('No new filename specified.').'</p></form>');
- }
- } elsif ($ENV{'form.action'} eq 'newdir') {
- my $mode = '';
- if (exists($ENV{'form.callingmode'}) ) {
- $mode = $ENV{'form.callingmode'};
- }
- &NewDir1($r, $uname, $udom, $fn, $newfilename, $mode);
- } elsif ($ENV{'form.action'} eq 'newfile' ||
- $ENV{'form.action'} eq 'newhtmlfile' ||
- $ENV{'form.action'} eq 'newproblemfile' ||
- $ENV{'form.action'} eq 'newpagefile' ||
- $ENV{'form.action'} eq 'newsequencefile' ||
- $ENV{'form.action'} eq 'newrightsfile' ||
- $ENV{'form.action'} eq 'newstyfile' ||
- $ENV{'form.action'} eq 'Select Action') {
- if ($newfilename) {
- &NewFile1($r, $uname, $udom, $fn, $newfilename);
- } else {
- $r->print('<p>'.&mt('No new filename specified.').'</p></form>');
- }
- }
+ if ($ENV{'form.action'} eq 'rename') {
+ &Rename1($r, $uname, $udom, $fn, $newfilename, 'rename');
+ } elsif ($ENV{'form.action'} eq 'move') {
+ &Rename1($r, $uname, $udom, $fn, $newfilename, 'move');
+ } elsif ($ENV{'form.action'} eq 'delete') {
+ &Delete1($r, $uname, $udom, $fn);
+ } elsif ($ENV{'form.action'} eq 'decompress') {
+ &Decompress1($r, $uname, $udom, $fn);
+ } elsif ($ENV{'form.action'} eq 'copy') {
+ if($newfilename) {
+ &Copy1($r, $uname, $udom, $fn, $newfilename);
+ } else {
+ $r->print('<p>'.&mt('No new filename specified.').'</p></form>');
+ }
+ } elsif ($ENV{'form.action'} eq 'newdir') {
+ my $mode = '';
+ if (exists($ENV{'form.callingmode'}) ) {
+ $mode = $ENV{'form.callingmode'};
+ }
+ &NewDir1($r, $uname, $udom, $fn, $newfilename, $mode);
+ } elsif ($ENV{'form.action'} eq 'newfile' ||
+ $ENV{'form.action'} eq 'newhtmlfile' ||
+ $ENV{'form.action'} eq 'newproblemfile' ||
+ $ENV{'form.action'} eq 'newpagefile' ||
+ $ENV{'form.action'} eq 'newsequencefile' ||
+ $ENV{'form.action'} eq 'newrightsfile' ||
+ $ENV{'form.action'} eq 'newstyfile' ||
+ $ENV{'form.action'} eq 'Select Action') {
+ if ($newfilename) {
+ &NewFile1($r, $uname, $udom, $fn, $newfilename);
+ } else {
+ $r->print('<p>'.&mt('No new filename specified.').'</p></form>');
+ }
+ }
}
=pod
@@ -829,57 +828,58 @@
sub Rename2 {
- my ($request, $user, $directory, $oldfile, $newfile) = @_;
+ my ($request, $user, $directory, $oldfile, $newfile) = @_;
- &Debug($request, "Rename2 directory: ".$directory." old file: ".$oldfile.
- " new file ".$newfile."\n");
- &Debug($request, "Target is: ".$directory.'/'.
- $newfile);
- if (-e $oldfile) {
-
- my $oRN=$oldfile;
- my $nRN=$newfile;
- unless (rename($oldfile,$newfile)) {
- $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
- return 0;
- }
- ## If old name.(extension) exits, move under new name.
- ## If it doesn't exist and a new.(extension) exists
- ## delete it (only concern when renaming over files)
- my $tmp1=$oRN.'.meta';
- my $tmp2=$nRN.'.meta';
- if(-e $tmp1){
- unless(rename($tmp1,$tmp2)){ }
- } elsif(-e $tmp2){
- unlink $tmp2;
- }
- $tmp1=$oRN.'.save';
- $tmp2=$nRN.'.save';
- if(-e $tmp1){
- unless(rename($tmp1,$tmp2)){ }
- } elsif(-e $tmp2){
- unlink $tmp2;
- }
- $tmp1=$oRN.'.log';
- $tmp2=$nRN.'.log';
- if(-e $tmp1){
- unless(rename($tmp1,$tmp2)){ }
- } elsif(-e $tmp2){
- unlink $tmp2;
- }
- $tmp1=$oRN.'.bak';
- $tmp2=$nRN.'.bak';
- if(-e $tmp1){
- unless(rename($tmp1,$tmp2)){ }
- } elsif(-e $tmp2){
- unlink $tmp2;
- }
- } else {
- $request->print("<p> ".&mt('No such file').": ".&display($oldfile).'</p></form>');
- return 0;
- }
- return 1;
+ &Debug($request, "Rename2 directory: ".$directory." old file: ".$oldfile.
+ " new file ".$newfile."\n");
+ &Debug($request, "Target is: ".$directory.'/'.
+ $newfile);
+ if (-e $oldfile) {
+
+ my $oRN=$oldfile;
+ my $nRN=$newfile;
+ unless (rename($oldfile,$newfile)) {
+ $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
+ return 0;
+ }
+ ## If old name.(extension) exits, move under new name.
+ ## If it doesn't exist and a new.(extension) exists
+ ## delete it (only concern when renaming over files)
+ my $tmp1=$oRN.'.meta';
+ my $tmp2=$nRN.'.meta';
+ if(-e $tmp1){
+ unless(rename($tmp1,$tmp2)){ }
+ } elsif(-e $tmp2){
+ unlink $tmp2;
+ }
+ $tmp1=$oRN.'.save';
+ $tmp2=$nRN.'.save';
+ if(-e $tmp1){
+ unless(rename($tmp1,$tmp2)){ }
+ } elsif(-e $tmp2){
+ unlink $tmp2;
+ }
+ $tmp1=$oRN.'.log';
+ $tmp2=$nRN.'.log';
+ if(-e $tmp1){
+ unless(rename($tmp1,$tmp2)){ }
+ } elsif(-e $tmp2){
+ unlink $tmp2;
+ }
+ $tmp1=$oRN.'.bak';
+ $tmp2=$nRN.'.bak';
+ if(-e $tmp1){
+ unless(rename($tmp1,$tmp2)){ }
+ } elsif(-e $tmp2){
+ unlink $tmp2;
+ }
+ } else {
+ $request->print("<p> ".&mt('No such file').": ".&display($oldfile).'</p></form>');
+ return 0;
+ }
+ return 1;
}
+
=pod
=item Delete2($request, $user, $filename)
@@ -910,36 +910,36 @@
=cut
sub Delete2 {
- my ($request, $user, $filename) = @_;
- if(opendir DIR, $filename) {
- my @files=readdir(DIR);
- shift @files; shift @files; # takes off . and ..
- if(@files) {
- $request->print('<font color="red"> '.&mt('Error: Directory Non Empty').'</font>');
- return 0;
- } else {
- if(-e $filename) {
- unless(rmdir($filename)) {
- $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
- return 0;
- }
- } else {
- $request->print('<p> '.&mt('No such file').'. </p></form>');
- return 0;
- }
- }
- } else {
- if(-e $filename) {
- unless(unlink($filename)) {
- $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
- return 0;
- }
+ my ($request, $user, $filename) = @_;
+ if(opendir DIR, $filename) {
+ my @files=readdir(DIR);
+ shift @files; shift @files; # takes off . and ..
+ if(@files) {
+ $request->print('<font color="red"> '.&mt('Error: Directory Non Empty').'</font>');
+ return 0;
+ } else {
+ if(-e $filename) {
+ unless(rmdir($filename)) {
+ $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
+ return 0;
+ }
+ } else {
+ $request->print('<p> '.&mt('No such file').'. </p></form>');
+ return 0;
+ }
+ }
} else {
- $request->print('<p> '.&mt('No such file').'. </p></form>');
- return 0;
- }
+ if(-e $filename) {
+ unless(unlink($filename)) {
+ $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
+ return 0;
+ }
+ } else {
+ $request->print('<p> '.&mt('No such file').'. </p></form>');
+ return 0;
}
- return 1;
+ }
+ return 1;
}
=pod
@@ -990,6 +990,7 @@
}
return 1;
}
+
=pod
=item NewDir2($request, $user, $newdirectory)
@@ -1013,28 +1014,30 @@
=cut
sub NewDir2 {
- my ($request, $user, $newdirectory) = @_;
+ my ($request, $user, $newdirectory) = @_;
- unless(mkdir($newdirectory, 02770)) {
- $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
- return 0;
- }
- unless(chmod(02770, ($newdirectory))) {
- $request->print('<font color="red"> '.&mt('Error').': '.$!.'</font>');
- return 0;
- }
- return 1;
+ unless(mkdir($newdirectory, 02770)) {
+ $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
+ return 0;
+ }
+ unless(chmod(02770, ($newdirectory))) {
+ $request->print('<font color="red"> '.&mt('Error').': '.$!.'</font>');
+ return 0;
+ }
+ return 1;
}
+
sub decompress2 {
- my ($r, $user, $dir, $file) = @_;
- &Apache::lonnet::appenv('cgi.file' => $file);
- &Apache::lonnet::appenv('cgi.dir' => $dir);
- my $result=&Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
- $r->print($result);
- &Apache::lonnet::delenv('cgi.file');
- &Apache::lonnet::delenv('cgi.dir');
- return 1;
+ my ($r, $user, $dir, $file) = @_;
+ &Apache::lonnet::appenv('cgi.file' => $file);
+ &Apache::lonnet::appenv('cgi.dir' => $dir);
+ my $result=&Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
+ $r->print($result);
+ &Apache::lonnet::delenv('cgi.file');
+ &Apache::lonnet::delenv('cgi.dir');
+ return 1;
}
+
=pod
=item phasetwo($r, $fn, $uname, $udom)
@@ -1087,34 +1090,28 @@
}
my $dest; # On success this is where we'll go.
- &Debug($r,
- "loncfile::phase2 dir = $dir main = $main suffix = $suffix");
- &Debug($r,
- " newfilename = ".$ENV{'form.newfilename'});
+ &Debug($r,"loncfile::phase2 dir = $dir main = $main suffix = $suffix");
+ &Debug($r," newfilename = ".$ENV{'form.newfilename'});
my $conspace=$fn;
- &Debug($r,
- "loncfile::phase2 Full construction space name: $conspace");
+ &Debug($r,"loncfile::phase2 Full construction space name: $conspace");
- &Debug($r,
- "loncfie::phase2 action is $ENV{'form.action'}");
+ &Debug($r,"loncfie::phase2 action is $ENV{'form.action'}");
# Select the appropriate processing sub.
if ($ENV{'form.action'} eq 'decompress') {
$main .= '.';
$main .= $suffix;
- if(!&decompress2($r, $uname, $dir, $main)) {
- return ;
- }
- $dest = $dir."/.";
-
-
+ if(!&decompress2($r, $uname, $dir, $main)) {
+ return ;
+ }
+ $dest = $dir."/.";
} elsif ($ENV{'form.action'} eq 'rename') { # Rename.
if($ENV{'form.newfilename'}) {
if (!defined($dir)) {
$fn=~m:^(.*)/:;
- $dir=$1;
+ $dir=$1;
}
if(!&Rename2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {
return;
@@ -1133,10 +1130,9 @@
if($ENV{'form.newfilename'}) {
if(!&Copy2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) {
return ;
- }
+ }
$dest = $ENV{'form.newfilename'};
-
- } else {
+ } else {
$r->print('<p>'.&mt('No New filename specified').'</p></form>');
return;
}
@@ -1146,84 +1142,81 @@
if(!&NewDir2($r, $uname, $newdir)) {
return;
}
- $dest = $newdir."/"
+ $dest = $newdir."/";
}
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 {
- $r->print('<h3><a href="'.&url($dest).'">'.&mt('Done').'</a></h3>');
+ $r->print('<h3><a href="'.&url($dest).'">'.&mt('Done').'</a></h3>');
}
}
sub handler {
- $r=shift;
+ $r=shift;
- &Debug($r, "loncfile.pm - handler entered");
- &Debug($r, " filename: ".$ENV{'form.filename'});
- &Debug($r, " newfilename: ".$ENV{'form.newfilename'});
+ &Debug($r, "loncfile.pm - handler entered");
+ &Debug($r, " filename: ".$ENV{'form.filename'});
+ &Debug($r, " newfilename: ".$ENV{'form.newfilename'});
#
# Determine the root filename
# This could come in as "filename", which actually is a URL, or
# as "qualifiedfilename", which is indeed a real filename in filesystem
#
- my $fn;
+ my $fn;
- if ($ENV{'form.filename'}) {
-
+ if ($ENV{'form.filename'}) {
&Debug($r, "test: $ENV{'form.filename'}");
- $fn=&Apache::lonnet::unescape($ENV{'form.filename'});
- $fn=&URLToPath($fn);
- }
- #Just hijack the script only the first time around to inject the correct information for further processing
- elsif($ENV{'QUERY_STRING'} && $ENV{'form.phase'} ne 'two') {
- &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress']);
- $fn=&Apache::lonnet::unescape($ENV{'form.decompress'});
+ $fn=&Apache::lonnet::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
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress']);
+ $fn=&Apache::lonnet::unescape($ENV{'form.decompress'});
$fn=&URLToPath($fn);
$ENV{'form.action'}="decompress";
- }
+ } elsif ($ENV{'form.qualifiedfilename'}) {
+ $fn=$ENV{'form.qualifiedfilename'};
+ } else {
+ &Debug($r, "loncfile::handler - no form.filename");
+ $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
+ ' unspecified filename for cfile', $r->filename);
+ return HTTP_NOT_FOUND;
+ }
- elsif ($ENV{'form.qualifiedfilename'}) {
- $fn=$ENV{'form.qualifiedfilename'};
- } else {
- &Debug($r, "loncfile::handler - no form.filename");
- $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
- ' unspecified filename for cfile', $r->filename);
- return HTTP_NOT_FOUND;
- }
-
- unless ($fn) {
- &Debug($r, "loncfile::handler - doctored url is empty");
- $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
- ' trying to cfile non-existing file', $r->filename);
- return HTTP_NOT_FOUND;
- }
+ unless ($fn) {
+ &Debug($r, "loncfile::handler - doctored url is empty");
+ $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
+ ' trying to cfile non-existing file', $r->filename);
+ return HTTP_NOT_FOUND;
+ }
# ----------------------------------------------------------- Start page output
- my $uname;
- my $udom;
+ my $uname;
+ my $udom;
+
+ ($uname,$udom)=
+ &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
+ &Debug($r,
+ "loncfile::handler constructaccess uname = $uname domain = $udom");
+ unless (($uname) && ($udom)) {
+ $r->log_reason($uname.' at '.$udom.
+ ' trying to manipulate file '.$ENV{'form.filename'}.
+ ' ('.$fn.') - not authorized',
+ $r->filename);
+ return HTTP_NOT_ACCEPTABLE;
+ }
+
- ($uname,$udom)=
- &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
- &Debug($r,
- "loncfile::handler constructaccess uname = $uname domain = $udom");
- unless (($uname) && ($udom)) {
- $r->log_reason($uname.' at '.$udom.
- ' trying to manipulate file '.$ENV{'form.filename'}.
- ' ('.$fn.') - not authorized',
- $r->filename);
- return HTTP_NOT_ACCEPTABLE;
- }
-
-
- &Apache::loncommon::content_type($r,'text/html');
- $r->send_http_header;
-
- 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('<html><head><title>LON-CAPA Construction Space</title><script language="Javascript">');
- $r->print(qq|
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+
+ 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('<html><head><title>LON-CAPA Construction Space</title><script language="Javascript">');
+ $r->print(qq|
function writeDone() {
var winName = window.opener
window.focus();
@@ -1232,59 +1225,58 @@
}
</script>
</head>|);
- my $loaditem = 'onLoad="writeDone()"';
- $r->print(&Apache::loncommon::bodytag('Construction Space File Operation','',$loaditem));
- } else {
- $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
- $r->print(&Apache::loncommon::bodytag('Construction Space File Operation'));
- }
+ my $loaditem = 'onLoad="writeDone()"';
+ $r->print(&Apache::loncommon::bodytag('Construction Space File Operation','',$loaditem));
+ } else {
+ $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
+ $r->print(&Apache::loncommon::bodytag('Construction Space File Operation'));
+ }
- $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');
+ $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');
- if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
- $r->print('<h3><font color="red">'.&mt('Co-Author').': '.$uname.' at '.$udom.
- '</font></h3>');
- }
-
-
- &Debug($r, "loncfile::handler Form action is $ENV{'form.action'} ");
- if ($ENV{'form.action'} eq 'delete') {
-
- $r->print('<h3>'.&mt('Delete').'</h3>');
- } elsif ($ENV{'form.action'} eq 'rename') {
- $r->print('<h3>'.&mt('Rename').'</h3>');
- } elsif ($ENV{'form.action'} eq 'move') {
- $r->print('<h3>'.&mt('Move').'</h3>');
- } elsif ($ENV{'form.action'} eq 'newdir') {
- $r->print('<h3>'.&mt('New Directory').'</h3>');
- } elsif ($ENV{'form.action'} eq 'decompress') {
- $r->print('<h3>'.&mt('Decompress').'</h3>');
- } elsif ($ENV{'form.action'} eq 'copy') {
- $r->print('<h3>'.&mt('Copy').'</h3>');
- } elsif ($ENV{'form.action'} eq 'newfile' ||
- $ENV{'form.action'} eq 'newhtmlfile' ||
- $ENV{'form.action'} eq 'newproblemfile' ||
- $ENV{'form.action'} eq 'newpagefile' ||
- $ENV{'form.action'} eq 'newsequencefile' ||
- $ENV{'form.action'} eq 'newrightsfile' ||
- $ENV{'form.action'} eq 'newstyfile' ||
- $ENV{'form.action'} eq 'Select Action' ) {
- $r->print('<h3>'.&mt('New Resource').'</h3>');
- } else {
- $r->print('<p>'.&mt('Unknown Action').' '.$ENV{'form.action'}.' </p></body></html>');
- return OK;
- }
- if ($ENV{'form.phase'} eq 'two') {
- &Debug($r, "loncfile::handler entering phase2");
- &phasetwo($r,$fn,$uname,$udom);
- } else {
- &Debug($r, "loncfile::handler entering phase1");
- &phaseone($r,$fn,$uname,$udom);
- }
+ if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
+ $r->print('<h3><font color="red">'.&mt('Co-Author').': '.$uname.' at '.$udom.
+ '</font></h3>');
+ }
+
+
+ &Debug($r, "loncfile::handler Form action is $ENV{'form.action'} ");
+ if ($ENV{'form.action'} eq 'delete') {
+ $r->print('<h3>'.&mt('Delete').'</h3>');
+ } elsif ($ENV{'form.action'} eq 'rename') {
+ $r->print('<h3>'.&mt('Rename').'</h3>');
+ } elsif ($ENV{'form.action'} eq 'move') {
+ $r->print('<h3>'.&mt('Move').'</h3>');
+ } elsif ($ENV{'form.action'} eq 'newdir') {
+ $r->print('<h3>'.&mt('New Directory').'</h3>');
+ } elsif ($ENV{'form.action'} eq 'decompress') {
+ $r->print('<h3>'.&mt('Decompress').'</h3>');
+ } elsif ($ENV{'form.action'} eq 'copy') {
+ $r->print('<h3>'.&mt('Copy').'</h3>');
+ } elsif ($ENV{'form.action'} eq 'newfile' ||
+ $ENV{'form.action'} eq 'newhtmlfile' ||
+ $ENV{'form.action'} eq 'newproblemfile' ||
+ $ENV{'form.action'} eq 'newpagefile' ||
+ $ENV{'form.action'} eq 'newsequencefile' ||
+ $ENV{'form.action'} eq 'newrightsfile' ||
+ $ENV{'form.action'} eq 'newstyfile' ||
+ $ENV{'form.action'} eq 'Select Action' ) {
+ $r->print('<h3>'.&mt('New Resource').'</h3>');
+ } else {
+ $r->print('<p>'.&mt('Unknown Action').' '.$ENV{'form.action'}.' </p></body></html>');
+ return OK;
+ }
+ if ($ENV{'form.phase'} eq 'two') {
+ &Debug($r, "loncfile::handler entering phase2");
+ &phasetwo($r,$fn,$uname,$udom);
+ } else {
+ &Debug($r, "loncfile::handler entering phase1");
+ &phaseone($r,$fn,$uname,$udom);
+ }
- $r->print('</body></html>');
- return OK;
+ $r->print('</body></html>');
+ return OK;
}
1;
--albertel1085610339--