--- loncom/publisher/loncfile.pm	2005/08/26 19:44:16	1.72
+++ 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.72 2005/08/26 19:44:16 albertel Exp $
+# $Id: loncfile.pm,v 1.88 2008/03/12 02:46:38 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -69,10 +69,11 @@ use File::Copy;
 use HTML::Entities();
 use Apache::Constants qw(:common :http :methods);
 use Apache::loncacc;
-use Apache::Log ();
 use Apache::lonnet;
 use Apache::loncommon();
 use Apache::lonlocal;
+use LONCAPA qw(:DEFAULT :match);
+
 
 my $DEBUG=0;
 my $r;				# Needs to be global for some stuff RF.
@@ -101,16 +102,9 @@ my $r;				# Needs to be global for some
 =cut
 
 sub Debug {
-  
-    # Marshall the parameters.
-  
-    my $r       = shift;
-    my $log     = $r->log;
-    my $message = shift;
-  
     # Put out the indicated message butonly if DEBUG is true.
-  
     if ($DEBUG) {
+	my ($r,$message) = @_;
 	$r->log_reason($message);
     }
 }
@@ -156,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>';
 }
 
 
@@ -195,20 +189,20 @@ sub obsolete_unpub {
 }
 
 # see if directory is empty
-# ignores any .meta, .save and .log files created for a previously
+# ignores any .meta, .save, .bak, and .log files created for a previously
 # published file, which has since been marked obsolete and deleted.
 sub empty_directory {
     my ($dirname,$phase) = @_;
     if (opendir DIR, $dirname) {
         my @files = grep(!/^\.\.?$/, readdir(DIR)); # ignore . and ..
         if (@files) { 
-            my @orphans = grep(/\.(meta|save|log)$/,@files);
+            my @orphans = grep(/\.(meta|save|log|bak)$/,@files);
             if (scalar(@files) - scalar(@orphans) > 0) { 
                 return 0;
             } else {
                 if (($phase eq 'Delete2') && (@orphans > 0)) {
                     foreach my $file (@orphans) {
-                        if ($file =~ /\.(meta|save|log)$/) {
+                        if ($file =~ /\.(meta|save|log|bak)$/) {
                             unlink($dirname.$file);
                         }
                     }
@@ -232,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
 
@@ -245,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.
@@ -254,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
@@ -306,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;
 }
@@ -321,6 +341,7 @@ sub cleanDest {
 	$foundbad=1;
 	$dest=~s/\.//g;
     }
+    $dest =~ s/(\s+$|^\s+)//g;
     if  ($dest=~/[\#\?&%\":]/) {
 	$foundbad=1;
 	$dest=~s/[\#\?&%\":]//g;
@@ -329,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;
 }
@@ -469,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;
 		}
@@ -481,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;
 	    }
@@ -501,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>');
@@ -609,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;
 	}
@@ -667,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">');
@@ -743,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).
@@ -842,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');
@@ -900,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.
@@ -974,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 {
@@ -990,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 {
@@ -1034,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;
@@ -1085,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;
@@ -1097,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');
@@ -1143,7 +1174,7 @@ sub phasetwo {
     
     &Debug($r, "loncfile - Entering phase 2 for $fn");
     
-    # Break down the file into it's component pieces.
+    # Break down the file into its component pieces.
     
     my $dir;		# Directory path
     my $main;		# Filename.
@@ -1156,8 +1187,10 @@ sub phasetwo {
 	$suffix=$1; #This is the actually filename extension if it exists
 	$main=~s/\.\w+$//; #strip the extension
     }
-    my $dest;                   # On success this is where we'll go.
-    
+    my $dest;                       #
+    my $dest_dir;                   # On success this is where we'll go.
+    my $disp_newname;               #
+    my $dest_newname;               #
     &Debug($r,"loncfile::phase2 dir = $dir main = $main suffix = $suffix");
     &Debug($r,"    newfilename = ".$env{'form.newfilename'});
 
@@ -1184,7 +1217,11 @@ sub phasetwo {
 	    if(!&Rename2($r, $uname, $dir, $fn, $env{'form.newfilename'})) {
 		return;
 	    }
-	    $dest = $env{'form.newfilename'};
+	    $dest = $dir."/";
+	    $dest_newname = $env{'form.newfilename'};
+	    $env{'form.newfilename'} =~ /.+(\/.+$)/;
+	    $disp_newname = $1;
+	    $disp_newname =~ s/\///;
 	}
     } elsif ($env{'form.action'} eq 'delete') { 
 	if(!&Delete2($r, $uname, $env{'form.newfilename'})) {
@@ -1215,7 +1252,12 @@ sub phasetwo {
     if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) {
 	$r->print('<h3><a href="javascript:self.close()">'.&mt('Done').'</a></h3>');
     } else {
-	$r->print('<h3><a href="'.&url($dest).'">'.&mt('Done').'</a></h3>');
+        if ($env{'form.action'} eq 'rename') {
+            $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>');
+	}
     }
 }
 
@@ -1237,12 +1279,12 @@ sub handler {
 
     if ($env{'form.filename'}) {
 	&Debug($r, "test: $env{'form.filename'}");
-	$fn=&Apache::lonnet::unescape($env{'form.filename'});
+	$fn=&unescape($env{'form.filename'});
 	$fn=&URLToPath($fn);
     }  elsif($ENV{'QUERY_STRING'} && $env{'form.phase'} ne 'two') {  
 	#Just hijack the script only the first time around to inject the
 	#correct information for further processing
-	$fn=&Apache::lonnet::unescape($env{'form.decompress'});
+	$fn=&unescape($env{'form.decompress'});
 	$fn=&URLToPath($fn);
 	$env{'form.action'}="decompress";
     } elsif ($env{'form.qualifiedfilename'}) {
@@ -1281,10 +1323,12 @@ sub handler {
     &Apache::loncommon::content_type($r,'text/html');
     $r->send_http_header;
 
+    my (%loaditem,$js);
+
     if ( ($env{'form.action'} eq 'newdir') && ($env{'form.phase'} eq 'two') && ( ($env{'form.callingmode'} eq 'testbank') || ($env{'form.callingmode'} eq 'imsimport') ) ) {
 	my $newdirname = $env{'form.newfilename'};
-	$r->print('<html><head><title>LON-CAPA Construction Space</title><script language="Javascript">');
-	$r->print(qq|
+	$js = qq|
+<script type="text/javascript">
 function writeDone() {
     var winName = window.opener
     window.focus();
@@ -1292,20 +1336,19 @@ function writeDone() {
     setTimeout("self.close()",10000)
 }
   </script>
-  </head>|);
-	my $loaditem = 'onLoad="writeDone()"';
-	$r->print(&Apache::loncommon::bodytag('Construction Space File Operation','',$loaditem));
-    } else {
-	$r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
-	$r->print(&Apache::loncommon::bodytag('Construction Space File Operation'));
+|;
+	$loaditem{'onload'} = "writeDone()";
     }
-
+    
+    $r->print(&Apache::loncommon::start_page('Construction Space File Operation',
+					     $js,
+					     {'add_entries' => \%loaditem,}));
   
     $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>');
     }
 
 
@@ -1329,11 +1372,13 @@ 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>');
     } else {
-	$r->print('<p>'.&mt('Unknown Action').' '.$env{'form.action'}.' </p></body></html>');
+	$r->print('<p>'.&mt('Unknown Action').' '.$env{'form.action'}.' </p>'.
+		  &Apache::loncommon::end_page());
 	return OK;  
     }
     if ($env{'form.phase'} eq 'two') {
@@ -1344,7 +1389,7 @@ function writeDone() {
 	&phaseone($r,$fn,$uname,$udom);
     }
 
-    $r->print('</body></html>');
+    $r->print(&Apache::loncommon::end_page());
     return OK;  
 }