--- loncom/publisher/lonpublisher.pm	2003/02/03 18:03:53	1.108
+++ loncom/publisher/lonpublisher.pm	2003/03/14 16:02:49	1.117
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Publication Handler
 #
-# $Id: lonpublisher.pm,v 1.108 2003/02/03 18:03:53 harris41 Exp $
+# $Id: lonpublisher.pm,v 1.117 2003/03/14 16:02:49 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -117,7 +117,6 @@ use File::Copy;
 use Apache::Constants qw(:common :http :methods);
 use HTML::LCParser;
 use Apache::lonxml;
-use Apache::lonhomework;
 use Apache::loncacc;
 use DBI;
 use Apache::lonnet();
@@ -790,6 +789,10 @@ This is the workhorse function of this m
 backup copies, performs any automatic processing (prior to publication,
 especially for rat and ssi files),
 
+Returns a 2 element array, the first is the string to be shown to the
+user, the second is an error code, either 1 (an error occured) or 0
+(no error occurred)
+
 I<Additional documentation needed.>
 
 =cut
@@ -806,8 +809,7 @@ sub publish {
     my %allow=();
 
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
-	return 
-         '<font color=red>No write permission to user directory, FAIL</font>';
+	return ('<font color="red">No write permission to user directory, FAIL</font>',1);
     }
     print $logfile 
 "\n\n================= Publish ".localtime()." Phase One  ================\n";
@@ -821,14 +823,14 @@ sub publish {
 	    print $logfile "Copied original file to ".$copyfile."\n";
         } else {
 	    print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";
-          return "<font color=red>Failed to write backup copy, $!,FAIL</font>";
+	    return ("<font color=\"red\">Failed to write backup copy, $!,FAIL</font>",1);
         }
 # ------------------------------------------------------------- IDs and indices
 	
 	my ($outstring,$error);
 	($outstring,$error,%allow)=&fix_ids_and_indices($logfile,$source,
 							$target);
-	if ($error) { return $outstring; }
+	if ($error) { return ($outstring,$error); }
 # ------------------------------------------------------------ Construct Allows
     
 	$scrout.='<h3>Dependencies</h3>';
@@ -873,9 +875,8 @@ sub publish {
           my $org;
           unless ($org=Apache::File->new('>'.$source)) {
              print $logfile "No write permit to $source\n";
-             return 
-		 '<font color="red">No write permission to '.$source.
-		 ', FAIL</font>';
+             return ('<font color="red">No write permission to '.$source.
+		     ', FAIL</font>',1);
 	  }
           print($org $outstring);
         }
@@ -956,90 +957,87 @@ sub publish {
     }
 # ---------------- Find and document discrepancies in the parameters and stores
 
-        my $chparms='';
-        foreach (sort keys %metadatafields) {
-	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
-                unless ($_=~/\.\w+$/) { 
-                   unless ($oldparmstores{$_}) {
-		      print $logfile 'New: '.$_."\n";
-                      $chparms.=$_.' ';
-                   }
-	        }
-            }
-        }
-        if ($chparms) {
-	    $scrout.='<p><b>New parameters or stored values:</b> '.
-                     $chparms;
-        }
+    my $chparms='';
+    foreach (sort keys %metadatafields) {
+	if (($_=~/^parameter/) || ($_=~/^stores/)) {
+	    unless ($_=~/\.\w+$/) { 
+		unless ($oldparmstores{$_}) {
+		    print $logfile 'New: '.$_."\n";
+		    $chparms.=$_.' ';
+		}
+	    }
+	}
+    }
+    if ($chparms) {
+	$scrout.='<p><b>New parameters or stored values:</b> '.$chparms;
+    }
 
-        $chparms='';
-        foreach (sort keys %oldparmstores) {
-	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
-                unless (($metadatafields{$_.'.name'}) ||
-                        ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {
-		    print $logfile 'Obsolete: '.$_."\n";
-                    $chparms.=$_.' ';
-                }
-            }
-        }
-        if ($chparms) {
-	    $scrout.='<p><b>Obsolete parameters or stored values:</b> '.
-                     $chparms;
-        }
+    $chparms='';
+    foreach (sort keys %oldparmstores) {
+	if (($_=~/^parameter/) || ($_=~/^stores/)) {
+	    unless (($metadatafields{$_.'.name'}) ||
+		    ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {
+		print $logfile 'Obsolete: '.$_."\n";
+		$chparms.=$_.' ';
+	    }
+	}
+    }
+    if ($chparms) {
+	$scrout.='<p><b>Obsolete parameters or stored values:</b> '.
+	    $chparms;
+    }
 
 # ------------------------------------------------------- Now have all metadata
 
-        my %keywords=();
+    my %keywords=();
         
-	if (length($content)<500000) {
-	    my $textonly=$content;
-            $textonly=~s/\<script[^\<]+\<\/script\>//g;
-            $textonly=~s/\<m\>[^\<]+\<\/m\>//g;
-            $textonly=~s/\<[^\>]*\>//g;
-            $textonly=~tr/A-Z/a-z/;
-            $textonly=~s/[\$\&][a-z]\w*//g;
-            $textonly=~s/[^a-z\s]//g;
-
-            foreach ($textonly=~m/(\w+)/g) {
-		unless ($nokey{$_}) {
-                   $keywords{$_}=1;
-                } 
-            }
-        }
+    if (length($content)<500000) {
+	my $textonly=$content;
+	$textonly=~s/\<script[^\<]+\<\/script\>//g;
+	$textonly=~s/\<m\>[^\<]+\<\/m\>//g;
+	$textonly=~s/\<[^\>]*\>//g;
+	$textonly=~tr/A-Z/a-z/;
+	$textonly=~s/[\$\&][a-z]\w*//g;
+	$textonly=~s/[^a-z\s]//g;
+	
+	foreach ($textonly=~m/(\w+)/g) {
+	    unless ($nokey{$_}) {
+		$keywords{$_}=1;
+	    } 
+	}
+    }
 
             
-            foreach (split(/\W+/,$metadatafields{'keywords'})) {
-		$keywords{$_}=1;
-            }
+    foreach (split(/\W+/,$metadatafields{'keywords'})) {
+	$keywords{$_}=1;
+    }
 # --------------------------------------------------- Now we also have keywords
 # =============================================================================
 # INTERACTIVE MODE
 #
-   unless ($batch) {
+    unless ($batch) {
         $scrout.=
-     '<form name="pubform" action="/adm/publish" method="post">'.
-       '<p><input type="submit" value="Finalize Publication" /></p>'.
-          &hiddenfield('phase','two').
-          &hiddenfield('filename',$ENV{'form.filename'}).
-	  &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).
-          &hiddenfield('dependencies',join(',',keys %allow)).
-          &textfield('Title','title',$metadatafields{'title'}).
-          &textfield('Author(s)','author',$metadatafields{'author'}).
-	  &textfield('Subject','subject',$metadatafields{'subject'});
+	    '<form name="pubform" action="/adm/publish" method="post">'.
+            '<p><input type="submit" value="Finalize Publication" /></p>'.
+            &hiddenfield('phase','two').
+            &hiddenfield('filename',$ENV{'form.filename'}).
+	    &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).
+            &hiddenfield('dependencies',join(',',keys %allow)).
+            &textfield('Title','title',$metadatafields{'title'}).
+            &textfield('Author(s)','author',$metadatafields{'author'}).
+	    &textfield('Subject','subject',$metadatafields{'subject'});
 
 # --------------------------------------------------- Scan content for keywords
 
         my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");
 	my $keywordout=<<"END";
 <script>
-function checkAll(field)
-{
+function checkAll(field) {
     for (i = 0; i < field.length; i++)
         field[i].checked = true ;
 }
 
-function uncheckAll(field)
-{
+function uncheckAll(field) {
     for (i = 0; i < field.length; i++)
         field[i].checked = false ;
 }
@@ -1049,111 +1047,116 @@ function uncheckAll(field)
 <input type="button" value="uncheck all" onclick="javascript:uncheckAll(document.pubform.keywords)"> 
 <br />
 END
-        $keywordout.='<table border=2><tr>';
-        my $colcount=0;
+	$keywordout.='<table border=2><tr>';
+	my $colcount=0;
+
+	foreach (sort keys %keywords) {
+	    $keywordout.='<td><input type=checkbox name="keywords" value="'.$_.'"';
+	    if ($metadatafields{'keywords'}) {
+		if ($metadatafields{'keywords'}=~/$_/) {
+		    $keywordout.=' checked';
+		}
+	    } elsif (&Apache::loncommon::keyword($_)) {
+		$keywordout.=' checked';
+	    }
+	    $keywordout.='>'.$_.'</td>';
+	    if ($colcount>10) {
+		$keywordout.="</tr><tr>\n";
+		$colcount=0;
+	    }
+	    $colcount++;
+	}
 
-            foreach (sort keys %keywords) {
-                $keywordout.='<td><input type=checkbox name="keywords" value="'.$_.'"';
-                if ($metadatafields{'keywords'}) {
-                   if ($metadatafields{'keywords'}=~/$_/) { 
-                      $keywordout.=' checked'; 
-                   }
-	        } elsif (&Apache::loncommon::keyword($_)) {
-	            $keywordout.=' checked';
-                } 
-                $keywordout.='>'.$_.'</td>';
-                if ($colcount>10) {
-		    $keywordout.="</tr><tr>\n";
-                    $colcount=0;
-                }
-                $colcount++;
-            }
-        
 	$keywordout.='</tr></table>';
 
-        $scrout.=$keywordout;
+	$scrout.=$keywordout;
 
-        $scrout.=&textfield('Additional Keywords','addkey','');
+	$scrout.=&textfield('Additional Keywords','addkey','');
 
-        $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
+	$scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
 
-        $scrout.=
-             '<p><b>Abstract:</b><br><textarea cols=80 rows=5 name=abstract>'.
-              $metadatafields{'abstract'}.'</textarea>';
+	$scrout.=
+	    '<p><b>Abstract:</b><br><textarea cols=80 rows=5 name=abstract>'.
+	    $metadatafields{'abstract'}.'</textarea>';
 
 	$source=~/\.(\w+)$/;
 
 	$scrout.=&hiddenfield('mime',$1);
 
-        $scrout.=&selectbox('Language','language',
-                            $metadatafields{'language'},
+	$scrout.=&selectbox('Language','language',
+			    $metadatafields{'language'},
 			    \&Apache::loncommon::languagedescription,
 			    (&Apache::loncommon::languageids),
-			     );
+			   );
 
-        unless ($metadatafields{'creationdate'}) {
+	unless ($metadatafields{'creationdate'}) {
 	    $metadatafields{'creationdate'}=time;
-        }
-        $scrout.=&hiddenfield('creationdate',
-              &Apache::loncommon::unsqltime($metadatafields{'creationdate'}));
+	}
+	$scrout.=&hiddenfield('creationdate',
+			      &Apache::loncommon::unsqltime($metadatafields{'creationdate'}));
+
+	$scrout.=&hiddenfield('lastrevisiondate',time);
 
-        $scrout.=&hiddenfield('lastrevisiondate',time);
 
-			   
 	$scrout.=&textfield('Publisher/Owner','owner',
-                            $metadatafields{'owner'});
+			    $metadatafields{'owner'});
 
 # -------------------------------------------------- Correct copyright for rat.
-    if ($style eq 'rat') {
-	if ($metadatafields{'copyright'} eq 'public') { 
-	    delete $metadatafields{'copyright'};
+	unless ($style eq 'prv') {
+	    if ($style eq 'rat') {
+		if ($metadatafields{'copyright'} eq 'public') { 
+		    delete $metadatafields{'copyright'};
+		}
+		$scrout.=&selectbox('Copyright/Distribution','copyright',
+				    $metadatafields{'copyright'},
+				    \&Apache::loncommon::copyrightdescription,
+				    (grep !/^public$/,(&Apache::loncommon::copyrightids)));
+	    } else {
+		$scrout.=&selectbox('Copyright/Distribution','copyright',
+				    $metadatafields{'copyright'},
+				    \&Apache::loncommon::copyrightdescription,
+				    (&Apache::loncommon::copyrightids));
+	    }
+    
+	    my $copyright_help =
+		Apache::loncommon::help_open_topic('Publishing_Copyright');
+	    $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;
+	    $scrout.=&textfield('Custom Distribution File','customdistributionfile',
+				$metadatafields{'customdistributionfile'}).
+				    $copyright_help;
+	} else {
+	    $scrout.=&hiddenfield('copyright','private');
 	}
-        $scrout.=&selectbox('Copyright/Distribution','copyright',
-                            $metadatafields{'copyright'},
-			    \&Apache::loncommon::copyrightdescription,
-		     (grep !/^public$/,(&Apache::loncommon::copyrightids)));
-    }
-    else {
-        $scrout.=&selectbox('Copyright/Distribution','copyright',
-                            $metadatafields{'copyright'},
-			    \&Apache::loncommon::copyrightdescription,
-			     (&Apache::loncommon::copyrightids));
-    }
-
-    my $copyright_help =
-        Apache::loncommon::help_open_topic('Publishing_Copyright');
-    $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;
-    return $scrout.
-        '<p><input type="submit" value="Finalize Publication" /></p></form>';
+	return ($scrout.'<p><input type="submit" value="Finalize Publication" /></p></form>',0);
 # =============================================================================
 # BATCH MODE
 #
-  } else {
+    } else {
 # Transfer metadata directly to environment for stage 2
-    foreach (keys %metadatafields) {
-	$ENV{'form.'.$_}=$metadatafields{$_};
+	foreach (keys %metadatafields) {
+	    $ENV{'form.'.$_}=$metadatafields{$_};
+	}
+	$ENV{'form.addkey'}='';
+	$ENV{'form.keywords'}='';
+	foreach (keys %keywords) {
+	    if ($metadatafields{'keywords'}) {
+		if ($metadatafields{'keywords'}=~/$_/) { 
+		    $ENV{'form.keywords'}.=$_.','; 
+		}
+	    } elsif (&Apache::loncommon::keyword($_)) {
+		$ENV{'form.keywords'}.=$_.',';
+	    }
+	}
+	$ENV{'form.keywords'}=~s/\,$//;
+	unless ($ENV{'form.creationdate'}) { $ENV{'form.creationdate'}=time; }
+	$ENV{'form.lastrevisiondate'}=time;
+	if ((($style eq 'rat') && ($ENV{'form.copyright'} eq 'public')) ||
+	    (!$ENV{'form.copyright'})) { 
+	    $ENV{'form.copyright'}='default';
+	}
+	$ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta);
+	return ($scrout,0);
     }
-    $ENV{'form.addkey'}='';
-    $ENV{'form.keywords'}='';
-    foreach (keys %keywords) {
-        if ($metadatafields{'keywords'}) {
-           if ($metadatafields{'keywords'}=~/$_/) { 
-              $ENV{'form.keywords'}.=$_.','; 
-           }
-	} elsif (&Apache::loncommon::keyword($_)) {
-	    $ENV{'form.keywords'}.=$_.',';
-        } 
-    }
-    $ENV{'form.keywords'}=~s/\,$//;
-    unless ($ENV{'form.creationdate'}) { $ENV{'form.creationdate'}=time; }
-    $ENV{'form.lastrevisiondate'}=time;
-    if ((($style eq 'rat') && ($ENV{'form.copyright'} eq 'public')) ||
-        (!$ENV{'form.copyright'})) { 
-	$ENV{'form.copyright'}='default';
-    } 
-    $ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta);
-    return $scrout;
-  }
 }
 
 #########################################
@@ -1199,11 +1202,18 @@ sub phasetwo {
     my ($r,$source,$target,$style,$distarget,$batch)=@_;
     $source=~s/\/+/\//g;
     $target=~s/\/+/\//g;
+
+    if ($target=~/\_\_\_/) {
+	$r->print(
+ '<font color="red">Unsupported character combination "<tt>___</tt>" in filename, FAIL</font>');
+        return 0;
+    }
     $distarget=~s/\/+/\//g;
     my $logfile;
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
-	return 
-            '<font color=red>No write permission to user directory, FAIL</font>';
+	$r->print(
+        '<font color="red">No write permission to user directory, FAIL</font>');
+        return 0;
     }
     print $logfile 
         "\n================= Publish ".localtime()." Phase Two  ================\n";
@@ -1224,6 +1234,8 @@ sub phasetwo {
     $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};
     $metadatafields{'owner'}=$ENV{'form.owner'};
     $metadatafields{'copyright'}=$ENV{'form.copyright'};
+    $metadatafields{'customdistributionfile'}=
+                                 $ENV{'form.customdistributionfile'};
     $metadatafields{'dependencies'}=$ENV{'form.dependencies'};
     
     my $allkeywords=$ENV{'form.addkey'};
@@ -1243,7 +1255,7 @@ sub phasetwo {
         my $mfh;
         unless ($mfh=Apache::File->new('>'.$source.'.meta')) {
             return 
-                '<font color=red>Could not write metadata, FAIL</font>';
+                '<font color="red">Could not write metadata, FAIL</font>';
         }
         foreach (sort keys %metadatafields) {
             unless ($_=~/\./) {
@@ -1295,7 +1307,7 @@ sub phasetwo {
         my $srcd=$1;
         unless ($srcd=~/^\/home\/httpd\/html\/res/) {
             print $logfile "\nPANIC: Target dir is ".$srcd;
-            return "<font color=red>Invalid target directory, FAIL</font>";
+            return "<font color=\"red\">Invalid target directory, FAIL</font>";
         }
         opendir(DIR,$srcd);
         while ($filename=readdir(DIR)) {
@@ -1320,7 +1332,7 @@ sub phasetwo {
             $r->print('<p>Copied old target file');
         } else {
 	    print $logfile "Unable to write ".$copyfile.':'.$!."\n";
-            return "<font color=red>Failed to copy old target, $!, FAIL</font>";
+            return "<font color=\"red\">Failed to copy old target, $!, FAIL</font>";
         }
         
 # --------------------------------------------------------------- Copy Metadata
@@ -1334,7 +1346,7 @@ sub phasetwo {
 	    print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
             if (-e $target.'.meta') {
                 return 
-                    "<font color=red>Failed to write old metadata copy, $!, FAIL</font>";
+                    "<font color=\"red\">Failed to write old metadata copy, $!, FAIL</font>";
 	    }
         }
         
@@ -1365,7 +1377,7 @@ sub phasetwo {
         $r->print('<p>Copied source file');
     } else {
         print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
-        return "<font color=red>Failed to copy source, $!, FAIL</font>";
+        return "<font color=\"red\">Failed to copy source, $!, FAIL</font>";
     }
     
 # --------------------------------------------------------------- Copy Metadata
@@ -1378,7 +1390,7 @@ sub phasetwo {
     } else {
         print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
         return 
-            "<font color=red>Failed to write metadata copy, $!, FAIL</font>";
+            "<font color=\"red\">Failed to write metadata copy, $!, FAIL</font>";
     }
     $r->rflush;
 # --------------------------------------------------- Send update notifications
@@ -1466,13 +1478,16 @@ sub batchpublish {
 
 # phase one takes
 #  my ($source,$target,$style,$batch)=@_;
-    $r->print('<p>'.&publish($srcfile,$targetfile,$thisembstyle,1).'</p>');
+    my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1);
+    $r->print('<p>'.$outstring.'</p>');
 # phase two takes
 # my ($source,$target,$style,$distarget,batch)=@_;
 # $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},...
-    $r->print('<p>');
-    &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
-    $r->print('</p>');
+    if (!$error) {
+	$r->print('<p>');
+	&phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
+	$r->print('</p>');
+    }
     return '';
 }
 
@@ -1587,7 +1602,7 @@ sub handler {
 
 # -------------------------------------------------------------- Check filename
 
-  my $fn=$ENV{'form.filename'};
+  my $fn=&Apache::lonnet::unescape($ENV{'form.filename'});
 
   
   unless ($fn) { 
@@ -1717,13 +1732,12 @@ unless ($ENV{'form.phase'} eq 'two') {
 # ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.
 
        unless ($ENV{'form.phase'} eq 'two') {
-         $r->print(
-          '<hr />'.&publish($thisfn,$thistarget,$thisembstyle));
+	   my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle);
+	   $r->print('<hr />'.$outstring);
        } else {
            $r->print('<hr />');
            &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget); 
-       }  
-
+       }
   }
   $r->print('</body></html>');