--- loncom/publisher/loncfile.pm	2006/12/20 22:41:08	1.80
+++ loncom/publisher/loncfile.pm	2009/01/29 11:50:32	1.93
@@ -9,7 +9,7 @@
 #  and displays a page showing the results of the action.
 #
 #
-# $Id: loncfile.pm,v 1.80 2006/12/20 22:41:08 albertel Exp $
+# $Id: loncfile.pm,v 1.93 2009/01/29 11:50:32 bisitz 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
 
@@ -239,6 +254,9 @@ Returns:
 
 =over 4
 
+=item  string - Either undef, 'warning' or 'error' depending on the
+                type of problem
+
 =item  string - Either where the resource exists as an html string that can
            be embedded in a dialog or an empty string if the resource
            does not exist.
@@ -248,20 +266,39 @@ 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\//;
-    my $result='';    
+	s{^/home/$user/public_html/}{/home/httpd/html/res/$domain/$user/};
+    my ($type,$result);
     if ( -d $construct ) {
-	return &mt('Error: destination for operation is an existing directory.');
+	return ('error','<p><span class="LC_error">'.&mt('Error: destination for operation is an existing directory.').'</span></p>');
+	
     }
+
     if ( -e $published) {
-	$result.='<p><font color="red">'.&mt('Warning: target file exists, and has been published!').'</font></p>';
+	if ( -e $construct ) {
+	    $type = 'warning';
+	    $result.='<p><span class="LC_warning">'.&mt('Warning: target file exists, and has been published!').'</span></p>';
+	} else {
+	    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) {
-	$result.='<p><font color="red">'.&mt('Warning: target file exists!').'</font></p>';
+	$type = 'warning';
+	$result.='<p><span class="LC_warning">'.&mt('Warning: target file exists!').'</span></p>';
     }
-    return $result;
+
+    return ($type,$result);
 }
 
 =pod
@@ -300,9 +337,9 @@ sub checksuffix {
     my $newsuffix;
     if ($new=~m:(.*/*)([^/]+)\.(\w+)$:) { $newsuffix=$3; }
     if ($old=~m:(.*)/+([^/]+)\.(\w+)$:) { $oldsuffix=$3; }
-    if ($oldsuffix ne $newsuffix) {
+    if (lc($oldsuffix) ne lc($newsuffix)) {
 	$result.=
-            '<p><font color="red">'.&mt('Warning: change of MIME type!').'</font></p>';
+            '<p><span class="LC_warning">'.&mt('Warning: change of MIME type!').'</span></p>';
     }
     return $result;
 }
@@ -315,6 +352,7 @@ sub cleanDest {
 	$foundbad=1;
 	$dest=~s/\.//g;
     }
+    $dest =~ s/(\s+$|^\s+)//g;
     if  ($dest=~/[\#\?&%\":]/) {
 	$foundbad=1;
 	$dest=~s/[\#\?&%\":]//g;
@@ -323,12 +361,25 @@ sub cleanDest {
 	my ($newpath)=($dest=~m|(.*)/|);
 	$newpath=&relativeDest($fn,$newpath,$uname);
 	if (! -d "$newpath") {
-	    $request->print("<p><font color=\"red\">".&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>"')."</font></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]','<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/;
+    }
     if ($foundbad) {
-	$request->print("<p><font color=\"red\">".&mt('Invalid characters in requested name have been removed.')."</font></p>");
+	$request->print("<p><span class=\"LC_error\">".&mt('Invalid characters in requested name have been removed.')."</span></p>");
     }
     return $dest;
 }
@@ -402,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
@@ -463,9 +514,9 @@ sub Rename1 {
 	    if (-d $fn) {
 		$newfilename=~/\.(\w+)$/;
 		if (&Apache::loncommon::fileembstyle($1) eq 'ssi') {
-		    $request->print('<br /><font color="red">'.
+		    $request->print('<br /><span classr="LC_warning">'.
 				    &mt('Cannot change MIME type of a directory').
-				    '</font>'.
+				    '</span>'.
 				    '<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
 		    return;
 		}
@@ -475,9 +526,9 @@ sub Rename1 {
 	    while ($newfilename=~m:/\.\./:) {
 		$newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
 	    }
-	    my $return=&exists($user, $domain, $newfilename);
+	    my ($type, $return)=&exists($user, $domain, $newfilename);
 	    $request->print($return);
-	    if ($return =~/^Error:/) {
+	    if ($type eq 'error') {
 		$request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
 		return;
 	    }
@@ -495,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>');
@@ -603,9 +654,9 @@ sub Copy1 {
 	    $newfilename=~ s:/[^/]+/\.\./:/:g; #remove dir/..
 	}
 	$request->print(&checksuffix($fn,$newfilename));
-	my $return=&exists($user, $domain, $newfilename);
+	my ($type,$return)=&exists($user, $domain, $newfilename);
 	$request->print($return);
-	if ($return =~/^Error:/) {
+	if ($type eq 'error') {
 	    $request->print('<br /><a href="'.&url($fn).'">'.&mt('Cancel').'</a>');
 	    return;
 	}
@@ -661,9 +712,10 @@ causes the newdir operation to transitio
 sub NewDir1 {
     my ($request, $username, $domain, $fn, $newfilename, $mode) = @_;
 
-    my $result=&exists($username,$domain,$newfilename);
-    if ($result) {
-	$request->print('<font color="red">'.$result.'</font></form>');
+    my ($type, $result)=&exists($username,$domain,$newfilename,'directory');
+    $request->print($result);
+    if ($type eq 'error') {
+	$request->print('</form>');
     } else {
 	if ($mode eq 'testbank') {
 	    $request->print('<input type="hidden" name="callingmode" value="testbank">');
@@ -737,29 +789,31 @@ sub NewFile1 {
 
         ##Informs User (name).(number).(extension) not allowed 
 	if($newfilename =~ /\.(\d+)\.(\w+)$/){
-	    $r->print('<font color="red">'.$newfilename.
+	    $r->print('<span class="LC_error">'.$newfilename.
 		      ' - '.&mt('Bad Filename').'<br />('.&mt('name').').('.&mt('number').').('.&mt('extension').') '.
-		      ' '.&mt('Not Allowed').'</font>');
+		      ' '.&mt('Not Allowed').'</span>');
 	    return;
 	}
 	if($newfilename =~ /(\:\:\:|\&\&\&|\_\_\_)/){
-	    $r->print('<font color="red">'.$newfilename.
+	    $r->print('<span class="LC_error">'.$newfilename.
 		      ' - '.&mt('Bad Filename').'<br />('.&mt('Must not include').' '.$1.') '.
-		      ' '.&mt('Not Allowed').'</font>');
+		      ' '.&mt('Not Allowed').'</span>');
 	    return;
 	}
 	if ($newfilename !~ /\Q.$extension\E$/) {
-	    if ($newfilename =~ m|^[^\.]*\.([^\.]+)$|) {
+	    if ($newfilename =~ m|/[^/.]*\.(?:[^/.]+)$|) {
 		#already has an extension strip it and add in expected one
-		$newfilename =~ s|.([^\.]+)$||;
+		$newfilename =~ s|(/[^./])\.(?:[^.]+)$|$1|;
 	    }
 	    $newfilename.=".$extension";
 	}
     }
-    my $result=&exists($user,$domain,$newfilename);
-    if($result) {
-	$request->print('<font color="red">'.$result.'</font></form>');
+    my ($type, $result)=&exists($user,$domain,$newfilename);
+    $request->print($result);
+    if ($type eq 'error') {
+	$request->print('</form>');
     } else {
+	
 	$request->print('<p>'.&mt('Make new file').' '.&display($newfilename).'?</p>');
 	$request->print('</form>');
 	$request->print('<form action="'.&url($newfilename).
@@ -836,6 +890,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');
@@ -894,7 +949,7 @@ sub Rename2 {
 	my $oRN=$oldfile;
 	my $nRN=$newfile;
 	unless (rename($oldfile,$newfile)) {
-	    $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
+	    $request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
 	    return 0;
 	}
 	## If old name.(extension) exits, move under new name.
@@ -968,12 +1023,12 @@ sub Delete2 {
     my ($request, $user, $filename) = @_;
     if (-d $filename) { 
 	unless (&empty_directory($filename,'Delete2')) { 
-	    $request->print('<font color="red"> '.&mt('Error: Directory Non Empty').'</font>'); 
+	    $request->print('<span class="LC_error">'.&mt('Error: Directory Non Empty').'</span>'); 
 	    return 0;
 	} else {   
 	    if(-e $filename) {
 		unless(rmdir($filename)) {
-		    $request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
+		    $request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
 		    return 0;
 		}
 	    } else {
@@ -984,7 +1039,7 @@ sub Delete2 {
     } else {
 	if(-e $filename) {
 	    unless(unlink($filename)) {
-		$request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
+		$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
 		return 0;
 	    }
 	} else {
@@ -1028,20 +1083,20 @@ sub Copy2 {
     &Debug($request ,"Will try to copy $oldfile to $newfile");
     if(-e $oldfile) {
         if ($oldfile eq $newfile) {
-            $request->print('<font color="red"> '.&mt('Warning').': '.&mt('Name of new file is the same as name of old file').' - '.&mt('no action taken').'.</font>');
+            $request->print('<span class="LC_error">'.&mt('Warning').': '.&mt('Name of new file is the same as name of old file').' - '.&mt('no action taken').'.</span>');
             return 1;
         }
 	unless (copy($oldfile, $newfile)) {
-	    $request->print('<font color="red"> '.&mt('copy Error').': '.$!.'</font>');
+	    $request->print('<span class="LC_error">'.&mt('copy Error').': '.$!.'</span>');
 	    return 0;
 	} elsif (!chmod(0660, $newfile)) {
-	    $request->print('<font color="red"> '.&mt('chmod error').': '.$!.'</font>');
+	    $request->print('<span class="LC_error">'.&mt('chmod error').': '.$!.'</span>');
 	    return 0;
 	} elsif (-e $oldfile.'.meta' && 
 		 !copy($oldfile.'.meta', $newfile.'.meta') &&
 		 !chmod(0660, $newfile.'.meta')) {
-	    $request->print('<font color="red"> '.&mt('copy metadata error').
-			    ': '.$!.'</font>');
+	    $request->print('<span class="LC_error">'.&mt('copy metadata error').
+			    ': '.$!.'</span>');
 	    return 0;
 	} else {
 	    return 1;
@@ -1079,11 +1134,11 @@ sub NewDir2 {
     my ($request, $user, $newdirectory) = @_;
   
     unless(mkdir($newdirectory, 02770)) {
-	$request->print('<font color="red">'.&mt('Error').': '.$!.'</font>');
+	$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
 	return 0;
     }
     unless(chmod(02770, ($newdirectory))) {
-	$request->print('<font color="red"> '.&mt('Error').': '.$!.'</font>');
+	$request->print('<span class="LC_error">'.&mt('Error').': '.$!.'</span>');
 	return 0;
     }
     return 1;
@@ -1091,8 +1146,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');
@@ -1219,7 +1274,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)));
 	}
     }
 }
@@ -1293,10 +1348,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>
 |;
@@ -1310,8 +1364,8 @@ function writeDone() {
     $r->print('<h3>'.&mt('Location').': '.&display($fn).'</h3>');
   
     if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
-	$r->print('<h3><font color="red">'.&mt('Co-Author').': '.$uname.' at '.$udom.
-		  '</font></h3>');
+	$r->print('<h3><span class="LC_error">'.&mt('Co-Author').': '.$uname.' at '.$udom.
+		  '</span></h3>');
     }
 
 
@@ -1335,6 +1389,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>');