|
version 1.14, 2002/08/05 02:09:05
|
version 1.129.2.2, 2024/09/03 11:07:47
|
|
Line 8
|
Line 8
|
| # and requests confirmation. The second phase commits the action |
# and requests confirmation. The second phase commits the action |
| # and displays a page showing the results of the action. |
# and displays a page showing the results of the action. |
| # |
# |
| |
|
| # |
# |
| # $Id$ |
# $Id$ |
| # |
# |
|
Line 34
|
Line 33
|
| # |
# |
| # http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
| # |
# |
| # |
|
| # (Handler to retrieve an old version of a file |
|
| # |
|
| # (Publication Handler |
|
| # |
|
| # (TeX Content Handler |
|
| # |
|
| # 05/29/00,05/30,10/11 Gerd Kortemeyer) |
|
| # |
|
| # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer |
|
| # 03/23 Guy Albertelli |
|
| # 03/24,03/29 Gerd Kortemeyer) |
|
| # |
|
| # 03/31,04/03,05/02,05/09,06/23,06/24 Gerd Kortemeyer) |
|
| # |
|
| # 06/23 Gerd Kortemeyer |
|
| # 05/07/02 Ron Fox: |
|
| # - Added Debug log output so that I can trace what the heck this |
|
| # undocumented thingy does. |
|
| # 05/28/02 Ron Fox: |
|
| # - Started putting in pod in standard format. |
|
| =pod |
=pod |
| |
|
| =head1 NAME |
=head1 NAME |
| |
|
| Apache::loncfile - Construction 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 procede 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 |
| completion. When the user dismisses the output of phase2, they are returned to |
completion. When the user dismisses the output of phase2, they are returned to |
|
Line 86 package Apache::loncfile;
|
Line 64 package Apache::loncfile;
|
| |
|
| use strict; |
use strict; |
| use Apache::File; |
use Apache::File; |
| |
use File::Basename; |
| use File::Copy; |
use File::Copy; |
| |
use HTML::Entities(); |
| use Apache::Constants qw(:common :http :methods); |
use Apache::Constants qw(:common :http :methods); |
| use Apache::loncacc; |
use Apache::lonnet; |
| use Apache::Log (); |
use Apache::loncommon(); |
| |
use Apache::lonhtmlcommon; |
| |
use Apache::lonlocal; |
| |
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 98 my $r; # Needs to be global for some
|
Line 81 my $r; # Needs to be global for some
|
| |
|
| =item Debug($request, $message) |
=item Debug($request, $message) |
| |
|
| If debugging is enabled puts out a debuggin message determined by the |
If debugging is enabled puts out a debugging message determined by the |
| caller. The debug message goes to the Apache error log file. Debugging |
caller. The debug message goes to the Apache error log file. Debugging |
| is enabled by ssetting the module global DEBUG variable to nonzero (TRUE). |
is enabled by setting the module global DEBUG variable to nonzero (TRUE). |
| |
|
| Parameters: |
Parameters: |
| |
|
| =over 4 |
=over 4 |
| |
|
| =item $request - The curretn request operation. |
|
| |
|
| =item $message - The message to put inthe log file. |
=item $request - The current request operation. |
| |
|
| |
=item $message - The message to put in the log file. |
| |
|
| =back |
=back |
| |
|
| Returns: |
Returns: |
| nothing. |
nothing. |
| |
|
| =cut |
=cut |
| |
|
| sub Debug { |
sub Debug { |
| |
# Put out the indicated message but only if DEBUG is true. |
| # Marshall the parameters. |
if ($DEBUG) { |
| |
my ($r,$message) = @_; |
| my $r = shift; |
$r->log_reason($message); |
| my $log = $r->log; |
} |
| my $message = shift; |
} |
| |
|
| # Put out the indicated message butonly if DEBUG is false. |
sub done { |
| |
my ($destfn) = @_; |
| if ($DEBUG) { |
return |
| $log->debug($message); |
'<p>' |
| } |
.&Apache::lonhtmlcommon::confirm_success(&mt("Done")) |
| |
.'<br /><a href="'.&url($destfn).'">'.&mt("Continue").'</a>' |
| |
.'<script type="text/javascript">' |
| |
.'location.href="'.&url($destfn,'js').'";' |
| |
.'</script>' |
| |
.'</p>'; |
| } |
} |
| |
|
| =pod |
=pod |
|
Line 137 sub Debug {
|
Line 125 sub Debug {
|
| =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 146 sub Debug {
|
Line 134 sub Debug {
|
| =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 corresponing file system path. |
=item The corresponding file system path. |
| |
|
| =back |
=back |
| |
|
|
Line 168 Global References
|
Line 156 Global References
|
| =cut |
=cut |
| |
|
| sub URLToPath { |
sub URLToPath { |
| my $Url = shift; |
my $Url = shift; |
| &Debug($r, "UrlToPath got: $Url"); |
&Debug($r, "UrlToPath got: $Url"); |
| $Url=~ s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; |
$Url=~ s{^https?\://[^/]+}{}; |
| $Url=~ s/^http\:\/\/[^\/]+//; |
$Url=~ s{//+}{/}g; |
| &Debug($r, "Returning $Url \n"); |
$Url=~ s{^/}{}; |
| return $Url; |
$Url=$Apache::lonnet::perlvar{'lonDocRoot'}."/$Url"; |
| |
&Debug($r, "Returning $Url \n"); |
| |
return $Url; |
| } |
} |
| |
|
| =pod |
sub url { |
| |
my ($fn,$context) = @_; |
| =item PublicationPath($domain, $user, $dir, $file) |
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
| |
$fn=~ s/^\Q$londocroot\E//; |
| Determines the filesystem path corersponding to a published resource |
$fn=~s{/\./}{/}g; |
| specification. The returned value is the path. |
if ($context eq 'js') { |
| Parameters: |
&js_escape(\$fn); |
| |
} else { |
| =over 4 |
$fn=&HTML::Entities::encode($fn,'\'<>"&'); |
| |
} |
| =item $domain - string [in] Name of the domain within which the resource is |
return $fn; |
| stored. |
|
| |
|
| =item $user - string [in] Name of the user asking about the resource. |
|
| |
|
| =item $dir - Directory pathr elatvie to the top of the resource space0 |
|
| |
|
| =item $file - name of the resource file itself without path info. |
|
| |
|
| =back |
|
| |
|
| =over 4 |
|
| |
|
| Returns: |
|
| |
|
| =item string - full path to the file if it exists in publication space. |
|
| |
|
| =back |
|
| |
|
| =cut |
|
| |
|
| sub PublicationPath |
|
| { |
|
| my ($domain, $user, $dir, $file)=@_; |
|
| |
|
| return '/home/httpd/html/res/'.$domain.'/'.$user.'/'.$dir.'/'. |
|
| $file; |
|
| } |
} |
| |
|
| =pod |
sub display { |
| |
my $fn=shift; |
| =item ConstructionPath($domain, $user, $dir, $file) |
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
| |
$fn=~s/^\Q$londocroot\E//; |
| Determines the filesystem path corersponding to a construction space |
$fn=~s{/\./}{/}g; |
| resource specification. The returned value is the path |
return '<span class="LC_filename">'.$fn.'</span>'; |
| Parameters: |
|
| |
|
| =over 4 |
|
| |
|
| =item $user - string [in] Name of the user asking about the resource. |
|
| |
|
| =item $dir - Directory path relatvie to the top of the resource space |
|
| |
|
| =item $file - name of the resource file itself without path info. |
|
| |
|
| Returns: |
|
| |
|
| =item string - full path to the file if it exists in Construction space. |
|
| |
|
| =back |
|
| |
|
| =cut |
|
| |
|
| sub ConstructionPath { |
|
| my ($user, $dir, $file) = @_; |
|
| |
|
| return '/home/'.$user.'/public_html/'.$dir.'/'.$file; |
|
| |
|
| } |
} |
| =pod |
|
| |
|
| =item ConstructionPathFromRelative($user, $relname) |
|
| |
|
| Determines the path to a construction space file given |
|
| the username and the path relative to the root of construction space. |
|
| |
|
| Parameters: |
|
| |
|
| =over 4 |
|
| |
|
| =item $user - string [in] Name of the user in whose construction space the |
|
| file [will] live. |
|
| |
|
| =item $relname - string[in] Path to the file relative to the root of the |
|
| construction space. |
|
| |
|
| =back |
|
| |
|
| Returns: |
|
| |
|
| =over 4 |
|
| |
|
| =item string - Full path to the file. |
|
| |
|
| =back |
|
| |
|
| =cut |
# see if the file is |
| |
# a) published (return 0 if not) |
| sub ConstructionPathFromRelative { |
# b) if, so obsolete (return 0 if not) |
| |
|
| my ($user, $relname) = @_; |
sub obsolete_unpub { |
| return '/home/'.$user.'/public_html'.$relname; |
my ($user,$domain,$construct)=@_; |
| |
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
| |
my $published=$construct; |
| |
$published=~s{^\Q$londocroot/priv/\E}{$londocroot/res/}; |
| |
if (-e $published) { |
| |
if (&Apache::lonnet::metadata($published,'obsolete')) { |
| |
return 1; |
| |
} |
| |
return 0; |
| |
} else { |
| |
return 1; |
| |
} |
| |
} |
| |
|
| |
# see if directory is empty |
| |
# ignores any .meta, .save, .bak, and .log files created for a previously |
| |
# published file, which has since been marked obsolete and deleted. |
| |
# ignores a .DS_Store file put there when viewing directory via webDAV on MacOS. |
| |
sub empty_directory { |
| |
my ($dirname,$phase) = @_; |
| |
if (opendir DIR, $dirname) { |
| |
my @files = grep(!/^\.\.?$/, readdir(DIR)); # ignore . and .. |
| |
if (@files) { |
| |
my @orphans = grep(/\.(meta|save|log|bak|DS_Store)$/,@files); |
| |
if (scalar(@files) - scalar(@orphans) > 0) { |
| |
return 0; |
| |
} else { |
| |
if (($phase eq 'Delete2') && (@orphans > 0)) { |
| |
foreach my $file (@orphans) { |
| |
if ($file =~ /\.(meta|save|log|bak)$/) { |
| |
unlink($dirname.$file); |
| |
} |
| |
} |
| |
} |
| |
} |
| |
} |
| |
closedir(DIR); |
| |
return 1; |
| |
} |
| |
return 0; |
| } |
} |
| |
|
| =pod |
=pod |
| |
|
| =item exists($user, $domain, $directory, $file) |
=item exists($user, $domain, $file) |
| |
|
| Determine if a resource file name has been publisehd or exists |
Determine if a resource filename has been published or exists |
| in the construction space. |
in the construction space. |
| |
|
| Parameters: |
Parameters: |
| |
|
| =over 4 |
=over 4 |
| |
|
| =item $user - string [in] - Name of the user for which to check. |
=item $user - string [in] - Name of the user for which to check. |
| |
|
| =item $domain - string [in] - Name of the domain in which the resource |
=item $domain - string [in] - Name of the domain in which the resource |
| might have been published. |
might have been published. |
| |
|
| =item $dir - string [in] - Path relative to construction or resource space |
=item $file - string [in] - Name of the file. |
| in which the resource might live. |
|
| |
|
| =item $file - string [in] - Name of the file. |
=item $creating - string [in] - optional, type of object being created, |
| |
either 'directory' or 'file'. Defaults to |
| |
'file' if unspecified. |
| |
|
| =back |
=back |
| |
|
|
Line 308 Returns:
|
Line 263 Returns:
|
| |
|
| =over 4 |
=over 4 |
| |
|
| |
=item string - Either undef, 'warning' or 'error' depending on the |
| |
type of problem |
| |
|
| =item string - Either where the resource exists as an html string that can |
=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 |
| |
|
| sub exists { |
sub exists { |
| my ($user, $domain, $dir, $file) = @_; |
my ($user, $domain, $construct, $creating) = @_; |
| |
$creating ||= 'file'; |
| |
|
| # Create complete paths in publication and construction space. |
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
| |
my $published=$construct; |
| my $published = &PublicationPath($domain, $user, $dir, $file); |
$published=~s{^\Q$londocroot/priv/\E}{$londocroot/res/}; |
| my $construct = &ConstructionPath($user, $dir, $file); |
my ($type,$result); |
| |
if ( -d $construct ) { |
| # If the resource exists in either space indicate this fact. |
return ('error','<p class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</p>'); |
| # Note that the check for existence in resource space is stricter. |
|
| |
} |
| |
|
| my $result; |
if ( -e $published) { |
| if ( -e $published) { |
if ( -e $construct ) { |
| $result.='<p><font color=red>Warning: target file exists, and has been published!</font></p>'; |
$type = 'warning'; |
| } |
$result.='<p class="LC_warning">'.&mt('Warning: target file exists, and has been published!').'</p>'; |
| elsif ( -e $construct) { |
} else { |
| $result.='<p><font color=red>Warning: target file exists!</font></p>'; |
my $published_type = (-d $published) ? 'directory' : 'file'; |
| } |
|
| |
|
| return $result; |
if ($published_type eq $creating) { |
| |
$type = 'warning'; |
| |
$result.='<p class="LC_warning">'.&mt("Warning: a published $published_type of this name exists.").'</p>'; |
| |
} else { |
| |
$type = 'error'; |
| |
$result.='<p class="LC_error">'.&mt("Error: a published $published_type of this name exists.").'</p>'; |
| |
} |
| |
} |
| |
} elsif ( -e $construct) { |
| |
$type = 'warning'; |
| |
$result.='<p class="LC_warning">'.&mt('Warning: target file exists!').'</p>'; |
| |
} |
| |
|
| |
return ($type,$result); |
| } |
} |
| |
|
| =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 360 as a result of this operation.
|
Line 331 as a result of this operation.
|
| |
|
| =over 4 |
=over 4 |
| |
|
| =item Empty string if everythikng worked. |
=item Empty string if everything worked. |
| |
|
| =item String containing an error message if there was a problem. |
=item String containing an error message if there was a problem. |
| |
|
|
Line 375 sub checksuffix {
|
Line 346 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>Warning: change of MIME type!</font></p>'; |
'<p class="LC_warning">'.&mt('Warning: change of MIME type!').'></p>'; |
| } |
} |
| return $result; |
return $result; |
| } |
} |
| |
|
| |
sub cleanDest { |
| |
my ($dest,$subdir,$fn,$uname,$udom)=@_; |
| |
#remove bad characters |
| |
my $foundbad=0; |
| |
my $warnings; |
| |
my $error=''; |
| |
if ($subdir && $dest =~/\./) { |
| |
$foundbad=1; |
| |
$dest=~s/\.//g; |
| |
} |
| |
$dest =~ s/(\s+$|^\s+)//g; |
| |
if ($dest=~/[\#\?&%\":]/) { |
| |
$foundbad=1; |
| |
$dest=~s/[\#\?&%\":]//g; |
| |
} |
| |
if ($dest=~m|/|) { |
| |
my ($newpath)=($dest=~m|(.*)/|); |
| |
($newpath,$error)=&relativeDest($fn,$newpath,$uname,$udom); |
| |
if (! -d "$newpath") { |
| |
$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." |
| |
,&display($newpath)) |
| |
.'</p>'; |
| |
$dest=~s|.*/||; |
| |
} |
| |
} |
| |
if ($dest =~ /\.(\d+)\.(\w+)$/) { |
| |
$warnings .= '<p class="LC_warning">' |
| |
.&mt('Bad filename [_1]',&display($dest)) |
| |
.'<br />' |
| |
.&mt('[_1](name).(number).(extension)[_2] not allowed.','<tt>','</tt>') |
| |
.'<br />' |
| |
.&mt('Removing the [_1].number.[_2] from requested filename.','<tt>','</tt>') |
| |
.'</p>'; |
| |
$dest =~ s/\.(\d+)(\.\w+)$/$2/; |
| |
} |
| |
if ($foundbad) { |
| |
$warnings .= '<p class="LC_warning">' |
| |
.&mt('Invalid characters in requested name have been removed.') |
| |
.'</p>'; |
| |
} |
| |
return ($dest,$error,$warnings); |
| |
} |
| |
|
| |
sub relativeDest { |
| |
my ($fn,$newfilename,$uname,$udom)=@_; |
| |
my $error = ''; |
| |
if ($newfilename=~/^\//) { |
| |
# absolute, simply add path |
| |
my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; |
| |
$newfilename="$londocroot/res/$udom/$uname/"; |
| |
} else { |
| |
my $dir=$fn; |
| |
$dir=~s{/[^/]+$}{}; |
| |
$newfilename=$dir.'/'.$newfilename; |
| |
} |
| |
$newfilename=~s{//+}{/}g; # remove duplicate / |
| |
while ($newfilename=~m{/\.\./}) { |
| |
$newfilename=~ s{/[^/]+/\.\./}{/}g; #remove dir/.. |
| |
} |
| |
my ($authorname,$authordom)=&Apache::lonnet::constructaccess($newfilename); |
| |
unless (($authorname) && ($authordom)) { |
| |
my $otherdir = &display($newfilename); |
| |
$error = &mt('Access denied to [_1]',$otherdir); |
| |
} |
| |
return ($newfilename,$error); |
| |
} |
| |
|
| =pod |
=pod |
| |
|
| =item CloseForm1($request, $user, $file) |
=item CloseForm1($request, $user, $file) |
|
Line 400 Parameters:
|
Line 440 Parameters:
|
| =cut |
=cut |
| |
|
| sub CloseForm1 { |
sub CloseForm1 { |
| my ($request, $cancelurl) = @_; |
my ($request, $fn) = @_; |
| |
$request->print('<input type="submit" value="'.&mt('Continue').'" /></form>'); |
| |
$request->print(' <form action="'.&url($fn).'" method="post">'. |
| &Debug($request, "Cancel url is: ".$cancelurl); |
'<input type="submit" value="'.&mt('Cancel').'" /></form>'); |
| $request->print('<p><input type=submit value=Continue></p></form>'); |
|
| $request->print('<form action="'.$cancelurl. |
|
| '" method=GET"><p><input type=submit value=Cancel><p></form>'); |
|
| |
|
| } |
} |
| |
|
| |
|
|
Line 427 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 436 Parameters:
|
Line 472 Parameters:
|
| =cut |
=cut |
| |
|
| sub CloseForm2 { |
sub CloseForm2 { |
| my ($request, $user, $directory) = @_; |
my ($request, $user, $fn) = @_; |
| |
$request->print(&done($fn)); |
| $request->print('<h3><a=href="/priv/'.$user.$directory.'/">Done </a> </h3>'); |
|
| } |
} |
| |
|
| =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 474 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, $filename, $user, $domain, $dir) = @_; |
my ($request, $user, $domain, $fn, $newfilename, $style) = @_; |
| &Debug($request, "Username - ".$user." filename: ".$filename."\n"); |
|
| my $conspace = $filename; |
if(-e $fn) { |
| |
if($newfilename) { |
| my $cancelurl = "/priv/".$filename; |
# is dest a dir |
| $cancelurl =~ s/\/home\///; |
if ($style eq 'move') { |
| $cancelurl =~ s/\/public_html//; |
if (-d $newfilename) { |
| |
if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; } |
| if(-e $conspace) { |
} |
| if($ENV{'form.newfilename'}) { |
} |
| my $newfilename = $ENV{'form.newfilename'}; |
if ($newfilename =~ m|/[^\.]+$|) { |
| $request->print(&checksuffix($filename, $newfilename)); |
#no extension add on original extension |
| $request->print(&exists($user, $domain, $dir, $newfilename)); |
if ($fn =~ m|/[^\.]*\.([^\.]+)$|) { |
| $request->print('<input type=hidden name=newfilename value="'. |
$newfilename.='.'.$1; |
| $newfilename. |
} |
| '"><p>Rename <tt>'.$filename.'</tt> to <tt>'. |
} |
| $dir.'/'.$newfilename.'</tt>?</p>'); |
$request->print(&checksuffix($fn, $newfilename)); |
| &CloseForm1($request, $cancelurl); |
#renaming a dir, delete the trailing / |
| |
#remove second to last element for current dir |
| |
if (-d $fn) { |
| |
$newfilename=~/\.(\w+)$/; |
| |
if (&Apache::loncommon::fileembstyle($1) eq 'ssi') { |
| |
$request->print('<p><span class="LC_error">'. |
| |
&mt('Cannot change MIME type of a directory.'). |
| |
'</span>'. |
| |
'<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>'); |
| |
return; |
| |
} |
| |
$newfilename=~s/\/[^\/]+\/([^\/]+)$/\/$1/; |
| |
} |
| |
$newfilename=~s://+:/:g; # remove duplicate / |
| |
while ($newfilename=~m:/\.\./:) { |
| |
$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/.. |
| |
} |
| |
my ($type, $return)=&exists($user, $domain, $newfilename); |
| |
$request->print($return); |
| |
if ($type eq 'error') { |
| |
$request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>'); |
| |
return; |
| |
} |
| |
unless (&obsolete_unpub($user,$domain,$fn)) { |
| |
$request->print('<p><span class="LC_error">' |
| |
.&mt('Cannot rename or move non-obsolete published file.') |
| |
.'</span><br />' |
| |
.'<a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>' |
| |
); |
| |
return; |
| |
} |
| |
my $action; |
| |
if ($style eq 'rename') { |
| |
$action='Rename'; |
| |
} else { |
| |
$action='Move'; |
| |
} |
| |
$request->print('<input type="hidden" name="newfilename" value="' |
| |
.$newfilename.'" />' |
| |
.'<p>' |
| |
.&mt($action.' [_1] to [_2]?', |
| |
&display($fn), |
| |
&display($newfilename)) |
| |
.'</p>' |
| |
); |
| |
&CloseForm1($request, $fn); |
| } else { |
} else { |
| $request->print('<p>No new filename specified</p></form>'); |
$request->print('<p class="LC_error">'.&mt('No new filename specified.').'</p></form>'); |
| return; |
return; |
| } |
} |
| } else { |
} else { |
| $request->print('<p> No such File </p> </form>'); |
$request->print('<p class="LC_error">' |
| |
.&mt('No such file: [_1]', |
| |
&display($fn)) |
| |
.'</p></form>' |
| |
); |
| return; |
return; |
| } |
} |
| |
|
| } |
} |
| |
|
| =pod |
=pod |
| |
|
| =item Delete1 |
=item Delete1 |
|
Line 519 Parameters:
|
Line 604 Parameters:
|
| =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 session user. |
=item $user - string [in] Name of the user initiating the request. |
| |
|
| |
=item $domain - string [in] Domain the initiating user is logged in as |
| |
|
| =item $filename - string [in] Name fo the file to be deleted: |
=item $filename - string [in] Source filename. |
| Filename is the full filesystem path to the file. |
|
| |
|
| =back |
=back |
| |
|
| =cut |
=cut |
| |
|
| sub Delete1 { |
sub Delete1 { |
| my ($request, $user, $filename) = @_; |
my ($request, $user, $domain, $fn) = @_; |
| |
|
| my $cancelurl = '/priv/'.$filename; |
if( -e $fn) { |
| $cancelurl =~ s/\/home\///; |
$request->print('<input type="hidden" name="newfilename" value="'. |
| $cancelurl =~ s/\/public_html//; |
$fn.'" />'); |
| |
if (-d $fn) { |
| |
unless (&empty_directory($fn,'Delete1')) { |
| if( -e $filename) { |
$request->print('<p>' |
| $request->print('<input type=hidden name=newfilename value="'. |
.'<span class="LC_error">' |
| $filename.'">'); |
.&mt('Only empty directories may be deleted.') |
| $request->print('<p> Delete <tt>'.$filename.'</tt>?</p>'); |
.'</span><br />' |
| &CloseForm1($request, $cancelurl); |
.&mt('You must delete the contents of the directory first.') |
| } else { |
.'</p>' |
| $request->print('<p> No Such file: <tt>'.$filename.'</tt></p></form>'); |
.'<p><a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>' |
| } |
); |
| |
return; |
| |
} |
| |
} else { |
| |
unless (&obsolete_unpub($user,$domain,$fn)) { |
| |
$request->print('<p><span class="LC_error">' |
| |
.&mt('Cannot delete non-obsolete published file.') |
| |
.'</span><br />' |
| |
.'<a href="'.&url($fn).'">'.&mt('Cancel').'</a></p>' |
| |
); |
| |
return; |
| |
} |
| |
} |
| |
$request->print('<p>' |
| |
.&mt('Delete [_1]?', |
| |
&display($fn)) |
| |
.'</p>' |
| |
); |
| |
&CloseForm1($request, $fn); |
| |
} else { |
| |
$request->print('<p class="LC_error">' |
| |
.&mt('No such file: [_1]', |
| |
&display($fn)) |
| |
.'</p></form>' |
| |
); |
| |
} |
| } |
} |
| |
|
| =pod |
=pod |
|
Line 552 sub Delete1 {
|
Line 662 sub Delete1 {
|
| =item Copy1($request, $user, $domain, $filename, $newfilename) |
=item Copy1($request, $user, $domain, $filename, $newfilename) |
| |
|
| Performs phase 1 processing of the construction space copy command. |
Performs phase 1 processing of the construction space copy command. |
| Ensure that the source fil eexists. Ensure that a destination exists, |
Ensure that the source file exists. Ensure that a destination exists, |
| also warn if the detination already exists. |
also warn if the destination already exists. |
| |
|
| Parameters: |
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. |
| |
|
| =item $domain - string [in] Domain the initiating user is logged in as |
=item $domain - string [in] Domain the initiating user is logged in as |
| |
|
| =item $dir - string [in] Directory path. |
=item $fn - string [in] Source filename. |
| |
|
| =item $filename - string [in] Source filename. |
|
| |
|
| =item $newfilename-string [in] Destination filename. |
=item $newfilename-string [in] Destination filename. |
| |
|
|
Line 577 Parameters:
|
Line 685 Parameters:
|
| =cut |
=cut |
| |
|
| sub Copy1 { |
sub Copy1 { |
| my ($request, $user, $domain, $dir, $filename, $newfilename) = @_; |
my ($request, $user, $domain, $fn, $newfilename) = @_; |
| |
|
| my $cancelurl = "/priv/".$filename; |
if(-e $fn) { |
| $cancelurl =~ s/\/home\///; |
# is dest a dir |
| $cancelurl =~ s/\/public_html//; |
if (-d $newfilename) { |
| |
if ($fn =~ m|/([^/]*)$|) { $newfilename .= '/'.$1; } |
| |
} |
| |
if ($newfilename =~ m|/[^\.]+$|) { |
| if(-e $filename) { |
#no extension add on original extension |
| $request->print(&checksuffix($filename,$newfilename)); |
if ($fn =~ m|/[^\.]*\.([^\.]+)$|) { $newfilename.='.'.$1; } |
| $request->print(&exists($user, $domain, $dir, $newfilename)); |
} |
| $request->print('<input type = hidden name = newfilename value = "'. |
$newfilename=~s://+:/:g; # remove duplicate / |
| $dir.'/'.$newfilename. |
while ($newfilename=~m:/\.\./:) { |
| '"><p>Copy <tt>'.$filename.'</tt> to'. |
$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/.. |
| '<tt>'.$dir.'/'.$newfilename.'</tt>/?</p>'); |
} |
| &CloseForm1($request, $cancelurl); |
$request->print(&checksuffix($fn,$newfilename)); |
| } else { |
my ($type,$return)=&exists($user, $domain, $newfilename); |
| $request->print('<p>No such file <tt>'.$filename.'</p></form>'); |
$request->print($return); |
| } |
if ($type eq 'error') { |
| |
$request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a></form>'); |
| |
return; |
| |
} |
| |
# Check if there is enough space. |
| |
my @fileinfo = stat($fn); |
| |
my ($dir,$fname) = ($fn =~ m{^(.+/)([^/]+)$}); |
| |
my $filesize = $fileinfo[7]; |
| |
$filesize = int($filesize/1000); #expressed in kb |
| |
my $output = &Apache::loncommon::excess_filesize_warning($user,$domain,'author', |
| |
$fname,$filesize,'copy'); |
| |
if ($output) { |
| |
$request->print($output.'<br /><a href="'.&url($dir).'">'.&mt('Cancel').'</a></form>'); |
| |
return; |
| |
} |
| |
$request->print( |
| |
'<input type="hidden" name="newfilename"' |
| |
.' value="'.$newfilename.'" />' |
| |
.'<p>' |
| |
.&mt('Copy [_1] to [_2]?', |
| |
&display($fn), |
| |
&display($newfilename)) |
| |
.'</p>' |
| |
); |
| |
&CloseForm1($request, $fn); |
| |
} else { |
| |
$request->print('<p class="LC_error">' |
| |
.&mt('No such file: [_1]', |
| |
&display($fn)) |
| |
.'</p></form>' |
| |
); |
| |
} |
| } |
} |
| |
|
| =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 611 Parameters:
|
Line 750 Parameters:
|
| =over 4 |
=over 4 |
| |
|
| =item $request - Apache Request Object [in] - Server request object for the |
=item $request - Apache Request Object [in] - Server request object for the |
| current url.. |
current url. |
| |
|
| =item $username - Name of the user that is requesting the directory creation. |
=item $username - Name of the user that is requesting the directory creation. |
| |
|
| =item $path - current directory relative to construction spacee. |
=item $domain - Domain user is in |
| |
|
| |
=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 635 causes the newdir operation to transitio
|
Line 776 causes the newdir operation to transitio
|
| =cut |
=cut |
| |
|
| |
|
| sub NewDir1 |
sub NewDir1 { |
| { |
my ($request, $username, $domain, $fn, $newfilename, $mode) = @_; |
| my ($request, $username, $path, $newdir) = @_; |
|
| |
my ($type, $result)=&exists($username,$domain,$newfilename,'directory'); |
| my $fullpath = '/home/'.$username.'/public_html/'. |
$request->print($result); |
| $path.'/'.$newdir; |
if ($type eq 'error') { |
| |
$request->print('</form>'); |
| my $cancelurl = '/priv/'.$username.'/'.$path; |
} else { |
| |
if (($mode eq 'testbank') || ($mode eq 'imsimport')) { |
| &Debug($request, "Full path is : ".$fullpath); |
$request->print('<input type="hidden" name="callingmode" value="'.$mode.'" />'."\n". |
| |
'<input type="hidden" name="inhibitmenu" value="yes" />'); |
| if(-e $fullpath) { |
} |
| $request->print('<p>Directory exists.</p></form>'); |
$request->print('<input type="hidden" name="newfilename" value="' |
| } |
.$newfilename.'" />' |
| else { |
.'<p>' |
| $request->print('<input type=hidden name=newfilename value="'. |
.&mt('Make new directory [_1]?', |
| $newdir.'"><p>Make new directory <tt>'. |
&display($newfilename)) |
| $path."/".$newdir.'</tt>?</p>'); |
.'</p>' |
| &CloseForm1($request, $cancelurl); |
); |
| |
&CloseForm1($request, $fn); |
| |
} |
| |
} |
| |
|
| |
|
| |
sub Decompress1 { |
| |
my ($request, $user, $domain, $fn) = @_; |
| |
if( -e $fn) { |
| |
$request->print('<input type="hidden" name="newfilename" value="'.$fn.'" />'); |
| |
$request->print('<p>' |
| |
.&mt('Decompress [_1]?', |
| |
&display($fn)) |
| |
.'</p>' |
| |
); |
| |
&CloseForm1($request, $fn); |
| |
} else { |
| |
$request->print('<p class="LC_error">' |
| |
.&mt('No such file: [_1]', |
| |
&display($fn)) |
| |
.'</p></form>' |
| |
); |
| |
} |
| |
} |
| |
|
| |
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,%defaults); |
| |
my ($compstyle,$canarchive,$cancompress,$numformat,$numcompress,$defext) = |
| |
&archive_tools(\%location_of,\%defaults); |
| |
if (!$canarchive) { |
| |
$request->print('<p class="LC_error">'. |
| |
&mt('This LON-CAPA instance does not seem to have either tar or zip installed.').'</p>'."\n". |
| |
'<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))."\n". |
| |
'</span></form>'); |
| |
} elsif (-e $fn) { |
| |
$request->print('<input type="hidden" name="adload" value="" />'."\n". |
| |
&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.'"'. |
| |
$defaults{$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.'"'. |
| |
$defaults{$compress}.' onclick="setArchiveExt(this.form);" />'. |
| |
$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>'."\n". |
| |
'<fieldset style="display:none" id="archive_saveas">'. |
| |
'<legend>'.&mt('Filename to download').'</legend>'. |
| |
'<table style="border-spacing:0"><tr><td style="padding:0;">'.&mt('Name').'<br />'."\n". |
| |
'<input type="text" name="archivefname" value="" size="8" /></td><td style="padding:0;">'. |
| |
&mt('Extension').'<br />'."\n". |
| |
'<input type="text" name="archiveext" id="archiveext" value="" size="4" readonly="readonly" />'. |
| |
'</td></tr></table></fieldset>'."\n". |
| |
&Apache::lonhtmlcommon::row_closure(1). |
| |
&Apache::lonhtmlcommon::end_pick_box().'<br />'."\n" |
| |
); |
| |
&CloseForm1($request, $fn); |
| |
} else { |
| |
$request->print('<p class="LC_error">' |
| |
.&mt('No such directory: [_1]', |
| |
&display($fn)) |
| |
.'</p></form>' |
| |
); |
| |
} |
| |
return; |
| |
} |
| |
|
| |
sub archive_tools { |
| |
my ($location_of,$defaults) = @_; |
| |
my ($compstyle,$canarchive,$cancompress,$numformat,$numcompress,$defext); |
| |
($numformat,$numcompress) = (0,0); |
| |
if ((ref($location_of) eq 'HASH') && (ref($defaults) eq 'HASH')) { |
| |
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; |
| |
} |
| |
} |
| |
} |
| |
foreach my $format ('tar','zip') { |
| |
if (exists($location_of->{$format})) { |
| |
unless ($canarchive) { |
| |
$defext = $format; |
| |
$defaults->{$format} = ' checked="checked"'; |
| |
if ($format eq 'tar') { |
| |
$compstyle = 'block'; |
| |
} else { |
| |
$compstyle = 'none'; |
| |
} |
| |
} |
| |
$canarchive = 1; |
| |
$numformat ++; |
| |
} |
| |
} |
| |
foreach my $compress ('gzip','bzip2','xz') { |
| |
if (exists($location_of->{$compress})) { |
| |
$numcompress ++; |
| |
unless ($cancompress) { |
| |
if ($defext eq 'tar') { |
| |
if ($compress eq 'gzip') { |
| |
$defext .= '.gz'; |
| |
} elsif ($compress eq 'bzip2') { |
| |
$defext .= '.bz2'; |
| |
} else { |
| |
$defext .= ".$compress"; |
| |
} |
| |
} |
| |
$defaults->{$compress} = ' checked="checked"'; |
| |
$cancompress = 1; |
| |
} |
| |
} |
| |
} |
| |
} |
| |
if (wantarray) { |
| |
return ($compstyle,$canarchive,$cancompress,$numformat,$numcompress,$defext); |
| |
} else { |
| |
return $defext; |
| |
} |
| |
} |
| |
|
| |
sub archive_in_progress { |
| |
my ($earlyout,$idnum); |
| |
if ($env{'cgi.author.archive'} =~ /^(\d+)_\d+_\d+$/) { |
| |
my $timestamp = $1; |
| |
$idnum = $env{'cgi.author.archive'}; |
| |
if (exists($env{'cgi.'.$idnum.'.archive'})) { |
| |
my $hashref = &Apache::lonnet::thaw_unescape($env{'cgi.'.$idnum.'.archive'}); |
| |
my $lonprtdir = $Apache::lonnet::perlvar{'lonPrtDir'}; |
| |
if (-e $lonprtdir.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$idnum.'.txt') { |
| |
$earlyout = $timestamp; |
| |
} elsif (ref($hashref) eq 'HASH') { |
| |
my $suffix = $hashref->{'extension'}; |
| |
if (-e $lonprtdir.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$idnum.$suffix) { |
| |
$earlyout = $timestamp; |
| |
} |
| |
} |
| |
unless ($earlyout) { |
| |
&Apache::lonnet::delenv('cgi.'.$idnum.'.archive'); |
| |
&Apache::lonnet::delenv('cgi.author.archive'); |
| |
} |
| |
} else { |
| |
&Apache::lonnet::delenv('cgi.author.archive'); |
| |
} |
| |
} |
| |
return ($earlyout,$idnum); |
| |
} |
| |
|
| |
sub cancel_archive_form { |
| |
my ($r,$title,$fname,$earlyout,$idnum) = @_; |
| |
$r->print('<h2>'.$title.'</h2>'."\n". |
| |
'<form action="/adm/cfile" method="post" onsubmit="return confirmation(this);">'."\n". |
| |
'<input type="hidden" name="filename" value="'.$fname.'" />'."\n". |
| |
'<input type="hidden" name="action" value="'.$env{'form.action'}.'" />'."\n". |
| |
'<p>'.&mt('Each author may only have one archive request in process at a time.')."\n".'<ul>'. |
| |
'<li>'.&mt('An incomplete archive request was begun: [_1].', |
| |
&Apache::lonlocal::locallocaltime($earlyout)). |
| |
'</li>'."\n". |
| |
'<li>'.&mt('An archive request is considered complete when the archive file has been successfully downloaded.').'</li>'."\n". |
| |
'<li>'. |
| |
&mt('To submit a new archive request, either wait for the existing request (e.g., in another tab/window) to complete, or remove it.').'</li>'."\n". |
| |
'</ul></p>'."\n". |
| |
'<p><span class="LC_nobreak">'.&mt('Remove existing archive request?').' '."\n". |
| |
'<label><input type="radio" name="remove_archive_request" value="'.$idnum.'" />'.&mt('Yes').'</label>'. |
| |
(' 'x2)."\n". |
| |
'<label><input type="radio" name="remove_archive_request" value="" checked="checked" />'.&mt('No').'</label></span></p>'."\n". |
| |
'<br />'); |
| |
} |
| |
|
| |
=pod |
| |
|
| |
=item NewFile1 |
| |
|
| |
Does all phase 1 processing of file creation: |
| |
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, |
| |
problem, page, or sequence, it then creates a form link to hand the |
| |
actual creation off to the proper handler. |
| |
|
| |
Parameters: |
| |
|
| |
=over 4 |
| |
|
| |
=item $request - Apache Request Object [in] - Server request object for the |
| |
current url. |
| |
|
| |
=item $username - Name of the user that is requesting the directory creation. |
| |
|
| |
=item $domain - Name of the domain of the user |
| |
|
| |
=item $fn - Source filename |
| |
|
| |
=item $newfilename |
| |
- Name of the file to be created; no path information |
| |
|
| |
=item $warnings - Information about changes to filename made by cleanDest(). |
| |
|
| |
=back |
| |
|
| |
Side Effects: |
| |
|
| |
=over 4 |
| |
|
| |
=item 2 new forms are displayed. Clicking on the confirmation button |
| |
causes the browser to attempt to load the specfied URL, allowing the |
| |
proper handler to take care of file creation. There is also a Cancel |
| |
button which returns you to the directory listing you came from |
| |
|
| |
=back |
| |
|
| |
=cut |
| |
|
| |
sub NewFile1 { |
| |
my ($request, $user, $domain, $fn, $newfilename, $warnings) = @_; |
| |
return if (&filename_check($newfilename,$warnings) ne 'ok'); |
| |
|
| |
if ($env{'form.action'} =~ /new(.+)file/) { |
| |
my $extension=$1; |
| |
if ($newfilename !~ /\Q.$extension\E$/) { |
| |
if ($newfilename =~ m|/[^/.]*\.(?:[^/.]+)$|) { |
| |
#already has an extension strip it and add in expected one |
| |
$newfilename =~ s|(/[^./])\.(?:[^.]+)$|$1|; |
| |
} |
| |
$newfilename.=".$extension"; |
| |
} |
| |
} |
| |
my ($type, $result)=&exists($user,$domain,$newfilename); |
| |
if ($type eq 'error') { |
| |
$request->print($warnings.$result); |
| |
$request->print('</form>'); |
| |
} else { |
| |
my $extension; |
| |
|
| |
if ($newfilename =~ m{[^/.]+\.([^/.]+)$}) { |
| |
$extension = $1; |
| |
} |
| |
|
| |
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))) { |
| |
my $validexts = '.'.join(', .',@okexts); |
| |
$request->print($warnings.$result); |
| |
$request->print('<p class="LC_warning">'. |
| |
&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 following are valid extensions: [_1].',$validexts). |
| |
'</p></form><p>'. |
| |
'<form name="fileaction" action="/adm/cfile" method="post">'. |
| |
'<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'. |
| |
'<input type="hidden" name="action" value="newfile" />'. |
| |
'<span class ="LC_nobreak">'.&mt('Enter a filename: ').'<input type="text" name="newfilename" value="Type Name Here" onfocus="if (this.value == '."'Type Name Here') this.value=''".'" /> <input type="submit" value="Go" />'. |
| |
'</span></form></p>'. |
| |
'<p><form action="'.&url($fn). |
| |
'" method="post"><p><input type="submit" value="'.&mt('Cancel').'" /></form></p>'); |
| |
} 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>'); |
| |
} |
| |
} |
| |
return; |
| |
} |
| |
|
| } |
sub filename_check { |
| |
my ($newfilename) = @_; |
| |
##Informs User (name).(number).(extension) not allowed |
| |
if($newfilename =~ /\.(\d+)\.(\w+)$/){ |
| |
$r->print('<span class="LC_error">'.$newfilename. |
| |
' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').') '. |
| |
' '.&mt('Not Allowed').'</span>'); |
| |
return; |
| |
} |
| |
if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){ |
| |
$r->print('<span class="LC_error">'.$newfilename. |
| |
' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '. |
| |
' '.&mt('Not Allowed').'</span>'); |
| |
return; |
| |
} |
| |
return 'ok'; |
| } |
} |
| |
|
| =pod |
=pod |
|
Line 666 sub NewDir1
|
Line 1162 sub NewDir1
|
| 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 675 performed and reported to the user.
|
Line 1171 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 nmae under which the user logged in. |
=item $udom - string [in] Domain name under which the user logged in. |
| |
|
| =back |
=back |
| |
|
| =cut |
=cut |
| |
|
| sub phaseone { |
sub phaseone { |
| my ($r,$fn,$uname,$udom)=@_; |
my ($r,$fn,$uname,$udom)=@_; |
| |
|
| $fn=~m:(.*)/([^/]+)\.(\w+)$:; |
my $doingdir=0; |
| my $dir=$1; |
if ($env{'form.action'} eq 'newdir') { $doingdir=1; } |
| my $main=$2; |
my ($newfilename,$error,$warnings) = |
| my $suffix=$3; |
&cleanDest($env{'form.newfilename'},$doingdir,$fn,$uname,$udom); |
| |
unless ($error) { |
| # my $conspace=ConstructionPathFromRelative($uname, $fn); |
($newfilename,$error)=&relativeDest($fn,$newfilename,$uname,$udom); |
| |
} |
| |
if ($error) { |
| $r->print('<form action=/adm/cfile method=post>'. |
my $dirlist; |
| '<input type=hidden name=filename value="/~'.$uname.$fn.'">'. |
if ($fn=~m{^(.*/)[^/]+$}) { |
| '<input type=hidden name=phase value=two>'. |
$dirlist=$1; |
| '<input type=hidden name=action value='.$ENV{'form.action'}.'>'); |
} else { |
| |
$dirlist=$fn; |
| if ($ENV{'form.action'} eq 'rename') { |
} |
| |
if ($warnings) { |
| &Rename1($r, $fn, $uname, $udom, $dir); |
$r->print($warnings); |
| |
} |
| } elsif ($ENV{'form.action'} eq 'delete') { |
$r->print('<div class="LC_error">'.$error.'</div>'. |
| |
'<p><a href="'.&url($dirlist).'">'.&mt('Return to Directory'). |
| &Delete1($r, $uname, $fn); |
'</a></p>'); |
| |
return; |
| } elsif ($ENV{'form.action'} eq 'copy') { |
} |
| if($ENV{'form.newfilename'}) { |
$r->print('<form action="/adm/cfile" method="post" name="phaseone">'."\n". |
| my $newfilename = $ENV{'form.newfilename'}; |
'<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'."\n". |
| &Copy1($r, $uname, $udom, $dir, $fn, $newfilename); |
'<input type="hidden" name="phase" value="two" />'."\n". |
| }else { |
'<input type="hidden" name="action" value="'.$env{'form.action'}.'" />'."\n"); |
| $r->print('<p>No new filename specified.</p></form>'); |
|
| } |
if ($env{'form.action'} eq 'newfile' || |
| } elsif ($ENV{'form.action'} eq 'newdir') { |
$env{'form.action'} eq 'newhtmlfile' || |
| &NewDir1($r, $uname, $dir, $ENV{'form.newfilename'}); |
$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'); |
| |
if (($newfilename!~/\/$/) && ($newfilename!~/$empty$/)) { |
| |
&NewFile1($r, $uname, $udom, $fn, $newfilename, $warnings); |
| |
} else { |
| |
if ($warnings) { |
| |
$r->print($warnings); |
| |
} |
| |
$r->print('<p class="LC_error">' |
| |
.&mt('No new filename specified.') |
| |
.'</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') { |
| |
if (($uname eq $env{'user.name'}) && ($udom eq $env{'user.domain'})) { |
| |
&Archive1($r,$fn); |
| |
} else { |
| |
$r->print('<p class="LC_error">' |
| |
.&mt('Archiving of Authoring Spaces is only permitted by Author') |
| |
.'</p></form>' |
| |
); |
| |
} |
| |
} 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); |
| |
} |
| |
} |
| } |
} |
| |
|
| =pod |
=pod |
| |
|
| =item Rename2($request, $user, $directory, $oldfile, $newfile) |
=item Rename2($request, $user, $directory, $oldfile, $newfile) |
| |
|
| Performs phase 2 procesing of a rename reequest. This is where the |
Performs phase 2 processing of a rename reequest. This is where the |
| actual rename is performed. |
actual rename is performed. |
| |
|
| Parameters |
Parameters |
|
Line 759 Returns:
|
Line 1310 Returns:
|
| |
|
| sub Rename2 { |
sub Rename2 { |
| |
|
| my ($request, $user, $directory, $oldfile, $newfile) = @_; |
my ($request, $user, $directory, $oldfile, $newfile) = @_; |
| |
|
| &Debug($request, "Rename2 directory: ".$directory." old file: ".$oldfile. |
&Debug($request, "Rename2 directory: ".$directory." old file: ".$oldfile. |
| " new file ".$newfile."\n"); |
" new file ".$newfile."\n"); |
| &Debug($request, "Target is: ".$directory.'/'. |
&Debug($request, "Target is: ".$directory.'/'. |
| $newfile); |
$newfile); |
| |
if (-e $oldfile) { |
| if(-e $oldfile) { |
|
| unless(rename($oldfile, |
my $oRN=$oldfile; |
| $directory.'/'.$newfile)) { |
my $nRN=$newfile; |
| $request->print('<font color=red>Error: '.$!.'</font>'); |
unless (rename($oldfile,$newfile)) { |
| return 0; |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
| } else {} |
return 0; |
| } else { |
} |
| $request->print("<p> No such file: /home".$user.'/public_html'. |
## If old name.(extension) exits, move under new name. |
| $oldfile.' </p></form>'); |
## If it doesn't exist and a new.(extension) exists |
| return 0; |
## delete it (only concern when renaming over files) |
| } |
my $tmp1=$oRN.'.meta'; |
| return 1; |
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 class="LC_error">' |
| |
.&mt('No such file: [_1]', |
| |
&display($oldfile)) |
| |
.'</p></form>' |
| |
); |
| |
return 0; |
| |
} |
| |
return 1; |
| } |
} |
| |
|
| =pod |
=pod |
| |
|
| =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 797 Parameters:
|
Line 1385 Parameters:
|
| =item $user - string [in] The name of the user initiating the delete |
=item $user - string [in] The name of the user initiating the delete |
| request. |
request. |
| |
|
| =item $filename - string [in] The name of the file, relative to construction space, |
=item $filename - string [in] The name of the file, relative to construction |
| to delete. |
space, to delete. |
| |
|
| =back |
=back |
| |
|
|
Line 809 Returns:
|
Line 1397 Returns:
|
| =cut |
=cut |
| |
|
| sub Delete2 { |
sub Delete2 { |
| my ($request, $user, $filename) = @_; |
my ($request, $user, $filename) = @_; |
| |
if (-d $filename) { |
| if(-e $filename) { |
unless (&empty_directory($filename,'Delete2')) { |
| unless(unlink($filename)) { |
$request->print('<span class="LC_error">'.&mt('Error: Directory Non Empty').'</span>'); |
| $request->print('<font color=red>Error: '.$!.'</font>'); |
return 0; |
| return 0; |
} else { |
| |
if(-e $filename) { |
| |
unless(rmdir($filename)) { |
| |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
| |
return 0; |
| |
} |
| |
} else { |
| |
$request->print('<p class="LC_error">'.&mt('No such file').'</p></form>'); |
| |
return 0; |
| |
} |
| |
} |
| |
} else { |
| |
if(-e $filename) { |
| |
unless(unlink($filename)) { |
| |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
| |
return 0; |
| |
} |
| |
} else { |
| |
$request->print('<p class="LC_error">'.&mt('No such file').'</p></form>'); |
| |
return 0; |
| |
} |
| } |
} |
| } else { |
return 1; |
| $request->print('<p> No such file. </form'); |
|
| return 0; |
|
| } |
|
| return 1; |
|
| } |
} |
| |
|
| =pod |
=pod |
| |
|
| =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 847 sub Delete2 {
|
Line 1451 sub Delete2 {
|
| |
|
| =back |
=back |
| |
|
| Returns 0 failure, and 0 successs. |
Returns 0 failure, and 1 successs. |
| |
|
| =cut |
=cut |
| |
|
|
Line 855 sub Copy2 {
|
Line 1459 sub Copy2 {
|
| my ($request, $username, $dir, $oldfile, $newfile) = @_; |
my ($request, $username, $dir, $oldfile, $newfile) = @_; |
| &Debug($request ,"Will try to copy $oldfile to $newfile"); |
&Debug($request ,"Will try to copy $oldfile to $newfile"); |
| if(-e $oldfile) { |
if(-e $oldfile) { |
| |
if ($oldfile eq $newfile) { |
| |
$request->print('<span class="LC_error">'.&mt('Warning').': '.&mt('Name of new file is the same as name of old file').' - '.&mt('no action taken').'.</span>'); |
| |
return 1; |
| |
} |
| unless (copy($oldfile, $newfile)) { |
unless (copy($oldfile, $newfile)) { |
| $request->print('<font color=red> copy Error: '.$!.'</font>'); |
$request->print('<span class="LC_error">'.&mt('copy Error').': '.$!.'</span>'); |
| |
return 0; |
| |
} elsif (!chmod(0660, $newfile)) { |
| |
$request->print('<span class="LC_error">'.&mt('chmod error').': '.$!.'</span>'); |
| |
return 0; |
| |
} elsif (-e $oldfile.'.meta' && |
| |
!copy($oldfile.'.meta', $newfile.'.meta') && |
| |
!chmod(0660, $newfile.'.meta')) { |
| |
$request->print('<span class="LC_error">'.&mt('copy metadata error'). |
| |
': '.$!.'</span>'); |
| return 0; |
return 0; |
| } else { |
} else { |
| unless (chmod(0660, $newfile)) { |
|
| $request->print('<font color=red> chmod error: '.$!.'</font>'); |
|
| return 0; |
|
| } |
|
| return 1; |
return 1; |
| } |
} |
| } else { |
} else { |
| $request->print('<p> No such file </p>'); |
$request->print('<p class="LC_error">'.&mt('No such file').'</p>'); |
| return 0; |
return 0; |
| } |
} |
| return 1; |
return 1; |
| } |
} |
| |
|
| =pod |
=pod |
| |
|
| =item NewDir2($request, $user, $newdirectory) |
=item NewDir2($request, $user, $newdirectory) |
|
Line 894 Returns 0 - failure 1 - success.
|
Line 1508 Returns 0 - failure 1 - success.
|
| =cut |
=cut |
| |
|
| sub NewDir2 { |
sub NewDir2 { |
| my ($request, $user, $newdirectory) = @_; |
my ($request, $user, $newdirectory) = @_; |
| |
|
| unless(mkdir($newdirectory, 02770)) { |
unless(mkdir($newdirectory, 02770)) { |
| $request->print('<font color=red>Error: '.$!.'</font>'); |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
| |
return 0; |
| |
} |
| |
unless(chmod(02770, ($newdirectory))) { |
| |
$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>'); |
| |
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; |
| |
} |
| |
|
| |
sub Archive2 { |
| |
my ($r,$uname,$udom,$fn,$identifier) = @_; |
| |
my %options = ( |
| |
dir => $fn, |
| |
uname => $uname, |
| |
udom => $udom, |
| |
); |
| |
if ($env{'form.adload'}) { |
| |
$options{'adload'} = 1; |
| |
if ($env{'form.archivefname'} ne '') { |
| |
$env{'form.archivefname'} =~ s{\.+}{.}g; |
| |
$options{'fname'} = $env{'form.archivefname'}; |
| |
} |
| |
if ($env{'form.archiveext'} ne '') { |
| |
$options{'extension'} = $env{'form.archiveext'}; |
| |
} |
| |
} |
| |
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, |
| |
'cgi.author.archive' => $identifier}); |
| |
return 1; |
| |
} |
| |
|
| |
sub Archive3 { |
| |
my ($hashref) = @_; |
| |
if (ref($hashref) eq 'HASH') { |
| |
if (($hashref->{'uname'} eq $env{'user.name'}) && |
| |
($hashref->{'udom'} eq $env{'user.domain'}) && |
| |
($env{'environment.canarchive'}) && |
| |
($env{'form.delarchive'})) { |
| |
my $filesdest = $Apache::lonnet::perlvar{'lonPrtDir'}.'/'.$env{'user.name'}.'_'.$env{'user.domain'}.'_archive_'.$env{'form.delarchive'}; |
| |
if (-e $filesdest) { |
| |
my $size = (stat($filesdest))[7]; |
| |
if (unlink($filesdest)) { |
| |
my ($identifier,$suffix) = split(/\./,$env{'form.delarchive'},2); |
| |
if (($identifier) && (exists($env{'cgi.'.$identifier.'.archive'}))) { |
| |
my $delres = &Apache::lonnet::delenv('cgi.'.$identifier.'.archive'); |
| |
if (($delres eq 'ok') && |
| |
(exists($env{'cgi.author.archive'})) && |
| |
($env{'cgi.author.archive'} eq $identifier)) { |
| |
&Apache::lonnet::authorarchivelog($hashref,$size,$filesdest,'delete'); |
| |
&Apache::lonnet::delenv('cgi.author.archive'); |
| |
} |
| |
} |
| |
return 1; |
| |
} |
| |
} |
| |
} |
| |
} |
| return 0; |
return 0; |
| } |
|
| unless(chmod(02770, ($newdirectory))) { |
|
| $request->print('<font color=red> Error: '.$!.'</font>'); |
|
| return 0; |
|
| } |
|
| 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 917 sub NewDir2 {
|
Line 1625 sub NewDir2 {
|
| 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 940 Parameters:
|
Line 1648 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 it's component pieces. |
# Break down the file into its component pieces. |
| |
|
| $fn=~/(.*)\/([^\/]+)\.(\w+)$/; |
my $dir; # Directory path |
| my $dir=$1; # Directory path |
my $main; # Filename. |
| my $main=$2; # Filename. |
my $suffix; # Extension. |
| my $suffix=$3; # Extension. |
if ($fn=~m:(.*)/([^/]+):) { |
| |
$dir=$1; # Directory path |
| my $dest; # On success this is where we'll go. |
$main=$2; # Filename. |
| |
} |
| &Debug($r, |
if($main=~m:\.(\w+)$:){ # Fixes problems with filenames with no extensions |
| "loncfile::phase2 dir = $dir main = $main suffix = $suffix"); |
$suffix=$1; #This is the actually filename extension if it exists |
| &Debug($r, |
$main=~s/\.\w+$//; #strip the extension |
| " newfilename = ".$ENV{'form.newfilename'}); |
} |
| |
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," newfilename = ".$env{'form.newfilename'}); |
| |
|
| my $conspace=$fn; |
my $conspace=$fn; |
| |
|
| &Debug($r, |
&Debug($r,"loncfile::phase2 Full construction space name: $conspace"); |
| "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 'rename') { # Rename. |
$main .= '.'.$suffix; |
| if($ENV{'form.newfilename'}) { |
if(!&decompress2($r, $uname, $dir, $main)) { |
| if(!&Rename2($r, $uname, $dir, $fn, $ENV{'form.newfilename'})) { |
return ; |
| |
} |
| |
$dest = $dir."/."; |
| |
} elsif ($env{'form.action'} eq 'archive') { |
| |
if (($env{'environment.archive'}) && |
| |
($env{'user.name'} eq $uname) && |
| |
($env{'user.domain'} eq $udom)) { |
| |
&Archive2($r,$uname,$udom,$fn,$identifier); |
| |
} else { |
| |
$r->print(&mt('You do not have permission to export to an archive file in this Authoring Space')); |
| |
} |
| |
return; |
| |
} elsif ($env{'form.action'} eq 'rename' || |
| |
$env{'form.action'} eq 'move') { |
| |
if($env{'form.newfilename'}) { |
| |
if (!defined($dir)) { |
| |
$fn=~m:^(.*)/:; |
| |
$dir=$1; |
| |
} |
| |
if(!&Rename2($r, $uname, $dir, $fn, $env{'form.newfilename'})) { |
| return; |
return; |
| } |
} |
| # Prepend the directory to the new name to form the basis of the |
$dest = $dir."/"; |
| # url of the new resource. |
$dest_newname = $env{'form.newfilename'}; |
| # |
$env{'form.newfilename'} =~ /.+(\/.+$)/; |
| $dest = $dir."/".$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'})) { |
| return ; |
return ; |
| } |
} |
| # Once a resource is deleted, we just list the directory that |
# Once a resource is deleted, we just list the directory that |
| # 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 ; |
| } |
} |
| $dest = $ENV{'form.newfilename'}; |
$dest = $env{'form.newfilename'}; |
| |
} else { |
| } else { |
$r->print('<p class="LC_error">'.&mt('No New filename specified').'</p></form>'); |
| $r->print('<p>No New filename specified</form>'); |
|
| return; |
return; |
| } |
} |
| |
|
| } elsif ($ENV{'form.action'} eq 'newdir') { |
} elsif ($env{'form.action'} eq 'newdir') { |
| # |
my $newdir= $env{'form.newfilename'}; |
| # Since the newfilename form field is construction space |
|
| # relative, ew need to prepend the current path; now in $fn. |
|
| # |
|
| my $newdir= $fn.$ENV{'form.newfilename'}; |
|
| if(!&NewDir2($r, $uname, $newdir)) { |
if(!&NewDir2($r, $uname, $newdir)) { |
| return; |
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( |
| |
'<p>' |
| |
.&Apache::lonhtmlcommon::confirm_success(&mt('Done')) |
| |
.'<br /><a href="javascript:self.close()">'.&mt('Continue').'</a>' |
| |
.'</p>' |
| |
); |
| |
} else { |
| |
if ($env{'form.action'} eq 'rename') { |
| |
$r->print( |
| |
'<p>'.&Apache::lonhtmlcommon::confirm_success(&mt('Done')).'</p>' |
| |
.&Apache::lonhtmlcommon::actionbox( |
| |
['<a href="'.&url($dest).'">'.&mt('Return to Directory').'</a>', |
| |
'<a href="'.&url($dest_newname).'">'.$disp_newname.'</a>'])); |
| |
} else { |
| |
$r->print(&done($dest)); |
| |
} |
| } |
} |
| # |
|
| # Substitute for priv for the first home in $dir to get our |
|
| # construction space path. |
|
| # |
|
| &Debug($r, "Final url is: $dest"); |
|
| $dest =~ s/\/home\//\/priv\//; |
|
| $dest =~ s/\/public_html//; |
|
| &Debug($r, "Final url after rewrite: $dest"); |
|
| |
|
| $r->print('<h3><a href="'.$dest.'">Done</a></h3>'); |
|
| } |
} |
| |
|
| sub handler { |
sub handler { |
| |
|
| $r=shift; |
$r=shift; |
| |
|
| |
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['decompress','action','filename','newfilename','mode']); |
| |
|
| |
&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, |
| |
# or in value of decompress form element, or need to be extracted |
| |
# from %env from hashref retrieved for cgi.<id>.archive key, where id |
| |
# is a unique cgi_id created when an Author creates an archive of |
| |
# Authoring Space for download. |
| |
# |
| |
my ($fn,$archiveref); |
| |
|
| |
if ($env{'form.filename'}) { |
| |
&Debug($r, "test: $env{'form.filename'}"); |
| |
$fn=&unescape($env{'form.filename'}); |
| |
$fn=&URLToPath($fn); |
| |
} elsif ($env{'form.delarchive'}) { |
| |
my ($delarchive,$suffix) = split(/\./,$env{'form.delarchive'}); |
| |
if (($delarchive) && (exists($env{'cgi.'.$delarchive.'.archive'}))) { |
| |
$archiveref = &Apache::lonnet::thaw_unescape($env{'cgi.'.$delarchive.'.archive'}); |
| |
if (ref($archiveref) eq 'HASH') { |
| |
$fn = $archiveref->{'dir'}; |
| |
} |
| |
} |
| |
} 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 |
| |
if ($env{'form.decompress'} ne '') { |
| |
$fn=&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; |
| |
} |
| |
|
| &Debug($r, "loncfile.pm - handler entered"); |
unless ($fn) { |
| &Debug($r, " filename: ".$ENV{'form.filename'}); |
&Debug($r, "loncfile::handler - doctored url is empty"); |
| &Debug($r, " newfilename: ".$ENV{'form.newfilename'}); |
$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. |
| |
' trying to cfile non-existing file', $r->filename); |
| my $fn; |
return HTTP_NOT_FOUND; |
| |
} |
| if ($ENV{'form.filename'}) { |
|
| $fn=$ENV{'form.filename'}; |
|
| &Debug($r, "loncfile::handler - raw url: $fn"); |
|
| # $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/; |
|
| # $fn=~s/^http\:\/\/[^\/]+//; |
|
| $fn=URLToPath($fn); |
|
| &Debug($r, "loncfile::handler - doctored url: $fn"); |
|
| |
|
| } 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; |
|
| } |
|
| |
|
| # ----------------------------------------------------------- Start page output |
# ----------------------------------------------------------- Start page output |
| my $uname; |
|
| my $udom; |
|
| |
|
| ($uname,$udom)= |
my ($uname,$udom) = &Apache::lonnet::constructaccess($fn); |
| &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); |
&Debug($r, |
| &Debug($r, |
"loncfile::handler constructaccess uname = $uname domain = $udom"); |
| "loncfile::handler constructaccess uname = $uname domain = $udom"); |
if (($uname eq '') || ($udom eq '')) { |
| unless (($uname) && ($udom)) { |
$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; |
} |
| } |
if (($env{'form.delarchive'}) && |
| |
($env{'environment.canarchive'})) { |
| $fn=~s/\/\~(\w+)//; |
&Apache::loncommon::content_type($r,'text/plain'); |
| &Debug($r, "loncfile::handler ~ removed filename: $fn"); |
$r->send_http_header; |
| |
if (($env{'user.name'} eq $uname) && |
| $r->content_type('text/html'); |
($env{'user.domain'} eq $udom)) { |
| $r->send_http_header; |
$r->print(&Archive3($archiveref)); |
| |
} else { |
| $r->print('<html><head><title>LON-CAPA Construction Space</title></head>'); |
$r->print(&mt('You do not have permission to export to an archive file in this Authoring Space')); |
| |
} |
| $r->print( |
return OK; |
| '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>'); |
} |
| |
|
| |
&Apache::loncommon::content_type($r,'text/html'); |
| $r->print('<h1>Construction Space <tt>'.$fn.'</tt></h1>'); |
$r->send_http_header; |
| |
|
| if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) { |
# Declarations for items used for directory archive requests |
| $r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom. |
my ($js,$identifier,$defext,$archive_earlyout,$archive_idnum); |
| '</font></h3>'); |
my $args = {}; |
| } |
|
| |
if (($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && |
| |
(($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport'))) { |
| &Debug($r, "loncfile::handler Form action is $ENV{'form.action'} "); |
my $newdirname = $env{'form.newfilename'}; |
| if ($ENV{'form.action'} eq 'delete') { |
&js_escape(\$newdirname); |
| |
$js = <<"ENDJS"; |
| $r->print('<h3>Delete</h3>'); |
<script type="text/javascript"> |
| } elsif ($ENV{'form.action'} eq 'rename') { |
// <![CDATA[ |
| $r->print('<h3>Rename</h3>'); |
function writeDone() { |
| } elsif ($ENV{'form.action'} eq 'newdir') { |
window.focus(); |
| $r->print('<h3>New Directory</h3>'); |
opener.document.info.newdir.value = "$newdirname"; |
| } elsif ($ENV{'form.action'} eq 'copy') { |
setTimeout("self.close()",10000); |
| $r->print('<h3>Copy</h3>'); |
} |
| } else { |
// ]]> |
| $r->print('<p>Unknown Action</body></html>'); |
</script> |
| return OK; |
ENDJS |
| } |
$args->{'add_entries'} = { onload => "writeDone()" }; |
| if ($ENV{'form.phase'} eq 'two') { |
} elsif (($env{'form.action'} eq 'archive') && |
| &Debug($r, "loncfile::handler entering phase2"); |
($env{'environment.canarchive'})) { |
| &phasetwo($r,$fn,$uname,$udom); |
# Check if author already has an archive request in process |
| } else { |
($archive_earlyout,$archive_idnum) = &archive_in_progress(); |
| &Debug($r, "loncfile::handler entering phase1"); |
# Check if archive request was in process which author wishes to terminate |
| &phaseone($r,$fn,$uname,$udom); |
if ($env{'form.remove_archive_request'}) { |
| } |
if ($env{'form.remove_archive_request'} eq $archive_idnum) { |
| |
if (exists($env{'cgi.'.$archive_idnum.'.archive'})) { |
| |
my $archiveref = &Apache::lonnet::thaw_unescape($env{'cgi.'.$archive_idnum.'.archive'}); |
| |
if (ref($archiveref) eq 'HASH') { |
| |
$env{'form.delarchive'} = $archive_idnum.$archiveref->{'extension'}; |
| |
if (&Archive3($archiveref)) { |
| |
($archive_earlyout,$archive_idnum) = &archive_in_progress(); |
| |
} |
| |
delete($env{'form.delarchive'}); |
| |
} |
| |
} |
| |
} |
| |
} |
| |
if ($archive_earlyout) { |
| |
my $conftext = |
| |
&mt('Removing an existing request will terminate an active download of the archive file.'); |
| |
&js_escape(\$conftext); |
| |
$js = <<"ENDJS"; |
| |
<script type="text/javascript"> |
| |
// <![CDATA[ |
| |
function confirmation(form) { |
| |
if (form.remove_archive_request.length) { |
| |
for (var i=0; i<form.remove_archive_request.length; i++) { |
| |
if (form.remove_archive_request[i].checked) { |
| |
if (form.remove_archive_request[i].value == '$archive_idnum') { |
| |
if (!confirm('$conftext')) { |
| |
return false; |
| |
} |
| |
} |
| |
} |
| |
} |
| |
} |
| |
return true; |
| |
} |
| |
// ]]> |
| |
</script> |
| |
|
| |
ENDJS |
| |
} else { |
| |
if ($env{'form.phase'} eq 'two') { |
| |
$identifier = &Apache::loncommon::get_cgi_id(); |
| |
$args->{'redirect'} = [0.1,"/cgi-bin/archive.pl?$identifier"]; |
| |
} else { |
| |
my (%location_of,%defaults); |
| |
$defext = &archive_tools(\%location_of,\%defaults); |
| |
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; |
| |
} |
| |
} |
| |
} |
| |
} |
| |
setArchiveExt(form); |
| |
return; |
| |
} |
| |
|
| |
function setArchiveExt(form) { |
| |
var newfmt; |
| |
var newcomp; |
| |
var newdef; |
| |
if (document.getElementById('archiveext')) { |
| |
if (form.format.length) { |
| |
for (var i=0; i<form.format.length; i++) { |
| |
if (form.format[i].checked) { |
| |
newfmt = form.format[i].value; |
| |
break; |
| |
} |
| |
} |
| |
} else { |
| |
newfmt = form.format[0]; |
| |
} |
| |
if (newfmt == 'tar') { |
| |
if (document.getElementById('tar_compression')) { |
| |
if (form.compress.length) { |
| |
for (var i=0; i<form.compress.length; i++) { |
| |
if (form.compress[i].checked) { |
| |
newcomp = form.compress[i].value; |
| |
break; |
| |
} |
| |
} |
| |
} else { |
| |
newcomp = form.compress[0]; |
| |
} |
| |
} |
| |
if (newcomp == 'gzip') { |
| |
newdef = newfmt+'.gz'; |
| |
} else if (newcomp == 'bzip2') { |
| |
newdef = newfmt+'.bz2'; |
| |
} else if (newcomp == 'xz') { |
| |
newdef = newfmt+'.'+newcomp; |
| |
} else { |
| |
newdef = newfmt; |
| |
} |
| |
} else if (newfmt == 'zip') { |
| |
newdef = newfmt; |
| |
} |
| |
if ((newdef == '') || (newdef == undefined) || (newdef == null)) { |
| |
newdef = '.$defext'; |
| |
} |
| |
document.getElementById('archiveext').value = newdef; |
| |
} |
| |
} |
| |
|
| |
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; |
| |
var a = document.createElement('a'); |
| |
var vis; |
| |
if (typeof a.download != "undefined") { |
| |
document.phaseone.adload.value = '1'; |
| |
if (document.getElementById('archive_saveas')) { |
| |
document.getElementById('archive_saveas').style.display = 'block'; |
| |
vis = '1'; |
| |
} |
| |
} |
| |
if (vis == '1') { |
| |
if (document.getElementById('archiveext')) { |
| |
document.getElementById('archiveext').value='.$defext'; |
| |
} |
| |
} else { |
| |
if (document.getElementById('archive_saveas')) { |
| |
document.getElementById('archive_saveas').style.display = 'none'; |
| |
} |
| |
if (document.getElementById('archiveext')) { |
| |
document.getElementById('archiveext').value=''; |
| |
} |
| |
} |
| |
} |
| |
|
| |
$check_uncheck_js |
| |
|
| |
// ]]> |
| |
</script> |
| |
|
| |
ENDJS |
| |
$args->{'add_entries'} = { onload => "resetForm()" }; |
| |
} |
| |
} |
| |
} |
| |
my $londocroot = $r->dir_config('lonDocRoot'); |
| |
my $trailfile = $fn; |
| |
$trailfile =~ s{^/(priv/)}{$londocroot/$1}; |
| |
|
| |
# Breadcrumbs |
| |
my $text = 'Authoring Space'; |
| |
my $title = 'Authoring Space File Operation', |
| |
my $href = &Apache::loncommon::authorspace(&url($fn)); |
| |
&Apache::lonhtmlcommon::clear_breadcrumbs(); |
| |
&Apache::lonhtmlcommon::add_breadcrumb({ |
| |
'text' => $text, |
| |
'href' => $href, |
| |
}); |
| |
&Apache::lonhtmlcommon::add_breadcrumb({ |
| |
'text' => 'File Operation', |
| |
'title' => $title, |
| |
'href' => '', |
| |
}); |
| |
|
| |
$r->print(&Apache::loncommon::start_page($title,$js,$args) |
| |
.&Apache::lonhtmlcommon::breadcrumbs() |
| |
.&Apache::loncommon::head_subbox( |
| |
&Apache::loncommon::CSTR_pageheader($trailfile)) |
| |
); |
| |
|
| |
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'})) { |
| |
$r->print('<p class="LC_info">' |
| |
.&mt('Co-Author [_1]',$uname.':'.$udom) |
| |
.'</p>' |
| |
); |
| |
} |
| |
|
| |
|
| |
&Debug($r, "loncfile::handler Form action is $env{'form.action'} "); |
| |
my %action = &Apache::lonlocal::texthash( |
| |
'delete' => 'Delete', |
| |
'rename' => 'Rename', |
| |
'move' => 'Move', |
| |
'newdir' => 'New Directory', |
| |
'decompress' => 'Decompress', |
| |
'archive' => 'Export directory to archive file', |
| |
'copy' => 'Copy', |
| |
'newfile' => 'New Resource', |
| |
'newhtmlfile' => 'New Resource', |
| |
'newproblemfile' => 'New Resource', |
| |
'newpagefile' => 'New Resource', |
| |
'newsequencefile' => 'New Resource', |
| |
'newrightsfile' => 'New Resource', |
| |
'newstyfile' => 'New Resource', |
| |
'newtaskfile' => 'New Resource', |
| |
'newlibraryfile' => 'New Resource', |
| |
'Select Action' => 'New Resource', |
| |
); |
| |
if ($action{$env{'form.action'}}) { |
| |
if ($env{'form.action'} eq 'archive') { |
| |
if ($env{'environment.canarchive'}) { |
| |
if ($archive_earlyout) { |
| |
my $fname = &url($fn); |
| |
my $title = $action{$env{'form.action'}}; |
| |
&cancel_archive_form($r,$title,$fname,$archive_earlyout,$archive_idnum); |
| |
&CloseForm1($r,$fn); |
| |
$r->print(&Apache::loncommon::end_page()); |
| |
return OK; |
| |
} |
| |
} else { |
| |
$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>'."\n"); |
| |
} else { |
| |
$r->print('<p class="LC_error">' |
| |
.&mt('Unknown Action: [_1]',$env{'form.action'}) |
| |
.'</p>' |
| |
.&Apache::loncommon::end_page() |
| |
); |
| |
return OK; |
| |
} |
| |
|
| |
if ($env{'form.phase'} eq 'two') { |
| |
&Debug($r, "loncfile::handler entering phase2"); |
| |
&phasetwo($r,$fn,$uname,$udom,$identifier); |
| |
} else { |
| |
&Debug($r, "loncfile::handler entering phase1"); |
| |
&phaseone($r,$fn,$uname,$udom); |
| |
} |
| |
|
| $r->print('</body></html>'); |
$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