--- loncom/publisher/loncfile.pm 2001/06/23 20:09:06 1.3 +++ loncom/publisher/loncfile.pm 2002/01/21 17:13:49 1.8 @@ -1,6 +1,31 @@ # The LearningOnline Network with CAPA # Handler to rename files, etc, in construction space # +# $Id: loncfile.pm,v 1.8 2002/01/21 17:13:49 albertel Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# +# # (Handler to retrieve an old version of a file # # (Publication Handler @@ -13,7 +38,7 @@ # 03/23 Guy Albertelli # 03/24,03/29 Gerd Kortemeyer) # -# 03/31,04/03,05/02,05/09,06/23 Gerd Kortemeyer) +# 03/31,04/03,05/02,05/09,06/23,06/24 Gerd Kortemeyer) # # 06/23 Gerd Kortemeyer @@ -25,10 +50,38 @@ use File::Copy; use Apache::Constants qw(:common :http :methods); use Apache::loncacc; +sub exists { + my ($uname,$udom,$dir,$newfile)=@_; + my $published='/home/httpd/html/res/'.$udom.'/'.$uname.'/'.$dir.'/'. + $ENV{'form.newfilename'}; + my $construct='/home/'.$uname.'/public_html/'.$dir.'/'. + $ENV{'form.newfilename'}; + my $result; + if (-e $published) { + $result.='

Warning: target file exists, and has been published!

'; + } elsif ( -e $construct ) { + $result.='

Warning: target file exists!

'; + } + return $result; +} + +sub checksuffix { + my ($old,$new) = @_; + my $result; + my $oldsuffix; + my $newsuffix; + if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; } + if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; } + if ($oldsuffix ne $newsuffix) { + $result.='

Warning: change of MIME type!

'; + } + return $result; +} + sub phaseone { my ($r,$fn,$uname,$udom)=@_; - $fn=~/(.*)\/([^\/]+)\.(\w+)$/; + $fn=~m:(.*)/([^/]+)\.(\w+)$:; my $dir=$1; my $main=$2; my $suffix=$3; @@ -39,76 +92,123 @@ sub phaseone { ''. ''. ''); + if ($ENV{'form.action'} eq 'rename') { if (-e $conspace) { if ($ENV{'form.newfilename'}) { - $ENV{'form.newfilename'}=~/(.*)\/([^\/]+)\.(\w+)$/; - if ($3 ne $suffix) { - $r->print( - '

Warning: change of MIME type!'); - } - if (-e - '/home/httpd/'.$uname.'/'.$dir.'/'.$ENV{'form.newfilename'}) { - $r->print( - '

Warning: target file exists!'); - } - $r->print('

Rename '.$fn.' to '. - $dir.'/'.$ENV{'form.newfilename'}.'?'); + $r->print(&checksuffix($fn,$ENV{'form.newfilename'})); + $r->print(&exists($uname,$udom,$dir,$ENV{'form.newfilename'})); + $r->print('

Rename '.$fn.' to '. + $dir.'/'.$ENV{'form.newfilename'}.'?

'); } else { - $r->print('

No new filename specified.'); + $r->print('

No new filename specified.

'); return; } } else { - $r->print('

No such file.'); + $r->print('

No such file.

'); return; } } elsif ($ENV{'form.action'} eq 'delete') { if (-e $conspace) { - $r->print('

Delete '.$fn.'?'); + $r->print('

Delete '.$fn.'?

'); } else { - $r->print('

No such file.'); + $r->print('

No such file.

'); return; } } elsif ($ENV{'form.action'} eq 'copy') { if (-e $conspace) { if ($ENV{'form.newfilename'}) { - $ENV{'form.newfilename'}=~/(.*)\/([^\/]+)\.(\w+)$/; - if ($3 ne $suffix) { - $r->print( - '

Warning: change of MIME type!'); - } - if (-e - '/home/httpd/'.$uname.'/'.$dir.'/'.$ENV{'form.newfilename'}) { - $r->print( - '

Warning: target file exists!'); - } - $r->print('

Copy '.$fn.' to '. - $dir.'/'.$ENV{'form.newfilename'}.'?'); + $r->print(&checksuffix($fn,$ENV{'form.newfilename'})); + $r->print(&exists($uname,$udom,$dir,$ENV{'form.newfilename'})); + $r->print('

Copy '.$fn.' to '. + $dir.'/'.$ENV{'form.newfilename'}.'?

'); } else { - $r->print('

No new filename specified.'); + $r->print('

No new filename specified.

'); return; } } else { - $r->print('

No such file.'); + $r->print('

No such file.

'); return; } } elsif ($ENV{'form.action'} eq 'newdir') { - if (-e $conspace) { - $r->print('

Directory exists.'); + my $newdir='/home/'.$uname.'/public_html/'. + $fn.$ENV{'form.newfilename'}; + if (-e $newdir) { + $r->print('

Directory exists.

'); return; } + $r->print('

Make new directory '. + $fn.$ENV{'form.newfilename'}.'?

'); } - $r->print('

'); + $r->print('

'); + $r->print('

'); + } sub phasetwo { my ($r,$fn,$uname,$udom)=@_; + + $fn=~/(.*)\/([^\/]+)\.(\w+)$/; + my $dir=$1; + my $main=$2; + my $suffix=$3; + + my $conspace='/home/'.$uname.'/public_html'.$fn; + if ($ENV{'form.action'} eq 'rename') { + if (-e $conspace) { + if ($ENV{'form.newfilename'}) { + unless (rename('/home/'.$uname.'/public_html'.$fn, + '/home/'.$uname.'/public_html'.$dir.'/'.$ENV{'form.newfilename'})) { + $r->print('Error: '.$!.''); + } + } + } else { + $r->print('

No such file.'); + return; + } } elsif ($ENV{'form.action'} eq 'delete') { + if (-e $conspace) { + unless (unlink('/home/'.$uname.'/public_html'.$fn)) { + $r->print('Error: '.$!.''); + } + } else { + $r->print('

No such file.'); + return; + } } elsif ($ENV{'form.action'} eq 'copy') { + if (-e $conspace) { + if ($ENV{'form.newfilename'}) { + unless (copy('/home/'.$uname.'/public_html'.$fn, + '/home/'.$uname.'/public_html'.$dir.'/'.$ENV{'form.newfilename'})) { + $r->print('Error: '.$!.''); + } + } else { + $r->print('

No new filename specified.'); + return; + } + } else { + $r->print('

No such file.'); + return; + } } elsif ($ENV{'form.action'} eq 'newdir') { - } + my $newdir='/home/'.$uname.'/public_html/'. + $fn.$ENV{'form.newfilename'}; + unless (mkdir($newdir,0770)) { + $r->print('Error: '.$!.''); + } + $r->print('

Done

'); + return; + } + $r->print('

Done

'); } sub handler { @@ -140,7 +240,7 @@ sub handler { &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); unless (($uname) && ($udom)) { $r->log_reason($uname.' at '.$udom. - ' trying to publish file '.$ENV{'form.filename'}. + ' trying to manipulate file '.$ENV{'form.filename'}. ' ('.$fn.') - not authorized', $r->filename); return HTTP_NOT_ACCEPTABLE; @@ -177,7 +277,7 @@ sub handler { return OK; } if ($ENV{'form.phase'} eq 'two') { -# &phasetwo($r,$fn,$uname,$udom); + &phasetwo($r,$fn,$uname,$udom); } else { &phaseone($r,$fn,$uname,$udom); }