--- loncom/publisher/lonupload.pm 2008/01/15 16:04:38 1.36
+++ loncom/publisher/lonupload.pm 2009/05/14 14:24:18 1.46
@@ -2,7 +2,7 @@
# The LearningOnline Network with CAPA
# Handler to upload files into construction space
#
-# $Id: lonupload.pm,v 1.36 2008/01/15 16:04:38 www Exp $
+# $Id: lonupload.pm,v 1.46 2009/05/14 14:24:18 bisitz Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -28,6 +28,92 @@
#
###
+=head1 NAME
+
+Apache::lonupload - upload files into construction space
+
+=head1 SYNOPSIS
+
+Invoked by /etc/httpd/conf/srm.conf:
+
+
+ PerlAccessHandler Apache::lonacc
+ SetHandler perl-script
+ PerlHandler Apache::lonupload
+ ErrorDocument 403 /adm/login
+ ErrorDocument 404 /adm/notfound.html
+ ErrorDocument 406 /adm/unauthorized.html
+ ErrorDocument 500 /adm/errorhandler
+
+
+=head1 INTRODUCTION
+
+This module uploads a file sitting on a client computer into
+library server construction space.
+
+This is part of the LearningOnline Network with CAPA project
+described at http://www.lon-capa.org.
+
+=head1 HANDLER SUBROUTINE
+
+This routine is called by Apache and mod_perl.
+
+=over 4
+
+=item *
+
+Initialize variables
+
+=item *
+
+Start page output
+
+=item *
+
+output relevant interface phase (phaseone or phasetwo or phasethree)
+
+=item *
+
+(phase one is to specify upload file; phase two is to handle conditions
+subsequent to specification--like overwriting an existing file; phase three
+is to handle processing of secondary uploads - of embedded objects in an
+html file).
+
+=back
+
+=head1 OTHER SUBROUTINES
+
+=over
+
+=item phaseone()
+
+Interface for specifying file to upload.
+
+=item phasetwo()
+
+Interface for handling post-conditions about uploading (such
+as overwriting an existing file).
+
+=item phasethree()
+
+Interface for handling secondary uploads of embedded objects
+in an html file.
+
+=item upfile_store()
+
+Store contents of uploaded file into temporary space. Invoked
+by phaseone subroutine.
+
+=item check_extension()
+
+Checks if filename extension is permitted and checks type
+ of file - if html file, calls parser to check for embedded objects.
+ Invoked by phasetwo subroutine.
+
+=back
+
+=cut
+
package Apache::lonupload;
use strict;
@@ -71,7 +157,6 @@ sub upfile_store {
return $datatoken;
}
-
sub phaseone {
my ($r,$fn,$uname,$udom,$mode)=@_;
my $action = '/adm/upload';
@@ -99,13 +184,14 @@ sub phaseone {
''.
''.&mt('Save uploaded file as ').
+ '" />'.&mt('Save uploaded file as [_1]',
"/priv/$uname/".
' '.
+ '" />').
+ ' '.
' '.&mt('Choose file type:').'
'.&Apache::loncommon::help_open_topic("Uploading_File_Options").'
@@ -116,15 +202,16 @@ sub phaseone {
# Check for bad extension and warn user
if ($fn=~/\.(\w+)$/ &&
(&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
- $r->print(''.&mt('The extension on this file,').
- ' "'.$1.'"'.&mt(', is reserved internally by LON-CAPA.').
- ' '.&mt('Please change the extension.').'');
+ $r->print('
'
+ .&mt('The extension on this file, [_1], is reserved internally by LON-CAPA.','"'.$1.'"')
+ .' '.&mt('Please change the extension.')
+ .'
');
} elsif($fn=~/\.(\w+)$/ &&
!defined(&Apache::loncommon::fileembstyle($1))) {
- $r->print(''.&mt('The extension on this file,').
- ' "'.$1.'"'.&mt(', is not recognized by LON-CAPA.').
- ' '.&mt('Please change the extension.').
- '');
+ $r->print('
'
+ .&mt('The extension on this file, [_1], is not recognized by LON-CAPA.','"'.$1.'"')
+ .' '.&mt('Please change the extension.')
+ .'
');
}
} else {
$r->print(''.&mt('Illegal filename.').'');
@@ -136,6 +223,7 @@ sub phaseone {
sub phasetwo {
my ($r,$tfn,$uname,$udom,$mode)=@_;
+ my $output;
my $action = '/adm/upload';
my $returnflag = '';
if ($mode eq 'testbank') {
@@ -162,76 +250,127 @@ sub phasetwo {
my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
my $dirpath=$path.'/';
$dirpath=~s/\/+/\//g;
- $r->print(&mt('Upload cancelled.').' '.
- &mt('Back to Directory').'');
+ $output .= &mt('Upload cancelled.').' '.
+ &mt('Back to Directory').'';
} elsif ((-e $target) && (!$env{'form.override'})) {
- $r->print('');
+ '';
} else {
my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
my $dirpath=$path.'/';
$dirpath=~s/\/+/\//g;
# Check for bad extension and disallow upload
- if ($fn=~/\.(\w+)$/ &&
- (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
- $r->print(&mt('File').' '.$fn.' '.
- &mt('could not be copied.').' '.
- ''.
- &mt('The extension on this file is reserved internally by LON-CAPA.').
- '');
- $r->print(' '.
- &mt('Back to Directory').'');
- } elsif ($fn=~/\.(\w+)$/ &&
- !defined(&Apache::loncommon::fileembstyle($1))) {
- $r->print(&mt('File').' '.$fn.' '.
- &mt('could not be copied.').' '.
- ''.
- &mt('The extension on this file is not recognized by LON-CAPA.').
- '');
- $r->print(' '.
- &mt('Back to Directory').'');
- } elsif (-d $target) {
- $r->print('File '.$fn.' could not be copied. '.
- ''.
- &mt('The target is an existing directory.').
- ' ');
- $r->print(''.
- &mt('Back to Directory').'');
- } elsif (copy($source,$target)) {
- chmod(0660, $target); # Set permissions to rw-rw---.
- if ($mode eq 'testbank' || $mode eq 'imsimport') {
- $r->print(&mt("Your file - $fn - was uploaded successfully")."
");
- $returnflag = 'ok';
- } else {
- $r->print(&mt('File copied.'));
- $r->print(' '.
- &mt('View file').'');
- $r->print(' '.
- &mt('Back to Directory').' ');
- }
- } else {
- $r->print('Failed to copy: '.$!);
- $r->print(' '.
- &mt('Back to Directory').'');
- }
+ my $result;
+ ($result,$returnflag) = &check_extension($fn,$mode,$source,$target,$action,$dirpath,$url);
+ $output .= $result;
}
} else {
- $r->print(''.
+ $output .= ''.
&mt('Please use browser "Back" button and pick a filename').
- ' ');
+ ' ';
}
} else {
- $r->print(''.
- &mt('Please use browser "Back" button and pick a filename').
- ' >');
+ $output .= ''.
+ &mt('Please use browser "Back" button and pick a filename').
+ ' ';
}
- return $returnflag;
+ return ($output,$returnflag);
+}
+
+sub check_extension {
+ my ($fn,$mode,$source,$target,$action,$dirpath,$url) = @_;
+ my ($result,$returnflag);
+ # Check for bad extension and disallow upload
+ if ($fn=~/\.(\w+)$/ &&
+ (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
+ $result .= &mt('File [_1] could not be copied.',
+ ''.$fn.' ').
+ '
'.
+ &mt('The extension on this file is reserved internally by LON-CAPA.').
+ '
';
+ } elsif ($fn=~/\.(\w+)$/ &&
+ !defined(&Apache::loncommon::fileembstyle($1))) {
+ $result .= &mt('File [_1] could not be copied.',
+ ''.$fn.' ').
+ '
'.
+ &mt('The extension on this file is not recognized by LON-CAPA.').
+ '
';
+ } elsif (-d $target) {
+ $result .= &mt('File [_1] could not be copied.',
+ ''.$fn.'').
+ '
'.
+ &mt('The target is an existing directory.').
+ '
';
+ } elsif (copy($source,$target)) {
+ chmod(0660, $target); # Set permissions to rw-rw---.
+ if ($mode eq 'testbank' || $mode eq 'imsimport') {
+ $returnflag = 'ok';
+ $result .= &mt('Your file - [_1] - was uploaded successfully',$fn).'
';
+ } else {
+ $result .= &mt('File copied.').' ';
+ }
+ # Check for embedded objects.
+ my (%allfiles,%codebase);
+ my ($text,$header,$css,$js);
+ if (($mode ne 'imsimport') && ($target =~ /\.(htm|html|shtml)$/i)) {
+ my (%allfiles,%codebase);
+ &Apache::lonnet::extract_embedded_items($target,\%allfiles,\%codebase);
+ if (keys(%allfiles) > 0) {
+ my $state = <
+
+
+
+
+STATE
+ $result .= "
".&mt("Reference Warning")."
".
+ "
".&mt("Completed upload of the file. This file contained references to other files.")."
".
+ "
".&mt("Please select the locations from which the referenced files are to be uploaded.")."