Annotation of loncom/publisher/lonupload.pm, revision 1.32
1.12 foxr 1:
1.1 www 2: # The LearningOnline Network with CAPA
3: # Handler to upload files into construction space
4: #
1.32 ! albertel 5: # $Id: lonupload.pm,v 1.31 2006/04/06 22:15:19 albertel Exp $
1.8 matthew 6: #
7: # Copyright Michigan State University Board of Trustees
8: #
9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
10: #
11: # LON-CAPA is free software; you can redistribute it and/or modify
12: # it under the terms of the GNU General Public License as published by
13: # the Free Software Foundation; either version 2 of the License, or
14: # (at your option) any later version.
15: #
16: # LON-CAPA is distributed in the hope that it will be useful,
17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19: # GNU General Public License for more details.
20: #
21: # You should have received a copy of the GNU General Public License
22: # along with LON-CAPA; if not, write to the Free Software
23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
24: #
25: # /home/httpd/html/adm/gpl.txt
26: #
27: # http://www.lon-capa.org/
28: #
1.10 harris41 29: ###
1.1 www 30:
31: package Apache::lonupload;
32:
33: use strict;
34: use Apache::File;
35: use File::Copy;
1.13 foxr 36: use File::Basename;
1.1 www 37: use Apache::Constants qw(:common :http :methods);
1.3 www 38: use Apache::loncacc;
1.10 harris41 39: use Apache::loncommon();
1.13 foxr 40: use Apache::lonnet;
1.14 foxr 41: use HTML::Entities();
1.20 www 42: use Apache::lonlocal;
1.29 albertel 43: use Apache::lonnet;
1.12 foxr 44:
45: my $DEBUG=0;
46:
47: sub Debug {
1.30 albertel 48: # Put out the indicated message but only if DEBUG is true.
1.22 albertel 49: if ($DEBUG) {
1.30 albertel 50: my ($r,$message) = @_;
51: $r->log_reason($message);
1.22 albertel 52: }
1.12 foxr 53: }
1.1 www 54:
1.2 www 55: sub upfile_store {
56: my $r=shift;
57:
1.29 albertel 58: my $fname=$env{'form.upfile.filename'};
1.2 www 59: $fname=~s/\W//g;
60:
1.29 albertel 61: chomp($env{'form.upfile'});
1.1 www 62:
1.29 albertel 63: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
1.2 www 64: '_upload_'.$fname.'_'.time.'_'.$$;
65: {
66: my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
67: '/tmp/'.$datatoken.'.tmp');
1.29 albertel 68: print $fh $env{'form.upfile'};
1.1 www 69: }
1.2 www 70: return $datatoken;
71: }
72:
73:
74: sub phaseone {
1.25 raeburn 75: my ($r,$fn,$uname,$udom,$mode)=@_;
76: my $action = '/adm/upload';
77: if ($mode eq 'testbank') {
78: $action = '/adm/testbank';
79: } elsif ($mode eq 'imsimport') {
80: $action = '/adm/imsimport';
81: }
1.29 albertel 82: $env{'form.upfile.filename'}=~s/\\/\//g;
83: $env{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/;
84: if ($env{'form.upfile.filename'}) {
1.22 albertel 85: $fn=~s/\/[^\/]+$//;
86: $fn=~s/([^\/])$/$1\//;
1.29 albertel 87: $fn.=$env{'form.upfile.filename'};
1.22 albertel 88: $fn=~s/^\///;
89: $fn=~s/(\/)+/\//g;
1.13 foxr 90:
91: # Fn is the full path to the destination filename.
92: #
93:
1.22 albertel 94: &Debug($r, "Filename for upload: $fn");
95: if (($fn) && ($fn!~/\/$/)) {
1.28 raeburn 96: $r->print('<form action="'.$action.'" method="post" name="fileupload">'.
1.23 albertel 97: '<input type="hidden" name="phase" value="two" />'.
98: '<input type="hidden" name="datatoken" value="'.
99: &upfile_store.'" />'.
100: '<input type="hidden" name="uploaduname" value="'.$uname.
101: '" />'.&mt('Store uploaded file as ').
1.25 raeburn 102: "<tt>/priv/$uname/</tt>".
103: '<input type="text" size="50" name="filename" value="'.$fn.
104: '" /><br />');
105: $r->print('<br />'.&mt('Please indicate the type of file you are uploading. The possible types of file are as follows:').'
106: <ul>
107: <li><b>'.&mt('Regular file:').'</b>'.&mt(' A file that requires no special handling during upload. The "Regular file" designation applies to html files, image files etc., as well as to zip, tar or gzip files that you wish to decompress after upload. In the case of a zip/tar/gz file etc., once the file has been uploaded, a "Decompress" link will automatically be displayed adjacent to the name of the file in the display of construction space directory contents. You will be able to decompress this file by clicking the link.').'</li>
108: <li><b>'.&mt('Testbank file:').'</b>'.&mt(' a testbank file containing plain text (ascii) questions and answers, which you plan to convert to LON-CAPA problems. The following question types can be converted: 1 of N multiple choice questions, individual True/False questions, groups of True/False questions, Fill-in-the-blank questions, Ranking questions, and Essay/short answer questions. Specific information about the format of the questions, foils, and correct answers is available ').'<a href="javascript:testbankWin()">'.&mt('here').'</a>,'.&mt(' and is also included in the pages displayed during step-by-step conversion of the testbank. The original testbank file can be removed from your construction space later, once the testbank questions have been converted.').'</li>
109: <li><b>'.&mt('IMS package').':</b>'.&mt(' a file containing course content from another Course Management System (e.g., Blackboard or ANGEL) packaged according to the IMS 1.1 specification. The original IMS package file can be removed from your construction space later, once the package has been decompressed and the files converted to LON-CAPA sequence, page, problem, or bulletin board files, or stored as html, image or movie files etc., as appropriate.').'</li>
110: </ul>
111: <br />'.&mt('Choose file type:').'
112: <select name="filetype">
113: <option value="standard" selected>'.&mt('Regular file').'
114: <option value="testbank">'.&mt('Testbank file').'
115: <option value="imsimport">'.&mt('IMS package').'
116: </select>
117: <br />
118: <br />
119: ');
120: $r->print('<input type="button" value="'.&mt('Store').'" onClick="javascript:verifyForm()"/></form>');
1.22 albertel 121: # Check for bad extension and warn user
122: if ($fn=~/\.(\w+)$/ &&
123: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.23 albertel 124: $r->print('<font color="red">'.&mt('The extension on this file,').
1.22 albertel 125: ' "'.$1.'"'.&mt(', is reserved internally by LON-CAPA.').
1.23 albertel 126: ' <br />'.&mt('Please change the extension.').'</font>');
1.22 albertel 127: } elsif($fn=~/\.(\w+)$/ &&
128: !defined(&Apache::loncommon::fileembstyle($1))) {
1.23 albertel 129: $r->print('<font color="red">'.&mt('The extension on this file,').
1.22 albertel 130: ' "'.$1.'"'.&mt(', is not recognized by LON-CAPA.').
1.23 albertel 131: ' <br />'.&mt('Please change the extension.').
1.22 albertel 132: '</font>');
133: }
134: } else {
1.23 albertel 135: $r->print('<font color="red">'.&mt('Illegal filename.').'</font>');
1.22 albertel 136: }
137: } else {
1.23 albertel 138: $r->print('<font color="red">'.&mt('No upload file specified.').'</font>');
1.22 albertel 139: }
1.1 www 140: }
141:
142: sub phasetwo {
1.25 raeburn 143: my ($r,$tfn,$uname,$udom,$mode)=@_;
144: my $action = '/adm/upload';
145: my $returnflag = '';
146: if ($mode eq 'testbank') {
147: $action = '/adm/testbank';
148: } elsif ($mode eq 'imsimport') {
149: $action = '/adm/imsimport';
150: }
1.22 albertel 151: my $fn='/priv/'.$uname.'/'.$tfn;
152: $fn=~s/\/+/\//g;
153: &Debug($r, "Filename is ".$tfn);
154: if ($tfn) {
155: &Debug($r, "Filename for tfn = ".$tfn);
156: my $target='/home/'.$uname.'/public_html'.$tfn;
157: &Debug($r, "target -> ".$target);
1.13 foxr 158: # target is the full filesystem path of the destination file.
1.22 albertel 159: my $base = &File::Basename::basename($fn);
160: my $path = &File::Basename::dirname($fn);
1.26 albertel 161: $base = &HTML::Entities::encode($base,'<>&"');
1.22 albertel 162: my $url = $path."/".$base;
163: &Debug($r, "URL is now ".$url);
1.29 albertel 164: my $datatoken=$env{'form.datatoken'};
1.22 albertel 165: if (($fn) && ($datatoken)) {
1.29 albertel 166: if ((-e $target) && ($env{'form.override'} ne 'Yes')) {
1.25 raeburn 167: $r->print('<form action="'.$action.'" method="post">'.
1.22 albertel 168: &mt('File').' <tt>'.$fn.'</tt> '.
169: &mt('exists. Overwrite?').' '.
1.23 albertel 170: '<input type="hidden" name="phase" value="two" />'.
171: '<input type="hidden" name="filename" value="'."$url".'" />'.
172: '<input type="hidden" name="datatoken" value="'.$datatoken.'" />'.
173: '<input type="submit" name="override" value="'.&mt('Yes').'" /></form>');
1.22 albertel 174: } else {
175: my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
1.27 www 176: my $dirpath=$path.'/';
177: $dirpath=~s/\/+/\//g;
1.22 albertel 178: # Check for bad extension and disallow upload
179: if ($fn=~/\.(\w+)$/ &&
180: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
181: $r->print(&mt('File').' <tt>'.$fn.'</tt> '.
182: &mt('could not be copied.').'<br />'.
1.23 albertel 183: '<font color="red">'.
1.22 albertel 184: &mt('The extension on this file is reserved internally by LON-CAPA.').
185: '</font>');
1.27 www 186: $r->print('<br /><font size=+2><a href="'.$dirpath.'">'.
1.22 albertel 187: &mt('Back to Directory').'</a></font>');
188: } elsif ($fn=~/\.(\w+)$/ &&
189: !defined(&Apache::loncommon::fileembstyle($1))) {
190: $r->print(&mt('File').' <tt>'.$fn.'</tt> '.
191: &mt('could not be copied.').'<br />'.
1.23 albertel 192: '<font color="red">'.
1.22 albertel 193: &mt('The extension on this file is not recognized by LON-CAPA.').
194: '</font>');
1.27 www 195: $r->print('<br /><font size="+2"><a href="'.$dirpath.'">'.
1.22 albertel 196: &mt('Back to Directory').'</a></font>');
197: } elsif (-d $target) {
198: $r->print('File <tt>'.$fn.'</tt> could not be copied.<br />'.
1.23 albertel 199: '<font color="red">'.
1.22 albertel 200: &mt('The target is an existing directory.').
1.23 albertel 201: '</font><br />');
1.27 www 202: $r->print('<font size="+2"><a href="'.$dirpath.'">'.
1.22 albertel 203: &mt('Back to Directory').'</a></font>');
204: } elsif (copy($source,$target)) {
205: chmod(0660, $target); # Set permissions to rw-rw---.
1.25 raeburn 206: if ($mode eq 'testbank' || $mode eq 'imsimport') {
207: $r->print(&mt("Your file - $fn - was uploaded successfully")."<br /><br />");
208: $returnflag = 'ok';
209: } else {
210: $r->print(&mt('File copied.'));
211: $r->print('<br /><font size="+2"><a href="'.$url.'">'.
1.22 albertel 212: &mt('View file').'</a></font>');
1.27 www 213: $r->print('<br /><font size="+2"><a href="'.$dirpath.'">'.
1.23 albertel 214: &mt('Back to Directory').'</a></font><br />');
1.25 raeburn 215: }
1.22 albertel 216: } else {
217: $r->print('Failed to copy: '.$!);
1.23 albertel 218: $r->print('<br /><font size="+2"><a href="'.$path.'">'.
1.22 albertel 219: &mt('Back to Directory').'</a></font>');
220: }
221: }
222: } else {
1.23 albertel 223: $r->print('<font size="+1" color="red">'.
1.22 albertel 224: &mt('Please use browser "Back" button and pick a filename').
1.24 albertel 225: '</font><br />');
1.22 albertel 226: }
1.1 www 227: } else {
1.22 albertel 228: $r->print('<font size=+1 color=red>'.
229: &mt('Please use browser "Back" button and pick a filename').
1.24 albertel 230: '</font><br />>');
1.1 www 231: }
1.25 raeburn 232: return $returnflag;
1.1 www 233: }
234:
1.10 harris41 235: # ---------------------------------------------------------------- Main Handler
1.1 www 236: sub handler {
237:
1.22 albertel 238: my $r=shift;
1.1 www 239:
1.22 albertel 240: my $uname;
241: my $udom;
1.25 raeburn 242: my $javascript = '';
1.18 www 243: #
244: # phase two: re-attach user
245: #
1.29 albertel 246: if ($env{'form.uploaduname'}) {
247: $env{'form.filename'}='/priv/'.$env{'form.uploaduname'}.'/'.
248: $env{'form.filename'};
1.22 albertel 249: }
250:
1.29 albertel 251: unless ($env{'form.phase'} eq 'two') {
1.32 ! albertel 252: my %body_layout = ('rightmargin' => "0",
! 253: 'leftmargin' => "0",
! 254: 'marginwidth' => "0",
! 255: 'topmargin' => "0",
! 256: 'marginheight' => "0");
1.31 albertel 257: my $start_page =
258: &Apache::loncommon::start_page('Importing a Testbank file into LON-CAPA',
259: undef,
260: {'only_body' => 1,
1.32 ! albertel 261: 'add_entries' => \%body_layout,
1.31 albertel 262: 'js_ready' => 1,});
263: my $end_page =
264: &Apache::loncommon::end_page({'js_ready' => 1,});
265:
1.25 raeburn 266: $javascript = qq|
267: function verifyForm() {
1.28 raeburn 268: var mode = document.fileupload.filetype.options[document.fileupload.filetype.selectedIndex].value
1.25 raeburn 269: if (mode == "testbank") {
1.28 raeburn 270: document.fileupload.action = "/adm/testbank";
1.25 raeburn 271: }
272: if (mode == "imsimport") {
1.28 raeburn 273: document.fileupload.action = "/adm/imsimport";
1.25 raeburn 274: }
275: if (mode == "standard") {
1.28 raeburn 276: document.fileupload.action = "/adm/upload";
1.25 raeburn 277: }
1.28 raeburn 278: document.fileupload.submit();
1.25 raeburn 279: }
280:
281: function testbankWin() {
282: newWindow = window.open("","testbankinfo","HEIGHT=400,WIDTH=750,scrollbars=yes")
283: newWindow.document.open()
1.31 albertel 284: newWindow.document.write('$start_page')
1.25 raeburn 285: newWindow.document.write("<img border='0' src='/adm/lonInterFace/author.jpg' alt='[Author Header]'>\\n")
286: newWindow.document.write("<table border='0' cellspacing='0' cellpadding='0' width='95%' bgcolor='#CCFFDD'>\\n")
287: newWindow.document.write("<tr><td width='2'> </td><td width='3'> </td>\\n")
288: newWindow.document.write("<td><font face='arial,helvetica,sans-serif'><h3>Importing Testbank questions into LON-CAPA</h3>")
289: newWindow.document.write("<font face='arial,helvetica,sans-serif'><br />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.")
290: newWindow.document.write("<ol><li>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.</li>")
291: newWindow.document.write("<li>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 .</li>")
292: newWindow.document.write("<li>One or more correct answers should be provided for all questions (although blank answers may be provided for <i>essay</i> questions). Answers should be numbered sequentially, using the same scheme as used for the questions, and must occur after all the questions.")
293: newWindow.document.write("<li><i>Multiple choice</i> and <i>multiple answer correct</i> 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) .</li>")
294: newWindow.document.write("<li>If <i>fill-in-the-blank</i> or <i>multiple answer</i> questions have more than one correct answer, each answer should appear in a comma-, tab-, space-, or new line-delimited list. </li></ol>")
295: newWindow.document.write("</td></tr>\\n")
1.31 albertel 296: newWindow.document.write("</table>")
297: newWindow.document.write('$end_page')
1.25 raeburn 298: newWindow.document.close()
299: newWindow.focus()
300: }
301: |;
302: }
1.22 albertel 303: ($uname,$udom)=
1.29 albertel 304: &Apache::loncacc::constructaccess($env{'form.filename'},
1.22 albertel 305: $r->dir_config('lonDefDomain'));
306: unless (($uname) && ($udom)) {
307: $r->log_reason($uname.' at '.$udom.
1.29 albertel 308: ' trying to publish file '.$env{'form.filename'}.
1.22 albertel 309: ' - not authorized',
310: $r->filename);
311: return HTTP_NOT_ACCEPTABLE;
312: }
313:
314: my $fn;
1.29 albertel 315: if ($env{'form.filename'}) {
316: $fn=$env{'form.filename'};
1.22 albertel 317: $fn=~s/^http\:\/\/[^\/]+\///;
318: $fn=~s/^\///;
319: $fn=~s/(\~|priv\/)(\w+)//;
320: $fn=~s/\/+/\//g;
321: } else {
1.29 albertel 322: $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
1.22 albertel 323: ' unspecified filename for upload', $r->filename);
324: return HTTP_NOT_FOUND;
325: }
1.1 www 326:
327: # ----------------------------------------------------------- Start page output
328:
329:
1.22 albertel 330: &Apache::loncommon::content_type($r,'text/html');
331: $r->send_http_header;
1.1 www 332:
1.31 albertel 333: $javascript = "<script type=\"text/javascript\">\n//<!--\n".
334: $javascript."\n// --></script>\n";
1.1 www 335:
1.31 albertel 336: $r->print(&Apache::loncommon::start_page('Upload file to Construction Space',
337: $javascript));
1.3 www 338:
1.29 albertel 339: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.22 albertel 340: $r->print('<h3><font color=red>'.&mt('Co-Author').': '.$uname.
341: &mt(' at ').$udom.'</font></h3>');
342: }
343:
1.29 albertel 344: if ($env{'form.phase'} eq 'two') {
1.22 albertel 345: &phasetwo($r,$fn,$uname,$udom);
346: } else {
347: &phaseone($r,$fn,$uname,$udom);
348: }
1.1 www 349:
1.31 albertel 350: $r->print(&Apache::loncommon::end_page());
1.22 albertel 351: return OK;
1.1 www 352: }
1.7 www 353:
354: 1;
355: __END__
1.10 harris41 356:
357: =head1 NAME
358:
359: Apache::lonupload - upload files into construction space
360:
361: =head1 SYNOPSIS
362:
363: Invoked by /etc/httpd/conf/srm.conf:
364:
365: <Location /adm/upload>
366: PerlAccessHandler Apache::lonacc
367: SetHandler perl-script
368: PerlHandler Apache::lonupload
369: ErrorDocument 403 /adm/login
370: ErrorDocument 404 /adm/notfound.html
371: ErrorDocument 406 /adm/unauthorized.html
372: ErrorDocument 500 /adm/errorhandler
373: </Location>
374:
375: =head1 INTRODUCTION
376:
377: This module uploads a file sitting on a client computer into
378: library server construction space.
379:
380: This is part of the LearningOnline Network with CAPA project
381: described at http://www.lon-capa.org.
382:
383: =head1 HANDLER SUBROUTINE
384:
385: This routine is called by Apache and mod_perl.
386:
387: =over 4
388:
389: =item *
390:
391: Initialize variables
392:
393: =item *
394:
395: Start page output
396:
397: =item *
398:
399: output relevant interface phase (phaseone or phasetwo)
400:
401: =item *
402:
403: (phase one is to specify upload file; phase two is to handle conditions
404: subsequent to specification--like overwriting an existing file)
405:
406: =back
407:
408: =head1 OTHER SUBROUTINES
409:
410: =over 4
411:
412: =item *
413:
414: phaseone() : Interface for specifying file to upload.
415:
416: =item *
417:
418: phasetwo() : Interface for handling post-conditions about uploading (such
419: as overwriting an existing file).
420:
421: =item *
422:
423: upfile_store() : Store contents of uploaded file into temporary space. Invoked
424: by phaseone subroutine.
425:
426: =back
427:
428: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonupload.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / publisher