|
version 1.120, 2013/07/03 05:03:19
|
version 1.128, 2024/05/13 13:55:50
|
|
Line 40
|
Line 40
|
| Apache::loncfile - Authoring space file management. |
Apache::loncfile - Authoring space file management. |
| |
|
| =head1 SYNOPSIS |
=head1 SYNOPSIS |
| |
|
| Content handler for buttons on the top frame of the construction space |
Content handler for buttons on the top frame of the construction space |
| directory. |
directory. |
| |
|
| =head1 INTRODUCTION |
=head1 INTRODUCTION |
| |
|
| loncfile is invoked when buttons in the top frame of the construction |
loncfile is invoked when buttons in the top frame of the construction |
| space directory listing are clicked. All operations proceed in two phases. |
space directory listing are clicked. All operations proceed in two phases. |
| The first phase describes to the user exactly what will be done. If the user |
The first phase describes to the user exactly what will be done. If the user |
| confirms the operation, the second phase commits the operation and indicates |
confirms the operation, the second phase commits the operation and indicates |
|
Line 70 use HTML::Entities();
|
Line 70 use HTML::Entities();
|
| use Apache::Constants qw(:common :http :methods); |
use Apache::Constants qw(:common :http :methods); |
| use Apache::lonnet; |
use Apache::lonnet; |
| use Apache::loncommon(); |
use Apache::loncommon(); |
| |
use Apache::lonhtmlcommon; |
| use Apache::lonlocal; |
use Apache::lonlocal; |
| use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
| |
|
| |
|
| 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 88 my $r; # Needs to be global for some
|
Line 88 my $r; # Needs to be global for some
|
| Parameters: |
Parameters: |
| |
|
| =over 4 |
=over 4 |
| |
|
| =item $request - The current request operation. |
=item $request - The current request operation. |
| |
|
| =item $message - The message to put in the log file. |
=item $message - The message to put in the log file. |
| |
|
| =back |
=back |
| |
|
| Returns: |
Returns: |
| nothing. |
nothing. |
| |
|
|
Line 109 sub Debug {
|
Line 109 sub Debug {
|
| } |
} |
| |
|
| sub done { |
sub done { |
| my ($url) = @_; |
my ($destfn) = @_; |
| return |
return |
| '<p>' |
'<p>' |
| .&Apache::lonhtmlcommon::confirm_success(&mt("Done")) |
.&Apache::lonhtmlcommon::confirm_success(&mt("Done")) |
| .'<br /><a href="'.$url.'">'.&mt("Continue").'</a>' |
.'<br /><a href="'.&url($destfn).'">'.&mt("Continue").'</a>' |
| .'<script type="text/javascript">' |
.'<script type="text/javascript">' |
| .'location.href="'.$url.'";' |
.'location.href="'.&url($destfn,'js').'";' |
| .'</script>' |
.'</script>' |
| .'</p>'; |
.'</p>'; |
| } |
} |
|
Line 125 sub done {
|
Line 125 sub done {
|
| =item URLToPath($url) |
=item URLToPath($url) |
| |
|
| Convert a URL to a file system path. |
Convert a URL to a file system path. |
| |
|
| In order to manipulate the construction space objects, it is necessary |
In order to manipulate the construction space objects, it is necessary |
| to access url identified objects a filespace objects. This function |
to access url identified objects a filespace objects. This function |
| translates a construction space URL to a file system path. |
translates a construction space URL to a file system path. |
|
Line 134 sub done {
|
Line 134 sub done {
|
| =over 4 |
=over 4 |
| |
|
| =item Url - string [in] The url to convert. |
=item Url - string [in] The url to convert. |
| |
|
| =back |
=back |
| |
|
| Returns: |
Returns: |
| |
|
| =over 4 |
=over 4 |
| |
|
| =item The corresponding file system path. |
=item The corresponding file system path. |
| |
|
| =back |
=back |
| |
|
|
Line 167 sub URLToPath {
|
Line 167 sub URLToPath {
|
| } |
} |
| |
|
| sub url { |
sub url { |
| my $fn=shift; |
my ($fn,$context) = @_; |
| my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
| $fn=~ s/^\Q$londocroot\E//; |
$fn=~ s/^\Q$londocroot\E//; |
| $fn=~s{/\./}{/}g; |
$fn=~s{/\./}{/}g; |
| $fn=&HTML::Entities::encode($fn,'<>"&'); |
if ($context eq 'js') { |
| |
&js_escape(\$fn); |
| |
} else { |
| |
$fn=&HTML::Entities::encode($fn,'\'<>"&'); |
| |
} |
| return $fn; |
return $fn; |
| } |
} |
| |
|
|
Line 206 sub obsolete_unpub {
|
Line 210 sub obsolete_unpub {
|
| # see if directory is empty |
# see if directory is empty |
| # ignores any .meta, .save, .bak, 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. |
# published file, which has since been marked obsolete and deleted. |
| # ignores a .DS_Store file put there when viewing directory via webDAV on MacOS. |
# ignores a .DS_Store file put there when viewing directory via webDAV on MacOS. |
| sub empty_directory { |
sub empty_directory { |
| my ($dirname,$phase) = @_; |
my ($dirname,$phase) = @_; |
| if (opendir DIR, $dirname) { |
if (opendir DIR, $dirname) { |
| my @files = grep(!/^\.\.?$/, readdir(DIR)); # ignore . and .. |
my @files = grep(!/^\.\.?$/, readdir(DIR)); # ignore . and .. |
| if (@files) { |
if (@files) { |
| my @orphans = grep(/\.(meta|save|log|bak|DS_Store)$/,@files); |
my @orphans = grep(/\.(meta|save|log|bak|DS_Store)$/,@files); |
| if (scalar(@files) - scalar(@orphans) > 0) { |
if (scalar(@files) - scalar(@orphans) > 0) { |
| return 0; |
return 0; |
| } else { |
} else { |
| if (($phase eq 'Delete2') && (@orphans > 0)) { |
if (($phase eq 'Delete2') && (@orphans > 0)) { |
|
Line 265 Returns:
|
Line 269 Returns:
|
| =item string - Either where the resource exists as an html string that can |
=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 |
be embedded in a dialog or an empty string if the resource |
| does not exist. |
does not exist. |
| |
|
| =back |
=back |
| |
|
| =cut |
=cut |
|
Line 279 sub exists {
|
Line 283 sub exists {
|
| $published=~s{^\Q$londocroot/priv/\E}{$londocroot/res/}; |
$published=~s{^\Q$londocroot/priv/\E}{$londocroot/res/}; |
| my ($type,$result); |
my ($type,$result); |
| if ( -d $construct ) { |
if ( -d $construct ) { |
| return ('error','<p><span class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</span></p>'); |
return ('error','<p class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</p>'); |
| |
|
| } |
} |
| |
|
| if ( -e $published) { |
if ( -e $published) { |
| if ( -e $construct ) { |
if ( -e $construct ) { |
| $type = 'warning'; |
$type = 'warning'; |
| $result.='<p><span class="LC_warning">'.&mt('Warning: target file exists, and has been published!').'</span></p>'; |
$result.='<p class="LC_warning">'.&mt('Warning: target file exists, and has been published!').'</p>'; |
| } else { |
} else { |
| my $published_type = (-d $published) ? 'directory' : 'file'; |
my $published_type = (-d $published) ? 'directory' : 'file'; |
| |
|
| if ($published_type eq $creating) { |
if ($published_type eq $creating) { |
| $type = 'warning'; |
$type = 'warning'; |
| $result.='<p><span class="LC_warning">'.&mt("Warning: a published $published_type of this name exists.").'</span></p>'; |
$result.='<p class="LC_warning">'.&mt("Warning: a published $published_type of this name exists.").'</p>'; |
| } else { |
} else { |
| $type = 'error'; |
$type = 'error'; |
| $result.='<p><span class="LC_error">'.&mt("Error: a published $published_type of this name exists.").'</span></p>'; |
$result.='<p class="LC_error">'.&mt("Error: a published $published_type of this name exists.").'</p>'; |
| } |
} |
| } |
} |
| } elsif ( -e $construct) { |
} elsif ( -e $construct) { |
| $type = 'warning'; |
$type = 'warning'; |
| $result.='<p><span class="LC_warning">'.&mt('Warning: target file exists!').'</span></p>'; |
$result.='<p class="LC_warning">'.&mt('Warning: target file exists!').'</p>'; |
| } |
} |
| |
|
| return ($type,$result); |
return ($type,$result); |
|
Line 309 sub exists {
|
Line 313 sub exists {
|
| =pod |
=pod |
| |
|
| =item checksuffix($old, $new) |
=item checksuffix($old, $new) |
| |
|
| Determine if a resource filename suffix (the stuff after the .) would change |
Determine if a resource filename suffix (the stuff after the .) would change |
| as a result of this operation. |
as a result of this operation. |
| |
|
|
Line 344 sub checksuffix {
|
Line 348 sub checksuffix {
|
| if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; } |
if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; } |
| if (lc($oldsuffix) ne lc($newsuffix)) { |
if (lc($oldsuffix) ne lc($newsuffix)) { |
| $result.= |
$result.= |
| '<p><span class="LC_warning">'.&mt('Warning: change of MIME type!').'</span></p>'; |
'<p class="LC_warning">'.&mt('Warning: change of MIME type!').'></p>'; |
| } |
} |
| return $result; |
return $result; |
| } |
} |
| |
|
| sub cleanDest { |
sub cleanDest { |
| my ($request,$dest,$subdir,$fn,$uname,$udom)=@_; |
my ($dest,$subdir,$fn,$uname,$udom)=@_; |
| #remove bad characters |
#remove bad characters |
| my $foundbad=0; |
my $foundbad=0; |
| |
my $warnings; |
| my $error=''; |
my $error=''; |
| if ($subdir && $dest =~/\./) { |
if ($subdir && $dest =~/\./) { |
| $foundbad=1; |
$foundbad=1; |
|
Line 367 sub cleanDest {
|
Line 372 sub cleanDest {
|
| my ($newpath)=($dest=~m|(.*)/|); |
my ($newpath)=($dest=~m|(.*)/|); |
| ($newpath,$error)=&relativeDest($fn,$newpath,$uname,$udom); |
($newpath,$error)=&relativeDest($fn,$newpath,$uname,$udom); |
| if (! -d "$newpath") { |
if (! -d "$newpath") { |
| $request->print('<p><span class="LC_warning">' |
$warnings = '<p class="LC_warning">' |
| .&mt("You have requested to create file in directory [_1] which doesn't exist. The requested directory path has been removed from the requested filename." |
.&mt("You have requested to create file in directory [_1] which doesn't exist. The requested directory path has been removed from the requested filename." |
| ,&display($newpath)) |
,&display($newpath)) |
| .'</span></p>'); |
.'</p>'; |
| $dest=~s|.*/||; |
$dest=~s|.*/||; |
| } |
} |
| } |
} |
| if ($dest =~ /\.(\d+)\.(\w+)$/){ |
if ($dest =~ /\.(\d+)\.(\w+)$/) { |
| $request->print('<p><span class="LC_warning">' |
$warnings .= '<p class="LC_warning">' |
| .&mt('Bad filename [_1]',&display($dest)) |
.&mt('Bad filename [_1]',&display($dest)) |
| .'<br />' |
.'<br />' |
| .&mt('[_1](name).(number).(extension)[_2] not allowed.','<tt>','</tt>') |
.&mt('[_1](name).(number).(extension)[_2] not allowed.','<tt>','</tt>') |
| .'<br />' |
.'<br />' |
| .&mt('Removing the [_1].number.[_2] from requested filename.','<tt>','</tt>') |
.&mt('Removing the [_1].number.[_2] from requested filename.','<tt>','</tt>') |
| .'</span></p>'); |
.'</p>'; |
| $dest =~ s/\.(\d+)(\.\w+)$/$2/; |
$dest =~ s/\.(\d+)(\.\w+)$/$2/; |
| } |
} |
| if ($foundbad) { |
if ($foundbad) { |
| $request->print('<p><span class="LC_warning">' |
$warnings .= '<p class="LC_warning">' |
| .&mt('Invalid characters in requested name have been removed.') |
.&mt('Invalid characters in requested name have been removed.') |
| .'</span></p>' |
.'</p>'; |
| ); |
|
| } |
} |
| return ($dest,$error); |
return ($dest,$error,$warnings); |
| } |
} |
| |
|
| sub relativeDest { |
sub relativeDest { |
|
Line 459 Parameters:
|
Line 463 Parameters:
|
| =item $user - string [in] - Name of the user that is initiating the |
=item $user - string [in] - Name of the user that is initiating the |
| request. |
request. |
| |
|
| =item $directory - string [in] - Directory in which the operation is |
=item $directory - string [in] - Directory in which the operation is |
| being done relative to the top level construction space |
being done relative to the top level construction space |
| directory. |
directory. |
| |
|
|
Line 469 Parameters:
|
Line 473 Parameters:
|
| |
|
| sub CloseForm2 { |
sub CloseForm2 { |
| my ($request, $user, $fn) = @_; |
my ($request, $user, $fn) = @_; |
| $request->print(&done(&url($fn))); |
$request->print(&done($fn)); |
| } |
} |
| |
|
| =pod |
=pod |
| |
|
| =item Rename1($request, $filename, $user, $domain, $dir) |
=item Rename1($request, $filename, $user, $domain, $dir) |
| |
|
| Perform phase 1 processing of the file rename operation. |
Perform phase 1 processing of the file rename operation. |
| |
|
| Parameters: |
Parameters: |
| |
|
| =over 4 |
=over 4 |
| |
|
| =item $request - Apache Request Object [in] The request object for the |
=item $request - Apache Request Object [in] The request object for the |
| current request. |
current request. |
| |
|
| =item $filename - The filename relative to construction space. |
=item $filename - The filename relative to construction space. |
|
Line 505 new filename relative to the current dir
|
Line 509 new filename relative to the current dir
|
| |
|
| =back |
=back |
| |
|
| =cut |
=cut |
| |
|
| sub Rename1 { |
sub Rename1 { |
| my ($request, $user, $domain, $fn, $newfilename, $style) = @_; |
my ($request, $user, $domain, $fn, $newfilename, $style) = @_; |
|
Line 583 sub Rename1 {
|
Line 587 sub Rename1 {
|
| ); |
); |
| return; |
return; |
| } |
} |
| |
|
| } |
} |
| |
|
| =pod |
=pod |
|
Line 597 Parameters:
|
Line 601 Parameters:
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item $request - Apache Request Object [in] request object for the current |
=item $request - Apache Request Object [in] request object for the current |
| request. |
request. |
| |
|
| =item $user - string [in] Name of the user initiating the request. |
=item $user - string [in] Name of the user initiating the request. |
|
Line 628 sub Delete1 {
|
Line 632 sub Delete1 {
|
| ); |
); |
| return; |
return; |
| } |
} |
| } else { |
} else { |
| unless (&obsolete_unpub($user,$domain,$fn)) { |
unless (&obsolete_unpub($user,$domain,$fn)) { |
| $request->print('<p><span class="LC_error">' |
$request->print('<p><span class="LC_error">' |
| .&mt('Cannot delete non-obsolete published file.') |
.&mt('Cannot delete non-obsolete published file.') |
|
Line 665 Parameters:
|
Line 669 Parameters:
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item $request - Apache Request Object [in] request object for the current |
=item $request - Apache Request Object [in] request object for the current |
| request. |
request. |
| |
|
| =item $user - string [in] Name of the user initiating the request. |
=item $user - string [in] Name of the user initiating the request. |
|
Line 691 sub Copy1 {
|
Line 695 sub Copy1 {
|
| if ($newfilename =~ m|/[^\.]+$|) { |
if ($newfilename =~ m|/[^\.]+$|) { |
| #no extension add on original extension |
#no extension add on original extension |
| if ($fn =~ m|/[^\.]*\.([^\.]+)$|) { $newfilename.='.'.$1; } |
if ($fn =~ m|/[^\.]*\.([^\.]+)$|) { $newfilename.='.'.$1; } |
| } |
} |
| $newfilename=~s://+:/:g; # remove duplicate / |
$newfilename=~s://+:/:g; # remove duplicate / |
| while ($newfilename=~m:/\.\./:) { |
while ($newfilename=~m:/\.\./:) { |
| $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/.. |
$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/.. |
|
Line 708 sub Copy1 {
|
Line 712 sub Copy1 {
|
| my ($dir,$fname) = ($fn =~ m{^(.+/)([^/]+)$}); |
my ($dir,$fname) = ($fn =~ m{^(.+/)([^/]+)$}); |
| my $filesize = $fileinfo[7]; |
my $filesize = $fileinfo[7]; |
| $filesize = int($filesize/1000); #expressed in kb |
$filesize = int($filesize/1000); #expressed in kb |
| my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$domain/$user"; |
my $output = &Apache::loncommon::excess_filesize_warning($user,$domain,'author', |
| my $output = &Apache::loncommon::excess_filesize_authorspace($user,$domain,$authorspace, |
$fname,$filesize,'copy'); |
| $fname,$filesize,'copy'); |
|
| if ($output) { |
if ($output) { |
| $request->print($output.'<br /><a href="'.&url($dir).'">'.&mt('Cancel').'</a></form>'); |
$request->print($output.'<br /><a href="'.&url($dir).'">'.&mt('Cancel').'</a></form>'); |
| return; |
return; |
|
Line 737 sub Copy1 {
|
Line 740 sub Copy1 {
|
| =pod |
=pod |
| |
|
| =item NewDir1 |
=item NewDir1 |
| |
|
| Does all phase 1 processing of directory creation: |
Does all phase 1 processing of directory creation: |
| Ensures that the user provides a new directory name, |
Ensures that the user provides a new directory name, |
| and that the directory does not already exist. |
and that the directory does not already exist. |
|
Line 755 Parameters:
|
Line 758 Parameters:
|
| |
|
| =item $fn - source file. |
=item $fn - source file. |
| |
|
| =item $newdir - Name of the directory to be created; path relative to the |
=item $newdir - Name of the directory to be created; path relative to the |
| top level of construction space. |
top level of construction space. |
| =back |
=back |
| |
|
|
Line 816 sub Decompress1 {
|
Line 819 sub Decompress1 {
|
| } |
} |
| } |
} |
| |
|
| |
sub Archive1 { |
| |
my ($request,$fn) = @_; |
| |
my @posstypes = qw(problem library sty sequence page task rights meta xml html xhtml htm xhtm css js tex txt gif jpg jpeg png svg other); |
| |
my (%location_of,%default,$compstyle); |
| |
foreach my $program ('tar','gzip','bzip2','xz','zip') { |
| |
foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/', |
| |
'/usr/sbin/') { |
| |
if (-x $dir.$program) { |
| |
$location_of{$program} = $dir.$program; |
| |
last; |
| |
} |
| |
} |
| |
} |
| |
my (%defaults,$cancompress,$canarchive); |
| |
if (exists($location_of{'tar'})) { |
| |
$default{'tar'} = ' checked="checked"'; |
| |
$canarchive = 1; |
| |
$compstyle = 'block'; |
| |
} elsif (exists($location_of{'zip'})) { |
| |
$default{'zip'} = ' checked="checked"'; |
| |
$canarchive = 1; |
| |
$compstyle = 'none'; |
| |
} |
| |
foreach my $compress ('gzip','bzip2','xz') { |
| |
if (exists($location_of{$compress})) { |
| |
$default{$compress} = ' checked="checked"'; |
| |
$cancompress = 1; |
| |
last; |
| |
} |
| |
} |
| |
if (!$canarchive) { |
| |
$request->print('<p class="LC_error">'. |
| |
&mt('This LON-CAPA instance does not seem to have either tar or zip installed.').'</p>'. |
| |
'<span class="LC_warning">'. |
| |
&mt('At least one of the two is needed in order to be able to create an archive file for: [_1].', |
| |
&display($fn)). |
| |
'</span></form>'); |
| |
} elsif (-e $fn) { |
| |
$request->print(&Apache::lonhtmlcommon::start_pick_box(). |
| |
&Apache::lonhtmlcommon::row_title(&mt('Directory')). |
| |
&display($fn). |
| |
&Apache::lonhtmlcommon::row_closure(). |
| |
&Apache::lonhtmlcommon::row_title(&mt('Options'). |
| |
&Apache::loncommon::help_open_topic('Archiving_Directory_Options')). |
| |
'<fieldset><legend>'.&mt('Recurse').'</legend>'. |
| |
'<span class="LC_nobreak"><label><input type="checkbox" name="recurse" /> '. |
| |
&mt('include subdirectories').'</label></span>'. |
| |
'</fieldset>'. |
| |
'<fieldset><legend>'.&mt('File types (extensions) to include').(' 'x2). |
| |
'<span style="text-decoration:line-through">'.(' 'x5).'</span>'.(' 'x2). |
| |
'<input type="button" name="checkall" value="'.&mt('check all'). |
| |
'" style="height:20px;" onclick="checkAll(document.phaseone.filetype);" />'. |
| |
(' 'x2). |
| |
'<input type="button" name="uncheckall" value="'.&mt('uncheck all'). |
| |
'" style="height:20px;" onclick="uncheckAll(document.phaseone.filetype);" /></legend>'. |
| |
'<table>'); |
| |
my $rem; |
| |
my $numinrow = 6; |
| |
for (my $i=0; $i<@posstypes; $i++) { |
| |
my $rem = $i%($numinrow); |
| |
if ($rem == 0) { |
| |
if ($i > 0) { |
| |
$request->print('</tr>'."\n"); |
| |
} |
| |
$request->print('<tr>'."\n"); |
| |
} |
| |
$request->print('<td class="LC_left_item">'. |
| |
'<span class="LC_nobreak"><label>'. |
| |
'<input type="checkbox" name="filetype" '. |
| |
'value="'.$posstypes[$i].'" /> '. |
| |
$posstypes[$i].'</label></span></td>'."\n"); |
| |
} |
| |
$rem = scalar(@posstypes)%($numinrow); |
| |
my $colsleft; |
| |
if ($rem) { |
| |
$colsleft = $numinrow - $rem; |
| |
} |
| |
if ($colsleft > 1 ) { |
| |
$request->print('<td colspan="'.$colsleft.'" class="LC_left_item">'. |
| |
' </td>'."\n"); |
| |
} elsif ($colsleft == 1) { |
| |
$request->print('<td class="LC_left_item"> </td>'."\n"); |
| |
} |
| |
$request->print('</tr></table>'."\n". |
| |
'</fieldset>'. |
| |
'<fieldset><legend>'.&mt('Archive file format').'</legend>'); |
| |
foreach my $possfmt ('tar','zip') { |
| |
if (exists($location_of{$possfmt})) { |
| |
$request->print('<span class="LC_nobreak">'. |
| |
'<label><input type="radio" name="format" value="'.$possfmt.'"'. |
| |
$default{$possfmt}.' onclick="toggleCompression(this.form);" /> '. |
| |
$possfmt.'</label></span> '); |
| |
} |
| |
} |
| |
$request->print('</fieldset>'."\n". |
| |
'<fieldset style="display:'.$compstyle.'" id="tar_compression">'. |
| |
'<legend>'.&mt('Compression to apply to tar file').'</legend>'. |
| |
'<span class="LC_nobreak">'); |
| |
if ($cancompress) { |
| |
foreach my $compress ('gzip','bzip2','xz') { |
| |
if (exists($location_of{$compress})) { |
| |
$request->print('<label><input type="radio" name="compress" value="'.$compress.'"'. |
| |
$default{$compress}.' />'.$compress.'</label> '); |
| |
} |
| |
} |
| |
} else { |
| |
$request->print('<span class="LC_warning">'. |
| |
&mt('This LON-CAPA instance does not seem to have gzip, bzip2 or xz installed.'). |
| |
'<br />'.&mt('No compression will be used.').'</span>'); |
| |
} |
| |
$request->print('</fieldset>'. |
| |
&Apache::lonhtmlcommon::row_closure(1). |
| |
&Apache::lonhtmlcommon::end_pick_box() |
| |
); |
| |
&CloseForm1($request, $fn); |
| |
} else { |
| |
$request->print('<p class="LC_error">' |
| |
.&mt('No such directory: [_1]', |
| |
&display($fn)) |
| |
.'</p></form>' |
| |
); |
| |
} |
| |
} |
| |
|
| =pod |
=pod |
| |
|
| =item NewFile1 |
=item NewFile1 |
| |
|
| Does all phase 1 processing of file creation: |
Does all phase 1 processing of file creation: |
| Ensures that the user provides a new filename, adds proper extension |
Ensures that the user provides a new filename, adds proper extension |
| if needed and that the file does not already exist, if it is a html, |
if needed and that the file does not already exist, if it is a html, |
|
Line 841 Parameters:
|
Line 968 Parameters:
|
| |
|
| =item $newfilename |
=item $newfilename |
| - Name of the file to be created; no path information |
- Name of the file to be created; no path information |
| |
|
| |
=item $warnings - Information about changes to filename made by cleanDest(). |
| |
|
| =back |
=back |
| |
|
| Side Effects: |
Side Effects: |
|
Line 857 button which returns you to the director
|
Line 987 button which returns you to the director
|
| =cut |
=cut |
| |
|
| sub NewFile1 { |
sub NewFile1 { |
| my ($request, $user, $domain, $fn, $newfilename) = @_; |
my ($request, $user, $domain, $fn, $newfilename, $warnings) = @_; |
| return if (&filename_check($newfilename) ne 'ok'); |
return if (&filename_check($newfilename,$warnings) ne 'ok'); |
| |
|
| if ($env{'form.action'} =~ /new(.+)file/) { |
if ($env{'form.action'} =~ /new(.+)file/) { |
| my $extension=$1; |
my $extension=$1; |
|
Line 871 sub NewFile1 {
|
Line 1001 sub NewFile1 {
|
| } |
} |
| } |
} |
| my ($type, $result)=&exists($user,$domain,$newfilename); |
my ($type, $result)=&exists($user,$domain,$newfilename); |
| $request->print($result); |
|
| if ($type eq 'error') { |
if ($type eq 'error') { |
| |
$request->print($warnings.$result); |
| $request->print('</form>'); |
$request->print('</form>'); |
| } else { |
} else { |
| my $extension; |
my $extension; |
|
Line 884 sub NewFile1 {
|
Line 1014 sub NewFile1 {
|
| my @okexts = qw(xml html xhtml htm xhtm problem page sequence rights sty task library js css txt); |
my @okexts = qw(xml html xhtml htm xhtm problem page sequence rights sty task library js css txt); |
| if (($extension eq '') || (!grep(/^\Q$extension\E/,@okexts))) { |
if (($extension eq '') || (!grep(/^\Q$extension\E/,@okexts))) { |
| my $validexts = '.'.join(', .',@okexts); |
my $validexts = '.'.join(', .',@okexts); |
| |
$request->print($warnings.$result); |
| $request->print('<p class="LC_warning">'. |
$request->print('<p class="LC_warning">'. |
| &mt('Invalid filename: ').&display($newfilename).'</p><p>'. |
&mt('Invalid filename: ').&display($newfilename).'</p><p>'. |
| &mt('The name of the new file needs to end with an appropriate file extension to indicate the type of file to create.').'<br />'. |
&mt('The name of the new file needs to end with an appropriate file extension to indicate the type of file to create.').'<br />'. |
|
Line 896 sub NewFile1 {
|
Line 1027 sub NewFile1 {
|
| '</span></form></p>'. |
'</span></form></p>'. |
| '<p><form action="'.&url($fn). |
'<p><form action="'.&url($fn). |
| '" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></form></p>'); |
'" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></form></p>'); |
| return; |
} elsif (($type ne 'warning') && ($warnings eq '') && ($result eq '')) { |
| |
my $query = ""; |
| |
$query .= "?mode=" . $env{'form.mode'} unless (!exists($env{'form.mode'}) || !length($env{'form.mode'})); |
| |
$request->print(' |
| |
<script type="text/javascript"> |
| |
window.location = "'.&url($newfilename,'js'). $query .'"; |
| |
</script>'); |
| |
} else { |
| |
$request->print($warnings.$result); |
| |
$request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>'); |
| |
$request->print('</form>'); |
| |
$request->print('<form action="'.&url($newfilename). |
| |
'" method="post"><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>'); |
| } |
} |
| |
|
| $request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>'); |
|
| $request->print('</form>'); |
|
| |
|
| $request->print('<form action="'.&url($newfilename). |
|
| '" method="post"><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>'); |
|
| } |
} |
| return; |
return; |
| } |
} |
|
Line 925 sub filename_check {
|
Line 1062 sub filename_check {
|
| ' '.&mt('Not Allowed').'</span>'); |
' '.&mt('Not Allowed').'</span>'); |
| return; |
return; |
| } |
} |
| return 'ok'; |
return 'ok'; |
| } |
} |
| |
|
| =pod |
=pod |
|
Line 936 sub filename_check {
|
Line 1073 sub filename_check {
|
| are returned if the request cannot be performed (e.g. attempts to manipulate |
are returned if the request cannot be performed (e.g. attempts to manipulate |
| files that are nonexistent). If the operation can be performed, what is |
files that are nonexistent). If the operation can be performed, what is |
| about to be done will be presented to the user for confirmation. If the |
about to be done will be presented to the user for confirmation. If the |
| user confirms the request, then phase two is executed, the action |
user confirms the request, then phase two is executed, the action |
| performed and reported to the user. |
performed and reported to the user. |
| |
|
| Parameters: |
Parameters: |
|
Line 945 performed and reported to the user.
|
Line 1082 performed and reported to the user.
|
| |
|
| =item $r - request object [in] - The Apache request being executed. |
=item $r - request object [in] - The Apache request being executed. |
| |
|
| =item $fn = string [in] - The filename being manipulated by the |
=item $fn = string [in] - The filename being manipulated by the |
| request. |
request. |
| |
|
| =item $uname - string [in] Name of user logged in and doing this action. |
=item $uname - string [in] Name of user logged in and doing this action. |
| |
|
| =item $udom - string [in] Domain name under which the user logged in. |
=item $udom - string [in] Domain name under which the user logged in. |
| |
|
| =back |
=back |
| |
|
|
Line 958 performed and reported to the user.
|
Line 1095 performed and reported to the user.
|
| |
|
| sub phaseone { |
sub phaseone { |
| my ($r,$fn,$uname,$udom)=@_; |
my ($r,$fn,$uname,$udom)=@_; |
| |
|
| my $doingdir=0; |
my $doingdir=0; |
| if ($env{'form.action'} eq 'newdir') { $doingdir=1; } |
if ($env{'form.action'} eq 'newdir') { $doingdir=1; } |
| my ($newfilename,$error) = |
my ($newfilename,$error,$warnings) = |
| &cleanDest($r,$env{'form.newfilename'},$doingdir,$fn,$uname,$udom); |
&cleanDest($env{'form.newfilename'},$doingdir,$fn,$uname,$udom); |
| unless ($error) { |
unless ($error) { |
| ($newfilename,$error)=&relativeDest($fn,$newfilename,$uname,$udom); |
($newfilename,$error)=&relativeDest($fn,$newfilename,$uname,$udom); |
| } |
} |
|
Line 971 sub phaseone {
|
Line 1108 sub phaseone {
|
| if ($fn=~m{^(.*/)[^/]+$}) { |
if ($fn=~m{^(.*/)[^/]+$}) { |
| $dirlist=$1; |
$dirlist=$1; |
| } else { |
} else { |
| $dirlist=$fn; |
$dirlist=$fn; |
| |
} |
| |
if ($warnings) { |
| |
$r->print($warnings); |
| } |
} |
| $r->print('<div class="LC_error">'.$error.'</div>'. |
$r->print('<div class="LC_error">'.$error.'</div>'. |
| '<p><a href="'.&url($dirlist).'">'.&mt('Return to Directory'). |
'<p><a href="'.&url($dirlist).'">'.&mt('Return to Directory'). |
| '</a></p>'); |
'</a></p>'); |
| return; |
return; |
| } |
} |
| $r->print('<form action="/adm/cfile" method="post">'. |
$r->print('<form action="/adm/cfile" method="post" name="phaseone">'. |
| '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'. |
'<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'. |
| '<input type="hidden" name="phase" value="two" />'. |
'<input type="hidden" name="phase" value="two" />'. |
| '<input type="hidden" name="action" value="'.$env{'form.action'}.'" />'); |
'<input type="hidden" name="action" value="'.$env{'form.action'}.'" />'); |
| |
|
| if ($env{'form.action'} eq 'rename') { |
if ($env{'form.action'} eq 'newfile' || |
| &Rename1($r, $uname, $udom, $fn, $newfilename, 'rename'); |
$env{'form.action'} eq 'newhtmlfile' || |
| } elsif ($env{'form.action'} eq 'move') { |
$env{'form.action'} eq 'newproblemfile' || |
| &Rename1($r, $uname, $udom, $fn, $newfilename, 'move'); |
$env{'form.action'} eq 'newpagefile' || |
| } elsif ($env{'form.action'} eq 'delete') { |
$env{'form.action'} eq 'newsequencefile' || |
| &Delete1($r, $uname, $udom, $fn); |
$env{'form.action'} eq 'newrightsfile' || |
| } elsif ($env{'form.action'} eq 'decompress') { |
$env{'form.action'} eq 'newstyfile' || |
| &Decompress1($r, $uname, $udom, $fn); |
$env{'form.action'} eq 'newtaskfile' || |
| } elsif ($env{'form.action'} eq 'copy') { |
$env{'form.action'} eq 'newlibraryfile' || |
| if($newfilename) { |
$env{'form.action'} eq 'Select Action') { |
| &Copy1($r, $uname, $udom, $fn, $newfilename); |
|
| } else { |
|
| $r->print('<p class="LC_error">' |
|
| .&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 'newtaskfile' || |
|
| $env{'form.action'} eq 'newlibraryfile' || |
|
| $env{'form.action'} eq 'Select Action') { |
|
| my $empty=&mt('Type Name Here'); |
my $empty=&mt('Type Name Here'); |
| if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) { |
if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) { |
| &NewFile1($r, $uname, $udom, $fn, $newfilename); |
&NewFile1($r, $uname, $udom, $fn, $newfilename, $warnings); |
| } else { |
} else { |
| |
if ($warnings) { |
| |
$r->print($warnings); |
| |
} |
| $r->print('<p class="LC_error">' |
$r->print('<p class="LC_error">' |
| .&mt('No new filename specified.') |
.&mt('No new filename specified.') |
| .'</p></form>' |
.'</p></form>' |
| ); |
); |
| } |
} |
| |
} else { |
| |
if ($warnings) { |
| |
$r->print($warnings); |
| |
} |
| |
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 'archive') { |
| |
&Archive1($r,$fn); |
| |
} elsif ($env{'form.action'} eq 'copy') { |
| |
if ($newfilename) { |
| |
&Copy1($r, $uname, $udom, $fn, $newfilename); |
| |
} else { |
| |
$r->print('<p class="LC_error">' |
| |
.&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); |
| |
} |
| } |
} |
| } |
} |
| |
|
|
Line 1079 sub Rename2 {
|
Line 1229 sub Rename2 {
|
| return 0; |
return 0; |
| } |
} |
| ## If old name.(extension) exits, move under new name. |
## If old name.(extension) exits, move under new name. |
| ## If it doesn't exist and a new.(extension) exists |
## If it doesn't exist and a new.(extension) exists |
| ## delete it (only concern when renaming over files) |
## delete it (only concern when renaming over files) |
| my $tmp1=$oRN.'.meta'; |
my $tmp1=$oRN.'.meta'; |
| my $tmp2=$nRN.'.meta'; |
my $tmp2=$nRN.'.meta'; |
|
Line 1125 sub Rename2 {
|
Line 1275 sub Rename2 {
|
| |
|
| =item Delete2($request, $user, $filename) |
=item Delete2($request, $user, $filename) |
| |
|
| Performs phase two of a delete. The user has confirmed that they want |
Performs phase two of a delete. The user has confirmed that they want |
| to delete the selected file. The file is deleted and the results of the |
to delete the selected file. The file is deleted and the results of the |
| delete attempt are indicated. |
delete attempt are indicated. |
| |
|
|
Line 1152 Returns:
|
Line 1302 Returns:
|
| |
|
| sub Delete2 { |
sub Delete2 { |
| my ($request, $user, $filename) = @_; |
my ($request, $user, $filename) = @_; |
| if (-d $filename) { |
if (-d $filename) { |
| unless (&empty_directory($filename,'Delete2')) { |
unless (&empty_directory($filename,'Delete2')) { |
| $request->print('<span class="LC_error">'.&mt('Error: Directory Non Empty').'</span>'); |
$request->print('<span class="LC_error">'.&mt('Error: Directory Non Empty').'</span>'); |
| return 0; |
return 0; |
| } else { |
} else { |
| if(-e $filename) { |
if(-e $filename) { |
| unless(rmdir($filename)) { |
unless(rmdir($filename)) { |
| $request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
|
Line 1185 sub Delete2 {
|
Line 1335 sub Delete2 {
|
| |
|
| =item Copy2($request, $username, $dir, $oldfile, $newfile) |
=item Copy2($request, $username, $dir, $oldfile, $newfile) |
| |
|
| Performs phase 2 of a copy. The file is copied and the status |
Performs phase 2 of a copy. The file is copied and the status |
| of that copy is reported back to the user. |
of that copy is reported back to the user. |
| |
|
| =over 4 |
=over 4 |
|
Line 1223 sub Copy2 {
|
Line 1373 sub Copy2 {
|
| } elsif (!chmod(0660, $newfile)) { |
} elsif (!chmod(0660, $newfile)) { |
| $request->print('<span class="LC_error">'.&mt('chmod error').': '.$!.'</span>'); |
$request->print('<span class="LC_error">'.&mt('chmod error').': '.$!.'</span>'); |
| return 0; |
return 0; |
| } elsif (-e $oldfile.'.meta' && |
} elsif (-e $oldfile.'.meta' && |
| !copy($oldfile.'.meta', $newfile.'.meta') && |
!copy($oldfile.'.meta', $newfile.'.meta') && |
| !chmod(0660, $newfile.'.meta')) { |
!chmod(0660, $newfile.'.meta')) { |
| $request->print('<span class="LC_error">'.&mt('copy metadata error'). |
$request->print('<span class="LC_error">'.&mt('copy metadata error'). |
|
Line 1263 Returns 0 - failure 1 - success.
|
Line 1413 Returns 0 - failure 1 - success.
|
| |
|
| sub NewDir2 { |
sub NewDir2 { |
| my ($request, $user, $newdirectory) = @_; |
my ($request, $user, $newdirectory) = @_; |
| |
|
| unless(mkdir($newdirectory, 02770)) { |
unless(mkdir($newdirectory, 02770)) { |
| $request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
| return 0; |
return 0; |
|
Line 1286 sub decompress2 {
|
Line 1436 sub decompress2 {
|
| return 1; |
return 1; |
| } |
} |
| |
|
| |
sub Archive2 { |
| |
my ($r,$name,$udom,$fn,$identifier) = @_; |
| |
my %options = ( |
| |
dir => $fn, |
| |
); |
| |
my @filetypes = qw(problem library sty sequence page task rights meta xml html xhtml htm xhtm css js tex txt gif jpg jpeg png svg other); |
| |
my (@include,%oktypes); |
| |
map { $oktypes{$_} = 1; } @filetypes; |
| |
my @posstypes = &Apache::loncommon::get_env_multiple('form.filetype'); |
| |
foreach my $type (@posstypes) { |
| |
if ($oktypes{$type}) { |
| |
push(@include,$type); |
| |
} |
| |
} |
| |
if (scalar(@include) == scalar(@filetypes)) { |
| |
$options{'types'} = 'all'; |
| |
} else { |
| |
$options{'types'} = join(',',@include); |
| |
} |
| |
if (exists($env{'form.recurse'})) { |
| |
$options{'recurse'} = 1; |
| |
} |
| |
if (exists($env{'form.encrypt'})) { |
| |
if ($env{'form.enckey'} ne '') { |
| |
$options{'encrypt'} = $env{'form.enckey'}; |
| |
} |
| |
} |
| |
$options{'format'} = 'tar'; |
| |
$options{'compress'} = 'gzip'; |
| |
if ((exists($env{'form.format'})) && $env{'form.format'} =~ /^zip$/i) { |
| |
$options{'format'} = 'zip'; |
| |
delete($options{'compress'}); |
| |
} elsif ((exists($env{'form.compress'})) && ($env{'form.compress'} =~ /^(xz|bzip2)$/i)) { |
| |
$options{'compress'} = lc($env{'form.compress'}); |
| |
} |
| |
my $key = 'cgi.'.$identifier.'.archive'; |
| |
my $storestring = &Apache::lonnet::freeze_escape(\%options); |
| |
&Apache::lonnet::appenv({$key => $storestring}); |
| |
return 1; |
| |
} |
| |
|
| =pod |
=pod |
| |
|
| =item phasetwo($r, $fn, $uname, $udom) |
=item phasetwo($r, $fn, $uname, $udom,$identifier) |
| |
|
| Controls the phase 2 processing of file management |
Controls the phase 2 processing of file management |
| requests for construction space. In phase one, the user |
requests for construction space. In phase one, the user |
|
Line 1296 sub decompress2 {
|
Line 1487 sub decompress2 {
|
| is performed and the result is shown. |
is performed and the result is shown. |
| |
|
| The strategy is to break out the processing into specific action processors |
The strategy is to break out the processing into specific action processors |
| named action2 where action is the requested action and the 2 denotes |
named action2 where action is the requested action and the 2 denotes |
| phase 2 processing. |
phase 2 processing. |
| |
|
| Parameters: |
Parameters: |
|
Line 1319 Parameters:
|
Line 1510 Parameters:
|
| =cut |
=cut |
| |
|
| sub phasetwo { |
sub phasetwo { |
| my ($r,$fn,$uname,$udom)=@_; |
my ($r,$fn,$uname,$udom,$identifier)=@_; |
| |
|
| &Debug($r, "loncfile - Entering phase 2 for $fn"); |
&Debug($r, "loncfile - Entering phase 2 for $fn"); |
| |
|
| # Break down the file into its component pieces. |
# Break down the file into its component pieces. |
| |
|
| my $dir; # Directory path |
my $dir; # Directory path |
| my $main; # Filename. |
my $main; # Filename. |
| my $suffix; # Extension. |
my $suffix; # Extension. |
|
Line 1344 sub phasetwo {
|
Line 1535 sub phasetwo {
|
| &Debug($r," newfilename = ".$env{'form.newfilename'}); |
&Debug($r," newfilename = ".$env{'form.newfilename'}); |
| |
|
| my $conspace=$fn; |
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. |
# Select the appropriate processing sub. |
| if ($env{'form.action'} eq 'decompress') { |
if ($env{'form.action'} eq 'decompress') { |
| $main .= '.'.$suffix; |
$main .= '.'.$suffix; |
| if(!&decompress2($r, $uname, $dir, $main)) { |
if(!&decompress2($r, $uname, $dir, $main)) { |
| return ; |
return ; |
| } |
} |
| $dest = $dir."/."; |
$dest = $dir."/."; |
| |
} elsif ($env{'form.action'} eq 'archive') { |
| |
&Archive2($r,$uname,$udom,$fn,$identifier); |
| |
return; |
| } elsif ($env{'form.action'} eq 'rename' || |
} elsif ($env{'form.action'} eq 'rename' || |
| $env{'form.action'} eq 'move') { |
$env{'form.action'} eq 'move') { |
| if($env{'form.newfilename'}) { |
if($env{'form.newfilename'}) { |
| if (!defined($dir)) { |
if (!defined($dir)) { |
| $fn=~m:^(.*)/:; |
$fn=~m:^(.*)/:; |
| $dir=$1; |
$dir=$1; |
| } |
} |
| if(!&Rename2($r, $uname, $dir, $fn, $env{'form.newfilename'})) { |
if(!&Rename2($r, $uname, $dir, $fn, $env{'form.newfilename'})) { |
| return; |
return; |
|
Line 1372 sub phasetwo {
|
Line 1566 sub phasetwo {
|
| $disp_newname = $1; |
$disp_newname = $1; |
| $disp_newname =~ s/\///; |
$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'})) { |
| return ; |
return ; |
| } |
} |
|
Line 1380 sub phasetwo {
|
Line 1574 sub phasetwo {
|
| # previously held it. |
# previously held it. |
| # |
# |
| $dest = $dir."/."; # Parent dir. |
$dest = $dir."/."; # Parent dir. |
| } elsif ($env{'form.action'} eq 'copy') { |
} elsif ($env{'form.action'} eq 'copy') { |
| if($env{'form.newfilename'}) { |
if($env{'form.newfilename'}) { |
| if(!&Copy2($r, $uname, $dir, $fn, $env{'form.newfilename'})) { |
if(!&Copy2($r, $uname, $dir, $fn, $env{'form.newfilename'})) { |
| return ; |
return ; |
|
Line 1413 sub phasetwo {
|
Line 1607 sub phasetwo {
|
| ['<a href="'.&url($dest).'">'.&mt('Return to Directory').'</a>', |
['<a href="'.&url($dest).'">'.&mt('Return to Directory').'</a>', |
| '<a href="'.&url($dest_newname).'">'.$disp_newname.'</a>'])); |
'<a href="'.&url($dest_newname).'">'.$disp_newname.'</a>'])); |
| } else { |
} else { |
| $r->print(&done(&url($dest))); |
$r->print(&done($dest)); |
| } |
} |
| } |
} |
| } |
} |
|
Line 1422 sub handler {
|
Line 1616 sub handler {
|
| |
|
| $r=shift; |
$r=shift; |
| |
|
| &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress','action','filename','newfilename']); |
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress','action','filename','newfilename','mode']); |
| |
|
| &Debug($r, "loncfile.pm - handler entered"); |
&Debug($r, "loncfile.pm - handler entered"); |
| &Debug($r, " filename: ".$env{'form.filename'}); |
&Debug($r, " filename: ".$env{'form.filename'}); |
|
Line 1438 sub handler {
|
Line 1632 sub handler {
|
| &Debug($r, "test: $env{'form.filename'}"); |
&Debug($r, "test: $env{'form.filename'}"); |
| $fn=&unescape($env{'form.filename'}); |
$fn=&unescape($env{'form.filename'}); |
| $fn=&URLToPath($fn); |
$fn=&URLToPath($fn); |
| } elsif($ENV{'QUERY_STRING'} && $env{'form.phase'} ne 'two') { |
} elsif($ENV{'QUERY_STRING'} && $env{'form.phase'} ne 'two') { |
| #Just hijack the script only the first time around to inject the |
#Just hijack the script only the first time around to inject the |
| #correct information for further processing |
#correct information for further processing |
| $fn=&unescape($env{'form.decompress'}); |
$fn=&unescape($env{'form.decompress'}); |
|
Line 1449 sub handler {
|
Line 1643 sub handler {
|
| } else { |
} else { |
| &Debug($r, "loncfile::handler - no form.filename"); |
&Debug($r, "loncfile::handler - no form.filename"); |
| $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. |
$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. |
| ' unspecified filename for cfile', $r->filename); |
' unspecified filename for cfile', $r->filename); |
| return HTTP_NOT_FOUND; |
return HTTP_NOT_FOUND; |
| } |
} |
| |
|
| unless ($fn) { |
unless ($fn) { |
| &Debug($r, "loncfile::handler - doctored url is empty"); |
&Debug($r, "loncfile::handler - doctored url is empty"); |
| $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. |
$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. |
| ' trying to cfile non-existing file', $r->filename); |
' trying to cfile non-existing file', $r->filename); |
| return HTTP_NOT_FOUND; |
return HTTP_NOT_FOUND; |
| } |
} |
| |
|
| # ----------------------------------------------------------- Start page output |
# ----------------------------------------------------------- Start page output |
| |
|
| my ($uname,$udom) = &Apache::lonnet::constructaccess($fn); |
my ($uname,$udom) = &Apache::lonnet::constructaccess($fn); |
| &Debug($r, |
&Debug($r, |
| "loncfile::handler constructaccess uname = $uname domain = $udom"); |
"loncfile::handler constructaccess uname = $uname domain = $udom"); |
| if (($uname eq '') || ($udom eq '')) { |
if (($uname eq '') || ($udom eq '')) { |
| $r->log_reason($uname.' at '.$udom. |
$r->log_reason($uname.' at '.$udom. |
| ' trying to manipulate file '.$env{'form.filename'}. |
' trying to manipulate file '.$env{'form.filename'}. |
| ' ('.$fn.') - not authorized', |
' ('.$fn.') - not authorized', |
| $r->filename); |
$r->filename); |
| return HTTP_NOT_ACCEPTABLE; |
return HTTP_NOT_ACCEPTABLE; |
| } |
} |
| |
|
|
Line 1477 sub handler {
|
Line 1671 sub handler {
|
| &Apache::loncommon::content_type($r,'text/html'); |
&Apache::loncommon::content_type($r,'text/html'); |
| $r->send_http_header; |
$r->send_http_header; |
| |
|
| my (%loaditem,$js); |
my ($js,$identifier); |
| |
my $args = {}; |
| |
|
| 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'))) { |
| my $newdirname = $env{'form.newfilename'}; |
my $newdirname = $env{'form.newfilename'}; |
| $js = qq| |
&js_escape(\$newdirname); |
| |
$js = <<"ENDJS"; |
| <script type="text/javascript"> |
<script type="text/javascript"> |
| |
// <![CDATA[ |
| function writeDone() { |
function writeDone() { |
| window.focus(); |
window.focus(); |
| opener.document.info.newdir.value = "$newdirname"; |
opener.document.info.newdir.value = "$newdirname"; |
| setTimeout("self.close()",10000); |
setTimeout("self.close()",10000); |
| } |
} |
| </script> |
// ]]> |
| |; |
</script> |
| $loaditem{'onload'} = "writeDone()"; |
ENDJS |
| |
$args->{'add_entries'} = { onload => "writeDone()" }; |
| |
} elsif (($env{'form.action'} eq 'archive') && |
| |
($env{'environment.authorarchive'})) { |
| |
if ($env{'form.phase'} eq 'two') { |
| |
$identifier = &Apache::loncommon::get_cgi_id(); |
| |
$args->{'redirect'} = [0,"/cgi-bin/archive.pl?$identifier"]; |
| |
} else { |
| |
my $check_uncheck_js = &Apache::loncommon::check_uncheck_jscript(); |
| |
$js = <<"ENDJS"; |
| |
<script type="text/javascript"> |
| |
// <![CDATA[ |
| |
function toggleCompression(form) { |
| |
if (document.getElementById('tar_compression')) { |
| |
if (form.format.length > 1) { |
| |
for (var i=0; i<form.format.length; i++) { |
| |
if (form.format[i].checked) { |
| |
if (form.format[i].value == 'zip') { |
| |
document.getElementById('tar_compression').style.display = 'none'; |
| |
} else if (form.format[i].value == 'tar') { |
| |
document.getElementById('tar_compression').style.display = 'block'; |
| |
} |
| |
break; |
| |
} |
| |
} |
| |
} |
| } |
} |
| |
return; |
| |
} |
| |
|
| |
function resetForm() { |
| |
if (document.phaseone.filetype.length) { |
| |
for (var i=0; i<document.phaseone.filetype.length; i++) { |
| |
document.phaseone.filetype[i].checked = false; |
| |
} |
| |
} |
| |
if (document.getElementById('tar_compression')) { |
| |
if (document.phaseone.format.length) { |
| |
document.getElementById('tar_compression').style.display = 'block'; |
| |
for (var i=0; i<document.phaseone.format.length; i++) { |
| |
if (document.phaseone.format[i].value == 'tar') { |
| |
document.phaseone.format[i].checked = true; |
| |
} else { |
| |
document.phaseone.format[i].checked = false; |
| |
} |
| |
} |
| |
} |
| |
if (document.phaseone.compress.length) { |
| |
for (var i=0; i<document.phaseone.compress.length; i++) { |
| |
if (document.phaseone.compress[i].value == 'gzip') { |
| |
document.phaseone.compress[i].checked = true; |
| |
} else { |
| |
document.phaseone.compress[i].checked = false; |
| |
} |
| |
} |
| |
} |
| |
} |
| |
document.phaseone.recurse.checked = false; |
| |
} |
| |
|
| |
$check_uncheck_js |
| |
|
| |
// ]]> |
| |
</script> |
| |
|
| |
ENDJS |
| |
$args->{'add_entries'} = { onload => "resetForm()" }; |
| |
} |
| |
} |
| my $londocroot = $r->dir_config('lonDocRoot'); |
my $londocroot = $r->dir_config('lonDocRoot'); |
| my $trailfile = $fn; |
my $trailfile = $fn; |
| $trailfile =~ s{^/(priv/)}{$londocroot/$1}; |
$trailfile =~ s{^/(priv/)}{$londocroot/$1}; |
| |
|
| # Breadcrumbs |
# Breadcrumbs |
| |
my $crsauthor; |
| |
my $text = 'Authoring Space'; |
| |
my $title = 'Authoring Space File Operation', |
| |
my $href = &Apache::loncommon::authorspace(&url($fn)); |
| |
if ($env{'request.course.id'}) { |
| |
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; |
| |
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
| |
if ($href eq "/priv/$cdom/$cnum/") { |
| |
$text = 'Course Authoring Space'; |
| |
$title = 'Course Authoring Space File Operation', |
| |
$crsauthor = 1; |
| |
} |
| |
} |
| &Apache::lonhtmlcommon::clear_breadcrumbs(); |
&Apache::lonhtmlcommon::clear_breadcrumbs(); |
| &Apache::lonhtmlcommon::add_breadcrumb({ |
&Apache::lonhtmlcommon::add_breadcrumb({ |
| 'text' => 'Authoring Space', |
'text' => $text, |
| 'href' => &Apache::loncommon::authorspace($fn), |
'href' => $href, |
| }); |
}); |
| &Apache::lonhtmlcommon::add_breadcrumb({ |
&Apache::lonhtmlcommon::add_breadcrumb({ |
| 'text' => 'File Operation', |
'text' => 'File Operation', |
| 'title' => 'Authoring Space File Operation', |
'title' => $title, |
| 'href' => '', |
'href' => '', |
| }); |
}); |
| |
|
| $r->print(&Apache::loncommon::start_page('Authoring Space File Operation', |
$r->print(&Apache::loncommon::start_page($title,$js,$args) |
| $js, |
|
| {'add_entries' => \%loaditem,}) |
|
| .&Apache::lonhtmlcommon::breadcrumbs() |
.&Apache::lonhtmlcommon::breadcrumbs() |
| .&Apache::loncommon::head_subbox( |
.&Apache::loncommon::head_subbox( |
| &Apache::loncommon::CSTR_pageheader($trailfile)) |
&Apache::loncommon::CSTR_pageheader($trailfile)) |
| ); |
); |
| |
|
| $r->print('<p>'.&mt('Location').': '.&display($fn).'</p>'); |
unless ($env{'form.action'} eq 'archive') { |
| |
$r->print('<p>'.&mt('Location').': '.&display($fn).'</p>'); |
| |
} |
| |
|
| if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { |
if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) { |
| $r->print('<p class="LC_info">' |
unless ($crsauthor) { |
| .&mt('Co-Author [_1]',$uname.':'.$udom) |
$r->print('<p class="LC_info">' |
| .'</p>' |
.&mt('Co-Author [_1]',$uname.':'.$udom) |
| ); |
.'</p>' |
| |
); |
| |
} |
| } |
} |
| |
|
| |
|
|
Line 1534 function writeDone() {
|
Line 1813 function writeDone() {
|
| 'move' => 'Move', |
'move' => 'Move', |
| 'newdir' => 'New Directory', |
'newdir' => 'New Directory', |
| 'decompress' => 'Decompress', |
'decompress' => 'Decompress', |
| |
'archive' => 'Export directory to archive file', |
| 'copy' => 'Copy', |
'copy' => 'Copy', |
| 'newfile' => 'New Resource', |
'newfile' => 'New Resource', |
| 'newhtmlfile' => 'New Resource', |
'newhtmlfile' => 'New Resource', |
|
Line 1547 function writeDone() {
|
Line 1827 function writeDone() {
|
| 'Select Action' => 'New Resource', |
'Select Action' => 'New Resource', |
| ); |
); |
| if ($action{$env{'form.action'}}) { |
if ($action{$env{'form.action'}}) { |
| |
if ($crsauthor) { |
| |
my @disallowed = qw(page sequence rights library); |
| |
my $newtype; |
| |
if ($env{'form.action'} =~ /^new(\w+)file$/) { |
| |
$newtype = $1; |
| |
} elsif ($env{'form.action'} eq 'newfile') { |
| |
($newtype) = ($env{'form.newfilename'} =~ m{\.([^/.]+)$}); |
| |
$newtype = lc($newtype); |
| |
} |
| |
if (($newtype ne '') && |
| |
(grep(/^\Q$newtype\E$/,@disallowed))) { |
| |
$r->print('<p class="LC_error">' |
| |
.&mt('Creation of a new file of type: [_1] is not permitted in Course Authoring Space',$newtype) |
| |
.'</p>' |
| |
.&Apache::loncommon::end_page() |
| |
); |
| |
return OK; |
| |
} |
| |
if ($env{'form.action'} eq 'archive') { |
| |
$r->print('<p>'.&mt('Location').': '.&display($fn).'</p>'."\n". |
| |
'<p class="LC_error">'. |
| |
&mt('Export to an archive file is not permitted in Course Authoring Space'). |
| |
'</p>'."\n". |
| |
&Apache::loncommon::end_page()); |
| |
return OK; |
| |
} |
| |
} elsif ($env{'form.action'} eq 'archive') { |
| |
unless ($env{'environment.authorarchive'}) { |
| |
$r->print('<p>'.&mt('Location').': '.&display($fn).'</p>'."\n". |
| |
'<p class="LC_error">'. |
| |
&mt('You do not have permission to export to an archive file in this Authoring Space'). |
| |
'</p>'."\n". |
| |
&Apache::loncommon::end_page()); |
| |
return OK; |
| |
} |
| |
} |
| $r->print('<h2>'.$action{$env{'form.action'}}.'</h2>'); |
$r->print('<h2>'.$action{$env{'form.action'}}.'</h2>'); |
| } else { |
} else { |
| $r->print('<p class="LC_error">' |
$r->print('<p class="LC_error">' |
|
Line 1559 function writeDone() {
|
Line 1875 function writeDone() {
|
| |
|
| if ($env{'form.phase'} eq 'two') { |
if ($env{'form.phase'} eq 'two') { |
| &Debug($r, "loncfile::handler entering phase2"); |
&Debug($r, "loncfile::handler entering phase2"); |
| &phasetwo($r,$fn,$uname,$udom); |
&phasetwo($r,$fn,$uname,$udom,$identifier); |
| } else { |
} else { |
| &Debug($r, "loncfile::handler entering phase1"); |
&Debug($r, "loncfile::handler entering phase1"); |
| &phaseone($r,$fn,$uname,$udom); |
&phaseone($r,$fn,$uname,$udom); |
| } |
} |
| |
|
| $r->print(&Apache::loncommon::end_page()); |
$r->print(&Apache::loncommon::end_page()); |
| return OK; |
return OK; |
| } |
} |
| |
|
| 1; |
1; |
![[BACK]](/icons/back.gif){kind=icon}
Return to loncfile.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / publisher