--- loncom/publisher/lonupload.pm 2001/04/05 19:35:15 1.1
+++ loncom/publisher/lonupload.pm 2004/02/17 15:23:53 1.25
@@ -1,164 +1,417 @@
+
# The LearningOnline Network with CAPA
# Handler to upload files into construction space
#
-# (Handler to retrieve an old version of a file
+# $Id: lonupload.pm,v 1.25 2004/02/17 15:23:53 raeburn Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
-# (Publication Handler
-#
-# (TeX Content Handler
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
#
-# 05/29/00,05/30,10/11 Gerd Kortemeyer)
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
#
-# 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)
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
-# 03/31,04/03 Gerd Kortemeyer)
+# /home/httpd/html/adm/gpl.txt
#
-# 04/05 Gerd Kortemeyer
+# http://www.lon-capa.org/
+#
+###
package Apache::lonupload;
use strict;
use Apache::File;
use File::Copy;
+use File::Basename;
use Apache::Constants qw(:common :http :methods);
+use Apache::loncacc;
+use Apache::loncommon();
+use Apache::Log();
+use Apache::lonnet;
+use HTML::Entities();
+use Apache::lonlocal;
-sub phaseone {
- my ($r,$fn,$uname,$udom)=@_;
- my $docroot=$r->dir_config('lonDocRoot');
+my $DEBUG=0;
- my $urldir='/res/'.$udom.'/'.$uname.$fn;
- $urldir=~s/\/[^\/]+$/\//;
+sub Debug {
+
+ # Marshall the parameters.
+
+ my $r = shift;
+ my $log = $r->log;
+ my $message = shift;
+
+ # Put out the indicated message butonly if DEBUG is false.
+
+ if ($DEBUG) {
+ $log->debug($message);
+ }
+}
- my $resfn=$docroot.'/res/'.$udom.'/'.$uname.$fn;
- my $resdir=$resfn;
- $resdir=~s/\/[^\/]+$/\//;
-
- $fn=~/^\/(.+)\.(\w+)$/;
- my $main=$1;
- my $suffix=$2;
-
- $r->print('');
+sub upfile_store {
+ my $r=shift;
+
+ my $fname=$ENV{'form.upfile.filename'};
+ $fname=~s/\W//g;
+
+ chomp($ENV{'form.upfile'});
+
+ my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
+ '_upload_'.$fname.'_'.time.'_'.$$;
+ {
+ my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
+ '/tmp/'.$datatoken.'.tmp');
+ print $fh $ENV{'form.upfile'};
+ }
+ return $datatoken;
+}
+
+
+sub phaseone {
+ my ($r,$fn,$uname,$udom,$mode)=@_;
+ my $action = '/adm/upload';
+ if ($mode eq 'testbank') {
+ $action = '/adm/testbank';
+ } elsif ($mode eq 'imsimport') {
+ $action = '/adm/imsimport';
+ }
+ $ENV{'form.upfile.filename'}=~s/\\/\//g;
+ $ENV{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/;
+ if ($ENV{'form.upfile.filename'}) {
+ $fn=~s/\/[^\/]+$//;
+ $fn=~s/([^\/])$/$1\//;
+ $fn.=$ENV{'form.upfile.filename'};
+ $fn=~s/^\///;
+ $fn=~s/(\/)+/\//g;
+
+# Fn is the full path to the destination filename.
+#
+
+ &Debug($r, "Filename for upload: $fn");
+ if (($fn) && ($fn!~/\/$/)) {
+ $r->print('');
+ # 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.').'');
+ } 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.').
+ '');
+ }
+ } else {
+ $r->print(''.&mt('Illegal filename.').'');
+ }
+ } else {
+ $r->print(''.&mt('No upload file specified.').'');
+ }
}
sub phasetwo {
- my ($r,$fn,$uname,$udom)=@_;
- if ($ENV{'form.version'}) {
- my $version=$ENV{'form.version'};
- if ($version eq 'new') {
- $r->print('Retrieving current (most recent) version
');
- } else {
- $r->print('Retrieving old version '.$version.'
');
- }
- my $logfile;
- my $ctarget='/home/'.$uname.'/public_html'.$fn;
- my $vfn=$fn;
- if ($version ne 'new') {
- $vfn=~s/\.(\w+)$/\.$version\.$1/;
- }
- my $csource=$r->dir_config('lonDocRoot').'/res/'.$udom.'/'.$uname.$vfn;
- unless ($logfile=Apache::File->new('>>'.$ctarget.'.log')) {
- $r->print(
- 'No write permission to user directory, FAIL');
- }
- print $logfile
-"\n\n================= Retrieve ".localtime()." ================\n".
-"Version: $version\nSource: $csource\nTarget: $ctarget\n";
- $r->print('Copying file: ');
- if (copy($csource,$ctarget)) {
- $r->print('ok
');
- print $logfile "Copied sucessfully.\n\n";
- } else {
- my $error=$!;
- $r->print('fail, '.$error.'
');
- print $logfile "Copy failed: $error\n\n";
- }
- $r->print('Back to '.$fn.'');
+ my ($r,$tfn,$uname,$udom,$mode)=@_;
+ my $action = '/adm/upload';
+ my $returnflag = '';
+ if ($mode eq 'testbank') {
+ $action = '/adm/testbank';
+ } elsif ($mode eq 'imsimport') {
+ $action = '/adm/imsimport';
+ }
+ my $fn='/priv/'.$uname.'/'.$tfn;
+ $fn=~s/\/+/\//g;
+ &Debug($r, "Filename is ".$tfn);
+ if ($tfn) {
+ &Debug($r, "Filename for tfn = ".$tfn);
+ my $target='/home/'.$uname.'/public_html'.$tfn;
+ &Debug($r, "target -> ".$target);
+# target is the full filesystem path of the destination file.
+ my $base = &File::Basename::basename($fn);
+ my $path = &File::Basename::dirname($fn);
+ $base = &HTML::Entities::encode($base);
+ my $url = $path."/".$base;
+ &Debug($r, "URL is now ".$url);
+ my $datatoken=$ENV{'form.datatoken'};
+ if (($fn) && ($datatoken)) {
+ if ((-e $target) && ($ENV{'form.override'} ne 'Yes')) {
+ $r->print('
');
+ } else {
+ my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
+ # 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').'');
+ }
+ }
+ } else {
+ $r->print(''.
+ &mt('Please use browser "Back" button and pick a filename').
+ '
');
+ }
} else {
- $r->print(
- 'Please pick a version to retrieve');
- &phaseone($r,$fn,$uname,$udom);
+ $r->print(''.
+ &mt('Please use browser "Back" button and pick a filename').
+ '
>');
}
+ return $returnflag;
}
+# ---------------------------------------------------------------- Main Handler
sub handler {
- my $r=shift;
+ my $r=shift;
- my $fn;
+ my $uname;
+ my $udom;
+ my $javascript = '';
+#
+# phase two: re-attach user
+#
+ if ($ENV{'form.uploaduname'}) {
+ $ENV{'form.filename'}='/priv/'.$ENV{'form.uploaduname'}.'/'.
+ $ENV{'form.filename'};
+ }
- if ($ENV{'form.filename'}) {
- $fn=$ENV{'form.filename'};
- $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)//;
- } else {
- $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
- ' unspecified filename for retrieval', $r->filename);
- return HTTP_NOT_FOUND;
- }
-
- unless ($fn) {
- $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
- ' trying to retrieve non-existing file', $r->filename);
- return HTTP_NOT_FOUND;
- }
+ unless ($ENV{'form.phase'} eq 'two') {
+ $javascript = qq|
+function verifyForm() {
+ var mode = document.forms[0].filetype.options[document.forms[0].filetype.selectedIndex].value
+ if (mode == "testbank") {
+ document.forms[0].action = "/adm/testbank";
+ }
+ if (mode == "imsimport") {
+ document.forms[0].action = "/adm/imsimport";
+ }
+ if (mode == "standard") {
+ document.forms[0].action = "/adm/upload";
+ }
+ document.forms[0].submit();
+}
-# ----------------------------------------------------------- Start page output
+function testbankWin() {
+ newWindow = window.open("","testbankinfo","HEIGHT=400,WIDTH=750,scrollbars=yes")
+ newWindow.document.open()
+ newWindow.document.write("
'Importing a Testbank file into LON-CAPA\\n")
+ newWindow.document.write("\\n")
+ newWindow.document.write("![[Author Header]](/adm/lonInterFace/author.jpg)
\\n")
+ newWindow.document.write("\\n")
+ newWindow.document.write("| | | \\n")
+ newWindow.document.write("Importing Testbank questions into LON-CAPA")
+ newWindow.document.write("
Four requirements must be met to ensure that you will succeed in building LON-CAPA problem files using your plain text file containing testbank questions.")
+ newWindow.document.write("- The questions and answers you upload must be in plain text format. Any header lines should occur before the text containing the questions and answers.
")
+ newWindow.document.write("- All questions must occur before any of the answers. Each question should be numbered sequentially using a number followed immediately by a space, a period, or enclosed in parentheses, i.e., 1 , 1., (1), 1), or (1 .
")
+ newWindow.document.write("- One or more correct answers should be provided for all questions (although blank answers may be provided for essay questions). Answers should be numbered sequentially, using the same scheme as used for the questions, and must occur after all the questions.")
+ newWindow.document.write("
- Multiple choice and multiple answer correct questions should consist of (i) the question number followed by (ii) a question stem beginning on the same line and (iii) two or more foils, with each foil beginning on a new line and prefixed by a unique letter, or Roman numeral, listed in alphabetic or numeric order, beginning at a (alphabetic) or i (Roman numeral), followed by a period, or enclosed in parentheses, i.e., a., (a), i., or (i) .
")
+ newWindow.document.write("- If fill-in-the-blank or multiple answer questions have more than one correct answer, each answer should appear in a comma-, tab-, space-, or new line-delimited list.
")
+ newWindow.document.write(" |
\\n")
+ newWindow.document.write("
")
+ newWindow.document.close()
+ newWindow.focus()
+}
+|;
+ }
+ ($uname,$udom)=
+ &Apache::loncacc::constructaccess($ENV{'form.filename'},
+ $r->dir_config('lonDefDomain'));
+ unless (($uname) && ($udom)) {
+ $r->log_reason($uname.' at '.$udom.
+ ' trying to publish file '.$ENV{'form.filename'}.
+ ' - not authorized',
+ $r->filename);
+ return HTTP_NOT_ACCEPTABLE;
+ }
+
+ my $fn;
+ if ($ENV{'form.filename'}) {
+ $fn=$ENV{'form.filename'};
+ $fn=~s/^http\:\/\/[^\/]+\///;
+ $fn=~s/^\///;
+ $fn=~s/(\~|priv\/)(\w+)//;
+ $fn=~s/\/+/\//g;
+ } else {
+ $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
+ ' unspecified filename for upload', $r->filename);
+ return HTTP_NOT_FOUND;
+ }
- my $uname=$ENV{'user.name'};
- my $udom=$ENV{'user.domain'};
+# ----------------------------------------------------------- Start page output
- $r->content_type('text/html');
- $r->send_http_header;
- $r->print('LON-CAPA Construction Space');
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
- $r->print(
- '
');
+ $r->print("LON-CAPA Construction Space\n");
+ $r->print(&Apache::loncommon::bodytag('Upload file to Construction Space'));
- $r->print('Retrieve previous versions of '.$fn.'
');
+ if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
+ $r->print(''.&mt('Co-Author').': '.$uname.
+ &mt(' at ').$udom.'
');
+ }
- if ($ENV{'form.phase'} eq 'two') {
- &phasetwo($r,$fn,$uname,$udom);
- } else {
- &phaseone($r,$fn,$uname,$udom);
- }
+ if ($ENV{'form.phase'} eq 'two') {
+ &phasetwo($r,$fn,$uname,$udom);
+ } else {
+ &phaseone($r,$fn,$uname,$udom);
+ }
- $r->print('');
- return OK;
+ $r->print('