Annotation of loncom/publisher/lonupload.pm, revision 1.30

1.12      foxr        1: 
1.1       www         2: # The LearningOnline Network with CAPA
                      3: # Handler to upload files into construction space
                      4: #
1.30    ! albertel    5: # $Id: lonupload.pm,v 1.29 2005/04/07 06:56:27 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.25      raeburn   252:         $javascript = qq|
                    253: function verifyForm() {
1.28      raeburn   254:     var mode = document.fileupload.filetype.options[document.fileupload.filetype.selectedIndex].value
1.25      raeburn   255:     if (mode == "testbank") {
1.28      raeburn   256:         document.fileupload.action = "/adm/testbank";
1.25      raeburn   257:     }
                    258:     if (mode == "imsimport") {
1.28      raeburn   259:         document.fileupload.action = "/adm/imsimport";
1.25      raeburn   260:     }
                    261:     if (mode == "standard") {
1.28      raeburn   262:         document.fileupload.action = "/adm/upload";
1.25      raeburn   263:     }
1.28      raeburn   264:     document.fileupload.submit();
1.25      raeburn   265: }
                    266: 
                    267: function testbankWin() {
                    268:   newWindow = window.open("","testbankinfo","HEIGHT=400,WIDTH=750,scrollbars=yes")
                    269:   newWindow.document.open()
                    270:   newWindow.document.write("<html><head><title>'Importing a Testbank file into LON-CAPA</title><meta http-equiv='pragma' content='no-cache'>\\n")
                    271:   newWindow.document.write("</head><body bgcolor='#CCFFDD' topmargin='0' leftmargin='0' marginheight='0'marginwidth='0' rightmargin='0'>\\n")
                    272:   newWindow.document.write("<img border='0' src='/adm/lonInterFace/author.jpg' alt='[Author Header]'>\\n")
                    273:   newWindow.document.write("<table border='0' cellspacing='0' cellpadding='0' width='95%' bgcolor='#CCFFDD'>\\n")
                    274:   newWindow.document.write("<tr><td width='2'>&nbsp;</td><td width='3'>&nbsp;</td>\\n")
                    275:   newWindow.document.write("<td><font face='arial,helvetica,sans-serif'><h3>Importing Testbank questions into LON-CAPA</h3>")
                    276:   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.")
                    277:   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>")
                    278:   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>")
                    279:    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.")
                    280:     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>")
                    281:      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>")
                    282:   newWindow.document.write("</td></tr>\\n")
                    283:   newWindow.document.write("</table></body></html>")
                    284:   newWindow.document.close()
                    285:   newWindow.focus()
                    286: }
                    287: |;
                    288:     }
1.22      albertel  289:     ($uname,$udom)=
1.29      albertel  290: 	&Apache::loncacc::constructaccess($env{'form.filename'},
1.22      albertel  291: 					  $r->dir_config('lonDefDomain'));
                    292:     unless (($uname) && ($udom)) {
                    293: 	$r->log_reason($uname.' at '.$udom.
1.29      albertel  294: 		       ' trying to publish file '.$env{'form.filename'}.
1.22      albertel  295: 		       ' - not authorized', 
                    296: 		       $r->filename); 
                    297: 	return HTTP_NOT_ACCEPTABLE;
                    298:     }
                    299:     
                    300:     my $fn;
1.29      albertel  301:     if ($env{'form.filename'}) {
                    302: 	$fn=$env{'form.filename'};
1.22      albertel  303: 	$fn=~s/^http\:\/\/[^\/]+\///;
                    304: 	$fn=~s/^\///;
                    305: 	$fn=~s/(\~|priv\/)(\w+)//;
                    306: 	$fn=~s/\/+/\//g;
                    307:     } else {
1.29      albertel  308: 	$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
1.22      albertel  309: 		       ' unspecified filename for upload', $r->filename); 
                    310: 	return HTTP_NOT_FOUND;
                    311:     }
1.1       www       312: 
                    313: # ----------------------------------------------------------- Start page output
                    314: 
                    315: 
1.22      albertel  316:     &Apache::loncommon::content_type($r,'text/html');
                    317:     $r->send_http_header;
1.1       www       318: 
1.25      raeburn   319:     $r->print("<html><head><title>LON-CAPA Construction Space</title><script type=\"text/javascript\">\n//<!--\n$javascript\n// --></script>\n</head>");
1.1       www       320: 
1.22      albertel  321:     $r->print(&Apache::loncommon::bodytag('Upload file to Construction Space'));
1.3       www       322:   
1.29      albertel  323:     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.22      albertel  324: 	$r->print('<h3><font color=red>'.&mt('Co-Author').': '.$uname.
                    325: 		  &mt(' at ').$udom.'</font></h3>');
                    326:     }
                    327: 
1.29      albertel  328:     if ($env{'form.phase'} eq 'two') {
1.22      albertel  329: 	&phasetwo($r,$fn,$uname,$udom);
                    330:     } else {
                    331: 	&phaseone($r,$fn,$uname,$udom);
                    332:     }
1.1       www       333: 
1.22      albertel  334:     $r->print('</body></html>');
                    335:     return OK;  
1.1       www       336: }
1.7       www       337: 
                    338: 1;
                    339: __END__
1.10      harris41  340: 
                    341: =head1 NAME
                    342: 
                    343: Apache::lonupload - upload files into construction space
                    344: 
                    345: =head1 SYNOPSIS
                    346: 
                    347: Invoked by /etc/httpd/conf/srm.conf:
                    348: 
                    349:  <Location /adm/upload>
                    350:  PerlAccessHandler       Apache::lonacc
                    351:  SetHandler perl-script
                    352:  PerlHandler Apache::lonupload
                    353:  ErrorDocument     403 /adm/login
                    354:  ErrorDocument     404 /adm/notfound.html
                    355:  ErrorDocument     406 /adm/unauthorized.html
                    356:  ErrorDocument	  500 /adm/errorhandler
                    357:  </Location>
                    358: 
                    359: =head1 INTRODUCTION
                    360: 
                    361: This module uploads a file sitting on a client computer into 
                    362: library server construction space.
                    363: 
                    364: This is part of the LearningOnline Network with CAPA project
                    365: described at http://www.lon-capa.org.
                    366: 
                    367: =head1 HANDLER SUBROUTINE
                    368: 
                    369: This routine is called by Apache and mod_perl.
                    370: 
                    371: =over 4
                    372: 
                    373: =item *
                    374: 
                    375: Initialize variables
                    376: 
                    377: =item *
                    378: 
                    379: Start page output
                    380: 
                    381: =item *
                    382: 
                    383: output relevant interface phase (phaseone or phasetwo)
                    384: 
                    385: =item *
                    386: 
                    387: (phase one is to specify upload file; phase two is to handle conditions
                    388: subsequent to specification--like overwriting an existing file)
                    389: 
                    390: =back
                    391: 
                    392: =head1 OTHER SUBROUTINES
                    393: 
                    394: =over 4
                    395: 
                    396: =item *
                    397: 
                    398: phaseone() : Interface for specifying file to upload.
                    399: 
                    400: =item *
                    401: 
                    402: phasetwo() : Interface for handling post-conditions about uploading (such
                    403: as overwriting an existing file).
                    404: 
                    405: =item *
                    406: 
                    407: upfile_store() : Store contents of uploaded file into temporary space.  Invoked
                    408: by phaseone subroutine.
                    409: 
                    410: =back
                    411: 
                    412: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>