--- loncom/publisher/loncfile.pm	2007/07/10 23:34:54	1.84
+++ loncom/publisher/loncfile.pm	2009/04/13 21:29:26	1.96
@@ -9,7 +9,7 @@
 #  and displays a page showing the results of the action.
 #
 #
-# $Id: loncfile.pm,v 1.84 2007/07/10 23:34:54 albertel Exp $
+# $Id: loncfile.pm,v 1.96 2009/04/13 21:29:26 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -109,6 +109,17 @@ sub Debug {
     }
 }
 
+sub done {
+   my ($url)=@_;
+   my $done=&mt("Done");
+   return(<<ENDDONE);
+<a href="$url">$done</a>
+<script type="text/javascript">
+location.href="$url";
+</script>
+ENDDONE
+}
+
 =pod
 
 =item URLToPath($url)
@@ -148,7 +159,7 @@ sub URLToPath {
     my $Url = shift;
     &Debug($r, "UrlToPath got: $Url");
     $Url=~ s/\/+/\//g;
-    $Url=~ s/^http\:\/\/[^\/]+//;
+    $Url=~ s/^https?\:\/\/[^\/]+//;
     $Url=~ s/^\///;
     $Url=~ s/(\~|priv\/)($match_username)\//\/home\/$2\/public_html\//;
     &Debug($r, "Returning $Url \n");
@@ -165,7 +176,7 @@ sub url {
 sub display {
     my $fn=shift;
     $fn=~s-^/home/($match_username)/public_html-/priv/$1-;
-    return '<tt>'.$fn.'</tt>';
+    return '<span class="LC_filename">'.$fn.'</span>';
 }
 
 
@@ -226,12 +237,16 @@ sub empty_directory {
 
 =over 4
 
-=item  $user   - string [in] - Name of the user for which to check.
+=item  $user     - string [in] - Name of the user for which to check.
 
-=item  $domain - string [in] - Name of the domain in which the resource
+=item  $domain   - string [in] - Name of the domain in which the resource
                           might have been published.
 
-=item  $file   - string [in] - Name of the file.
+=item  $file     - string [in] - Name of the file.
+
+=item  $creating - string [in] - optional, type of object being created,
+                               either 'directory' or 'file'. Defaults to
+                               'file' if unspecified.
 
 =back
 
@@ -251,7 +266,9 @@ Returns:
 =cut
 
 sub exists {
-    my ($user, $domain, $construct) = @_;
+    my ($user, $domain, $construct, $creating) = @_;
+    $creating ||= 'file';
+
     my $published=$construct;
     $published=~
 	s{^/home/$user/public_html/}{/home/httpd/html/res/$domain/$user/};
@@ -266,8 +283,15 @@ sub exists {
 	    $type = 'warning';
 	    $result.='<p><span class="LC_warning">'.&mt('Warning: target file exists, and has been published!').'</span></p>';
 	} else {
-	    $type = 'warning';
-	    $result.='<p><span class="LC_warning">'.&mt('Warning: a published file of this names exists.').'</span></p>';
+	    my $published_type = (-d $published) ? 'directory' : 'file';
+
+	    if ($published_type eq $creating) {
+		$type = 'warning';
+		$result.='<p><span class="LC_warning">'.&mt("Warning: a published $published_type of this name exists.").'</span></p>';
+	    } else {
+		$type = 'error';
+		$result.='<p><span class="LC_error">'.&mt("Error: a published $published_type of this name exists.").'</span></p>';
+	    }
 	}
     } elsif ( -e $construct) {
 	$type = 'warning';
@@ -328,6 +352,7 @@ sub cleanDest {
 	$foundbad=1;
 	$dest=~s/\.//g;
     }
+    $dest =~ s/(\s+$|^\s+)//g;
     if  ($dest=~/[\#\?&%\":]/) {
 	$foundbad=1;
 	$dest=~s/[\#\?&%\":]//g;
@@ -336,13 +361,20 @@ sub cleanDest {
 	my ($newpath)=($dest=~m|(.*)/|);
 	$newpath=&relativeDest($fn,$newpath,$uname);
 	if (! -d "$newpath") {
-	    $request->print("<p><span class=\"LC_error\">".&mt('You have requested to create file in directory [_1] which doesn\'t exist. The requested directory path has been removed from the requested file name.','"<tt>'.$newpath.'</tt>"')."</span></p>");
+	    $request->print('<p><span class="LC_error">'
+                           .&mt("You have requested to create file in directory [_1] which doesn't exist. The requested directory path has been removed from the requested file name."
+                               ,'"'.&display($newpath).'"')
+                           .'</span></p>');
 	    $dest=~s|.*/||;
 	}
     }
     if ($dest =~ /\.(\d+)\.(\w+)$/){
 	$request->print('<span class="LC_error">'
-			.&mt('Bad filename [_1].<br /> <tt>(name).(number).(extension)</tt> not allowed. <br /> Removing the <tt>.number.</tt> from requested filename.',$dest)
+			.&mt('Bad filename [_1]','<span class="LC_filename">'.&display($dest).'</span>')
+                        .'<br />'
+                        .&mt('[_1](name).(number).(extension)[_2] not allowed.','<tt>','</tt>')
+                        .'<br />'
+                        .&mt('Removing the [_1].number.[_2] from requested filename.','<tt>','</tt>')
 			.'</span>');
 	$dest =~ s/\.(\d+)(\.\w+)$/$2/;
     }
@@ -421,7 +453,7 @@ Parameters:
 
 sub CloseForm2 {
     my ($request, $user, $fn) = @_;
-    $request->print('<h3><a href="'.&url($fn).'/">'.&mt('Done').'</a></h3>');
+    $request->print(&done(&url($fn)));
 }
 
 =pod
@@ -514,7 +546,7 @@ sub Rename1 {
 	    $request->print('<input type="hidden" name="newfilename" value="'.
 			    $newfilename.
 			    '" /><p>'.$action.' '.&display($fn).
-			    '</tt><br />to '.&display($newfilename).'?</p>');
+			    '</p><br />to '.&display($newfilename).'?</p>');
 	    &CloseForm1($request, $fn);
 	} else {
 	    $request->print('<p>'.&mt('No new filename specified.').'</p></form>');
@@ -556,7 +588,7 @@ sub Delete1 {
 
     if( -e $fn) {
 	$request->print('<input type="hidden" name="newfilename" value="'.
-			$fn.'"/>');
+			$fn.'" />');
         if (-d $fn) {
             unless (&empty_directory($fn,'Delete1')) {
                 $request->print('<h3>'.&mt('Only empty directories may be deleted.').'</h3>'.
@@ -680,15 +712,15 @@ causes the newdir operation to transitio
 sub NewDir1 {
     my ($request, $username, $domain, $fn, $newfilename, $mode) = @_;
 
-    my ($type, $result)=&exists($username,$domain,$newfilename);
+    my ($type, $result)=&exists($username,$domain,$newfilename,'directory');
     $request->print($result);
-    if ($result) {
+    if ($type eq 'error') {
 	$request->print('</form>');
     } else {
 	if ($mode eq 'testbank') {
-	    $request->print('<input type="hidden" name="callingmode" value="testbank">');
+	    $request->print('<input type="hidden" name="callingmode" value="testbank" />');
 	} elsif ($mode eq 'imsimport') {
-	    $request->print('<input type="hidden" name="callingmode" value="imsimport">');
+	    $request->print('<input type="hidden" name="callingmode" value="imsimport" />');
 	}
 	$request->print('<input type="hidden" name="newfilename" value="'.
 			$newfilename.'" /><p>'.&mt('Make new directory').' '.
@@ -701,7 +733,7 @@ sub NewDir1 {
 sub Decompress1 {
     my ($request, $user, $domain, $fn) = @_;
     if( -e $fn) {
-   	$request->print('<input type="hidden" name="newfilename" value="'.$fn.'"/>');
+   	$request->print('<input type="hidden" name="newfilename" value="'.$fn.'" />');
    	$request->print('<p>'.&mt('Decompress').' '.&display($fn).'?</p>');
    	&CloseForm1($request, $fn);
     } else {
@@ -751,23 +783,10 @@ button which returns you to the driector
 
 sub NewFile1 {
     my ($request, $user, $domain, $fn, $newfilename) = @_;
+    return if (&filename_check($newfilename) ne 'ok');
 
     if ($env{'form.action'} =~ /new(.+)file/) {
 	my $extension=$1;
-
-        ##Informs User (name).(number).(extension) not allowed 
-	if($newfilename =~ /\.(\d+)\.(\w+)$/){
-	    $r->print('<span class="LC_error">'.$newfilename.
-		      ' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').') '.
-		      ' '.&mt('Not Allowed').'</span>');
-	    return;
-	}
-	if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){
-	    $r->print('<span class="LC_error">'.$newfilename.
-		      ' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '.
-		      ' '.&mt('Not Allowed').'</span>');
-	    return;
-	}
 	if ($newfilename !~ /\Q.$extension\E$/) {
 	    if ($newfilename =~ m|/[^/.]*\.(?:[^/.]+)$|) {
 		#already has an extension strip it and add in expected one
@@ -781,14 +800,57 @@ sub NewFile1 {
     if ($type eq 'error') {
 	$request->print('</form>');
     } else {
-	
+        my $extension;
+
+        if ($newfilename =~ m{[^/.]+\.([^/.]+)$}) {
+            $extension = $1;
+        }
+
+        my @okexts = qw(xml html xhtml htm xhtm problem page sequence rights sty library js css txt);
+        if (($extension eq '') || (!grep(/^\Q$extension\E/,@okexts))) {
+            my $validexts = '.'.join(', .',@okexts);
+            $request->print('<p class="LC_warning">'.
+                &mt('Invalid filename: ').&display($newfilename).'</p><p>'.
+                &mt('The name of the new file needs to end with an appropriate file extension to indicate the type of file to create.').'<br />'.
+                &mt('The following are valid extensions: [_1].',$validexts).
+                '</p></form><p>'.
+		'<form name="fileaction" action="/adm/cfile" method="post">'.
+                '<input type="hidden" name="qualifiedfilename" value="'.$fn.'" />'.
+		'<input type="hidden" name="action" value="newfile" />'.
+	        '<span class ="LC_nobreak">'.&mt('Enter a file name: ').'<input type="text" name="newfilename" value="Type Name Here" onfocus="if (this.value == '."'Type Name Here') this.value=''".'" />&nbsp;<input type="submit" value="Go" />'.
+                '</span></form></p>'.
+                '<p><form action="'.&url($fn).
+                '" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></form></p>');
+            return;
+        }
+
 	$request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>');
 	$request->print('</form>');
+
 	$request->print('<form action="'.&url($newfilename).
 			'" method="POST"><p><input type="submit" value="'.&mt('Continue').'" /></p></form>');
 	$request->print('<form action="'.&url($fn).
 			'" method="POST"><p><input type="submit" value="'.&mt('Cancel').'" /></p></form>');
     }
+    return;
+}
+
+sub filename_check {
+    my ($newfilename) = @_;
+    ##Informs User (name).(number).(extension) not allowed
+    if($newfilename =~ /\.(\d+)\.(\w+)$/){
+        $r->print('<span class="LC_error">'.$newfilename.
+                  ' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').') '.
+                  ' '.&mt('Not Allowed').'</span>');
+        return;
+    }
+    if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){
+        $r->print('<span class="LC_error">'.$newfilename.
+                  ' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '.
+                  ' '.&mt('Not Allowed').'</span>');
+        return;
+    }
+    return 'ok'; 
 }
 
 =pod
@@ -858,6 +920,7 @@ sub phaseone {
 	      $env{'form.action'} eq 'newsequencefile' ||
 	      $env{'form.action'} eq 'newrightsfile' ||
 	      $env{'form.action'} eq 'newstyfile' ||
+	      $env{'form.action'} eq 'newtaskfile' ||
               $env{'form.action'} eq 'newlibraryfile' ||
 	      $env{'form.action'} eq 'Select Action') {
         my $empty=&mt('Type Name Here');
@@ -1113,8 +1176,8 @@ sub NewDir2 {
 
 sub decompress2 {
     my ($r, $user, $dir, $file) = @_;
-    &Apache::lonnet::appenv('cgi.file' => $file);
-    &Apache::lonnet::appenv('cgi.dir' => $dir);
+    &Apache::lonnet::appenv({'cgi.file' => $file});
+    &Apache::lonnet::appenv({'cgi.dir' => $dir});
     my $result=&Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
     $r->print($result);
     &Apache::lonnet::delenv('cgi.file');
@@ -1241,7 +1304,7 @@ sub phasetwo {
             $r->print('<h3><a href="'.&url($dest).'">'.&mt('Return to Directory').'</a></h3>');
             $r->print('<h3><a href="'.&url($dest_newname).'">'.$disp_newname.'</a></h3>');
         } else {
-	    $r->print('<h3><a href="'.&url($dest).'">'.&mt('Done').'</a></h3>');
+	    $r->print(&done(&url($dest)));
 	}
     }
 }
@@ -1315,10 +1378,9 @@ sub handler {
 	$js = qq|
 <script type="text/javascript">
 function writeDone() {
-    var winName = window.opener
     window.focus();
-    winName.document.dataForm.newdir.value = "$newdirname"
-    setTimeout("self.close()",10000)
+    opener.document.info.newdir.value = "$newdirname";
+    setTimeout("self.close()",10000);
 }
   </script>
 |;
@@ -1332,8 +1394,10 @@ function writeDone() {
     $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');
   
     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
-	$r->print('<h3><span class="LC_error">'.&mt('Co-Author').': '.$uname.' at '.$udom.
-		  '</span></h3>');
+        $r->print('<p class="LC_warning">'
+                 .&mt('Co-Author [_1]:[_2]',$uname,$udom)
+                 .'</p>'
+        );
     }
 
 
@@ -1357,6 +1421,7 @@ function writeDone() {
 	     $env{'form.action'} eq 'newsequencefile' ||
 	     $env{'form.action'} eq 'newrightsfile' ||
 	     $env{'form.action'} eq 'newstyfile' ||
+	     $env{'form.action'} eq 'newtaskfile' ||
              $env{'form.action'} eq 'newlibraryfile' ||
 	     $env{'form.action'} eq 'Select Action' ) {
 	$r->print('<h3>'.&mt('New Resource').'</h3>');