--- loncom/publisher/loncfile.pm	2006/11/23 01:50:57	1.79
+++ loncom/publisher/loncfile.pm	2008/03/12 02:46:38	1.88
@@ -9,7 +9,7 @@
 #  and displays a page showing the results of the action.
 #
 #
-# $Id: loncfile.pm,v 1.79 2006/11/23 01:50:57 banghart Exp $
+# $Id: loncfile.pm,v 1.88 2008/03/12 02:46:38 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -72,9 +72,8 @@ use Apache::loncacc;
 use Apache::lonnet;
 use Apache::loncommon();
 use Apache::lonlocal;
-use lib '/home/httpd/lib/perl/';
-use LONCAPA;
- 
+use LONCAPA qw(:DEFAULT :match);
+
 
 my $DEBUG=0;
 my $r;				# Needs to be global for some stuff RF.
@@ -151,22 +150,22 @@ sub URLToPath {
     $Url=~ s/\/+/\//g;
     $Url=~ s/^http\:\/\/[^\/]+//;
     $Url=~ s/^\///;
-    $Url=~ s/(\~|priv\/)(\w+)\//\/home\/$2\/public_html\//;
+    $Url=~ s/(\~|priv\/)($match_username)\//\/home\/$2\/public_html\//;
     &Debug($r, "Returning $Url \n");
     return $Url;
 }
 
 sub url {
     my $fn=shift;
-    $fn=~s/^\/home\/(\w+)\/public\_html/\/priv\/$1/;
+    $fn=~s/^\/home\/($match_username)\/public\_html/\/priv\/$1/;
     $fn=&HTML::Entities::encode($fn,'<>"&');
     return $fn;
 }
 
 sub display {
     my $fn=shift;
-    $fn=~s-^/home/(\w+)/public_html-/priv/$1-;
-    return '<tt>'.$fn.'</tt>';
+    $fn=~s-^/home/($match_username)/public_html-/priv/$1-;
+    return '<span class="LC_filename">'.$fn.'</span>';
 }
 
 
@@ -227,12 +226,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
 
@@ -240,6 +243,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.
@@ -249,20 +255,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
@@ -301,9 +326,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;
 }
@@ -316,6 +341,7 @@ sub cleanDest {
 	$foundbad=1;
 	$dest=~s/\.//g;
     }
+    $dest =~ s/(\s+$|^\s+)//g;
     if  ($dest=~/[\#\?&%\":]/) {
 	$foundbad=1;
 	$dest=~s/[\#\?&%\":]//g;
@@ -324,12 +350,18 @@ 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].<br /> <tt>(name).(number).(extension)</tt> not allowed. <br /> Removing the <tt>.number.</tt> from requested filename.',&display($dest))
+			.'</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;
 }
@@ -464,9 +496,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;
 		}
@@ -476,9 +508,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;
 	    }
@@ -496,7 +528,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>');
@@ -604,9 +636,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;
 	}
@@ -662,9 +694,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">');
@@ -738,29 +771,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).
@@ -837,6 +872,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');
@@ -895,7 +931,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.
@@ -969,12 +1005,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 {
@@ -985,7 +1021,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 {
@@ -1029,20 +1065,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;
@@ -1080,11 +1116,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;
@@ -1092,8 +1128,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');
@@ -1311,8 +1347,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>');
     }
 
 
@@ -1336,6 +1372,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>');