--- loncom/publisher/lonupload.pm	2006/04/10 22:30:31	1.32
+++ loncom/publisher/lonupload.pm	2008/11/18 19:14:40	1.40
@@ -2,7 +2,7 @@
 # The LearningOnline Network with CAPA
 # Handler to upload files into construction space
 #
-# $Id: lonupload.pm,v 1.32 2006/04/10 22:30:31 albertel Exp $
+# $Id: lonupload.pm,v 1.40 2008/11/18 19:14:40 jms 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:
+
+ <Location /adm/upload>
+ 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
+ </Location>
+
+=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;
@@ -41,6 +127,7 @@ use Apache::lonnet;
 use HTML::Entities();
 use Apache::lonlocal;
 use Apache::lonnet;
+use LONCAPA();
 
 my $DEBUG=0;
 
@@ -70,7 +157,6 @@ sub upfile_store {
     return $datatoken;
 }
 
-
 sub phaseone {
     my ($r,$fn,$uname,$udom,$mode)=@_;
     my $action = '/adm/upload';
@@ -98,49 +184,44 @@ sub phaseone {
 		      '<input type="hidden" name="datatoken" value="'.
 		      &upfile_store.'" />'.
 		      '<input type="hidden" name="uploaduname" value="'.$uname.
-		      '" />'.&mt('Store uploaded file as ').
-                      "<tt>/priv/$uname/</tt>".
+		      '" />'.&mt('Save uploaded file as ').
+                      "<span class='LC_filename'>/priv/$uname/</span>".
                       '<input type="text" size="50" name="filename" value="'.$fn.
-                      '" /><br />');
-            $r->print('<br />'.&mt('Please indicate the type of file you are uploading. The possible types of file are as follows:').'
-<ul>
- <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>     
- <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>
-<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>
-</ul>
-<br />'.&mt('Choose file type:').'
+                      '" /><br />'.
+		      '<br />'.&mt('Choose file type:').'
 <select name="filetype">
  <option value="standard" selected>'.&mt('Regular file').'
  <option value="testbank">'.&mt('Testbank file').'
  <option value="imsimport">'.&mt('IMS package').'
-</select>
+</select>'.&Apache::loncommon::help_open_topic("Uploading_File_Options").'
 <br />
 <br />
 ');
-            $r->print('<input type="button" value="'.&mt('Store').'" onClick="javascript:verifyForm()"/></form>');
+            $r->print('<input type="button" value="'.&mt('Save').'" onClick="javascript:verifyForm()"/></form>');
 	    # Check for bad extension and warn user
 	    if ($fn=~/\.(\w+)$/ && 
 		(&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
-		$r->print('<font color="red">'.&mt('The extension on this file,').
+		$r->print('<span class="LC_error">'.&mt('The extension on this file,').
 			  ' "'.$1.'"'.&mt(', is reserved internally by LON-CAPA.').
-			  ' <br />'.&mt('Please change the extension.').'</font>');
+			  ' <br />'.&mt('Please change the extension.').'</span>');
 	    } elsif($fn=~/\.(\w+)$/ && 
 		    !defined(&Apache::loncommon::fileembstyle($1))) {
-		$r->print('<font color="red">'.&mt('The extension on this file,').
+		$r->print('<span class="LC_error">'.&mt('The extension on this file,').
 			  ' "'.$1.'"'.&mt(', is not recognized by LON-CAPA.').
 			  ' <br />'.&mt('Please change the extension.').
-			  '</font>');
+			  '</span>');
 	    }
 	} else {
-	    $r->print('<font color="red">'.&mt('Illegal filename.').'</font>');
+	    $r->print('<span class="LC_error">'.&mt('Illegal filename.').'</span>');
 	}
     } else {
-	$r->print('<font color="red">'.&mt('No upload file specified.').'</font>');
+	$r->print('<span class="LC_error">'.&mt('No upload file specified.').'</span>');
     }
 }
 
 sub phasetwo {
     my ($r,$tfn,$uname,$udom,$mode)=@_;
+    my $output;
     my $action = '/adm/upload';
     my $returnflag = '';
     if ($mode eq 'testbank') {
@@ -163,73 +244,131 @@ sub phasetwo {
 	&Debug($r, "URL is now ".$url);
 	my $datatoken=$env{'form.datatoken'};
 	if (($fn) && ($datatoken)) {
-	    if ((-e $target) && ($env{'form.override'} ne 'Yes')) {
-		$r->print('<form action="'.$action.'" method="post">'.
-			  &mt('File').' <tt>'.$fn.'</tt> '.
-			  &mt('exists. Overwrite?').' '.
+            if ($env{'form.cancel'}) {
+                my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
+                my $dirpath=$path.'/';
+                $dirpath=~s/\/+/\//g;
+                $output .= &mt('Upload cancelled.').'<br /><font size="+2"><a href="'.$dirpath.'">'.
+                          &mt('Back to Directory').'</a></font>';
+	    } elsif ((-e $target) && (!$env{'form.override'})) {
+		$output .= '<form action="'.$action.'" method="post">'.
+			  &mt('File [_1] exists. Overwrite?','<span class="LC_filename">'.$fn.'</span>').
 			  '<input type="hidden" name="phase" value="two" />'.
-			  '<input type="hidden" name="filename" value="'."$url".'" />'.
+			  '<input type="hidden" name="filename" value="'.$url.'" />'.
 			  '<input type="hidden" name="datatoken" value="'.$datatoken.'" />'.
-			  '<input type="submit" name="override" value="'.&mt('Yes').'" /></form>');
-	    } else {
+			  '<input type="submit" name="override" value="'.&mt('Yes').'" />'.
+                          '<input type="submit" name="cancel" value="'.&mt('Cancel').'" />'.
+                          '</form>';
+            } 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').' <tt>'.$fn.'</tt> '.
-			      &mt('could not be copied.').'<br />'.
-			      '<font color="red">'.
-			      &mt('The extension on this file is reserved internally by LON-CAPA.').
-			      '</font>');
-		    $r->print('<br /><font size=+2><a href="'.$dirpath.'">'.
-			      &mt('Back to Directory').'</a></font>');
-		} elsif ($fn=~/\.(\w+)$/ && 
-			 !defined(&Apache::loncommon::fileembstyle($1))) {
-		    $r->print(&mt('File').' <tt>'.$fn.'</tt> '.
-			      &mt('could not be copied.').'<br />'.
-			      '<font color="red">'.
-			      &mt('The extension on this file is not recognized by LON-CAPA.').
-			      '</font>');
-		    $r->print('<br /><font size="+2"><a href="'.$dirpath.'">'.
-			      &mt('Back to Directory').'</a></font>');
-		} elsif (-d $target) {
-		    $r->print('File <tt>'.$fn.'</tt> could not be copied.<br />'.
-			      '<font color="red">'.
-			      &mt('The target is an existing directory.').
-			      '</font><br />');
-		    $r->print('<font size="+2"><a href="'.$dirpath.'">'.
-			      &mt('Back to Directory').'</a></font>');
-		} 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")."<br /><br />");
-                        $returnflag = 'ok';
-                    } else {
-                        $r->print(&mt('File copied.'));
-		        $r->print('<br /><font size="+2"><a href="'.$url.'">'.
-			      &mt('View file').'</a></font>');
-		        $r->print('<br /><font size="+2"><a href="'.$dirpath.'">'.
-			      &mt('Back to Directory').'</a></font><br />');
-                    }
-		} else {
-		    $r->print('Failed to copy: '.$!);
-		    $r->print('<br /><font size="+2"><a href="'.$path.'">'.
-			      &mt('Back to Directory').'</a></font>');
-		}
+                my $result;
+                ($result,$returnflag) = &check_extension($fn,$mode,$source,$target,$action,$dirpath,$url);
+                $output .= $result;
 	    }
 	} else {
-	    $r->print('<font size="+1" color="red">'.
+	    $output .= '<span class="LC_error">'.
 		      &mt('Please use browser "Back" button and pick a filename').
-		      '</font><br />');
+		      '</span><br />';
 	}
     } else {
-	$r->print('<font size=+1 color=red>'.
-		  &mt('Please use browser "Back" button and pick a filename').
-		  '</font><br />>');
+	$output .= '<span class="LC_error">'.
+		   &mt('Please use browser "Back" button and pick a filename').
+		   '</span><br />';
+    }
+    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.',
+                      '<span class="LC_filename">'.$fn.'</span> ').
+                  '<br /><span class="LC_error">'.
+                  &mt('The extension on this file is reserved internally by LON-CAPA.').
+                  '</span>';
+    } elsif ($fn=~/\.(\w+)$/ &&
+             !defined(&Apache::loncommon::fileembstyle($1))) {
+        $result .= &mt('File [_1] could not be copied.',
+                      '<span class="LC_filename">'.$fn.'</span> ').
+                  '<br /><span class="LC_error">'.
+                  &mt('The extension on this file is not recognized by LON-CAPA.').
+                  '</span>';
+    } elsif (-d $target) {
+        $result .= &mt('File [_1] could not be copied.',
+                      '<span class="LC_filename">'.$fn.'</span>').
+                  '<br /><span class="LC_error">'.
+                  &mt('The target is an existing directory.').
+                  '</span>';
+    } 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).'<br /><br />';
+        } else {
+            $result .= &mt('File copied.').'<br />';
+        }
+        # 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;
+    <input type="hidden" name="action"      value="upload_embedded" />
+    <input type="hidden" name="currentpath" value="$env{'form.currentpath'}" />
+    <input type="hidden" name="mode"        value="$mode" />
+    <input type="hidden" name="phase"       value="three" />
+    <input type="hidden" name="filename" value="$url" />
+STATE
+                $result .= "<h3>".&mt("Reference Warning")."</h3>".
+                           "<p>".&mt("Completed upload of the file. This file contained references to other files.")."</p>".
+                          "<p>".&mt("Please select the locations from which the referenced files are to be uploaded.")."</p>".
+                          &Apache::loncommon::ask_for_embedded_content($action,$state,\%allfiles,\%codebase,
+                                      {'error_on_invalid_names'   => 1,
+                                       'ignore_remote_references' => 1,});
+                if ($mode eq 'testbank') {
+                    $returnflag = 'embedded';
+                    $result .=  '<p>'.&mt('Or [_1]continue[_2] the testbank import without these files','<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
+                }
+            }
+        }
+        if (($mode ne 'imsimport') && ($mode ne 'testbank')) {
+            $result .= '<br /><font size="+2"><a href="'.$url.'">'.
+                        &mt('View file').'</a></font>';
+        }
+    } else {
+        $result .= &mt('Failed to copy: [_1].',$!);
+    }
+    if ($mode ne 'imsimport' && $mode ne 'testbank') {
+        $result .= '<br /><font size="+2"><a href="'.$dirpath.'">'.
+                   &mt('Back to Directory').'</a></font><br />';
     }
-    return $returnflag;
+    return ($result,$returnflag);
+}
+
+sub phasethree {
+    my ($r,$fn,$uname,$udom,$mode) = @_;
+    my $result;
+    my $dir_root = '/home/'.$uname.'/public_html';
+    my $url_root = '/priv/'.$uname;
+    my $base = &File::Basename::basename($fn);
+    my $path = &File::Basename::dirname($fn);
+    $result = &Apache::loncommon::upload_embedded($mode,$path,$uname,$udom,
+                                                  $dir_root,$url_root);
+    if ($mode ne 'imsimport' && $mode ne 'testbank') {
+        $result = '<br /><font size="+2"><a href="'.$url_root.$fn.'">'.
+                  &mt('View main file').'</a></font>'.
+                  '<br /><font size="+2"><a href="'.$url_root.$path.'">'.
+                  &mt('Back to Directory').'</a></font><br />';
+    }
+    return $result;
 }
 
 # ---------------------------------------------------------------- Main Handler
@@ -249,20 +388,6 @@ sub handler {
     }
 
     unless ($env{'form.phase'} eq 'two') {
-	my %body_layout = ('rightmargin'  => "0",
-			   'leftmargin'   => "0",
-			   'marginwidth'  => "0",
-			   'topmargin'    => "0",
-			   'marginheight' => "0");
-	my $start_page = 
-	    &Apache::loncommon::start_page('Importing a Testbank file into LON-CAPA',
-					   undef,
-					   {'only_body'   => 1,
-					    'add_entries' => \%body_layout,
-					    'js_ready'    => 1,});
-	my $end_page = 
-	    &Apache::loncommon::end_page({'js_ready' => 1,});
-
         $javascript = qq|
 function verifyForm() {
     var mode = document.fileupload.filetype.options[document.fileupload.filetype.selectedIndex].value
@@ -277,32 +402,12 @@ function verifyForm() {
     }
     document.fileupload.submit();
 }
-
-function testbankWin() {
-  newWindow = window.open("","testbankinfo","HEIGHT=400,WIDTH=750,scrollbars=yes")
-  newWindow.document.open()
-  newWindow.document.write('$start_page')
-  newWindow.document.write("<img border='0' src='/adm/lonInterFace/author.jpg' alt='[Author Header]'>\\n")
-  newWindow.document.write("<table border='0' cellspacing='0' cellpadding='0' width='95%' bgcolor='#CCFFDD'>\\n")
-  newWindow.document.write("<tr><td width='2'>&nbsp;</td><td width='3'>&nbsp;</td>\\n")
-  newWindow.document.write("<td><font face='arial,helvetica,sans-serif'><h3>Importing Testbank questions into LON-CAPA</h3>")
-  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.")
-  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>")
-  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>")
-   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.")
-    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>")
-     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>")
-  newWindow.document.write("</td></tr>\\n")
-  newWindow.document.write("</table>")
-  newWindow.document.write('$end_page')
-  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'}.
@@ -316,7 +421,7 @@ function testbankWin() {
 	$fn=$env{'form.filename'};
 	$fn=~s/^http\:\/\/[^\/]+\///;
 	$fn=~s/^\///;
-	$fn=~s/(\~|priv\/)(\w+)//;
+	$fn=~s{(~|priv/)($LONCAPA::username_re)}{};
 	$fn=~s/\/+/\//g;
     } else {
 	$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
@@ -337,12 +442,16 @@ function testbankWin() {
 					     $javascript));
   
     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
-	$r->print('<h3><font color=red>'.&mt('Co-Author').': '.$uname.
-		  &mt(' at ').$udom.'</font></h3>');
+	$r->print('<h3><span class="LC_error">'.&mt('Co-Author').': '.$uname.
+		  &mt(' at ').$udom.'</span></h3>');
     }
 
-    if ($env{'form.phase'} eq 'two') {
-	&phasetwo($r,$fn,$uname,$udom);
+    if ($env{'form.phase'} eq 'three') {
+        my $output = &phasethree($r,$fn,$uname,$udom,'author');
+        $r->print($output);
+    } elsif ($env{'form.phase'} eq 'two') {
+	my ($output,$returnflag) = &phasetwo($r,$fn,$uname,$udom);
+        $r->print($output);
     } else {
 	&phaseone($r,$fn,$uname,$udom);
     }
@@ -354,75 +463,4 @@ function testbankWin() {
 1;
 __END__
 
-=head1 NAME
-
-Apache::lonupload - upload files into construction space
 
-=head1 SYNOPSIS
-
-Invoked by /etc/httpd/conf/srm.conf:
-
- <Location /adm/upload>
- 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
- </Location>
-
-=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)
-
-=item *
-
-(phase one is to specify upload file; phase two is to handle conditions
-subsequent to specification--like overwriting an existing file)
-
-=back
-
-=head1 OTHER SUBROUTINES
-
-=over 4
-
-=item *
-
-phaseone() : Interface for specifying file to upload.
-
-=item *
-
-phasetwo() : Interface for handling post-conditions about uploading (such
-as overwriting an existing file).
-
-=item *
-
-upfile_store() : Store contents of uploaded file into temporary space.  Invoked
-by phaseone subroutine.
-
-=back
-
-=cut