--- loncom/publisher/lonpublisher.pm	2002/04/17 18:32:35	1.79
+++ loncom/publisher/lonpublisher.pm	2002/09/16 13:05:50	1.95
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Publication Handler
 #
-# $Id: lonpublisher.pm,v 1.79 2002/04/17 18:32:35 matthew Exp $
+# $Id: lonpublisher.pm,v 1.95 2002/09/16 13:05:50 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -61,6 +61,57 @@
 ##                                                                           ##
 ###############################################################################
 
+
+######################################################################
+######################################################################
+
+=pod 
+
+=head1 NAME
+
+lonpublisher - LON-CAPA publishing handler
+
+=head1 SYNOPSIS
+
+B<lonpublisher> is used by B<mod_perl> inside B<Apache>.  This is the
+invocation by F<loncapa_apache.conf>:
+
+  <Location /adm/publish>
+  PerlAccessHandler       Apache::lonacc
+  SetHandler perl-script
+  PerlHandler Apache::lonpublisher
+  ErrorDocument     403 /adm/login
+  ErrorDocument     404 /adm/notfound.html
+  ErrorDocument     406 /adm/unauthorized.html
+  ErrorDocument     500 /adm/errorhandler
+  </Location>
+
+=head1 DESCRIPTION
+
+B<lonpublisher> takes the proper steps to add resources to the LON-CAPA
+digital library.  This includes updating the metadata table in the
+LON-CAPA database.
+
+B<lonpublisher> is many things to many people.  
+
+This module publishes a file.  This involves gathering metadata,
+versioning the file, copying file from construction space to
+publication space, and copying metadata from construction space
+to publication space.
+
+=head2 SUBROUTINES
+
+Many of the undocumented subroutines implement various magical
+parsing shortcuts.
+
+=over 4
+
+=cut
+
+######################################################################
+######################################################################
+
+
 package Apache::lonpublisher;
 
 # ------------------------------------------------- modules used by this module
@@ -75,6 +126,7 @@ use Apache::loncacc;
 use DBI;
 use Apache::lonnet();
 use Apache::loncommon();
+use Apache::lonmysql;
 
 my %addid;
 my %nokey;
@@ -87,7 +139,36 @@ my $docroot;
 my $cuname;
 my $cudom;
 
-# ----------------------------------------------- Evaluate string with metadata
+#########################################
+#########################################
+
+=pod
+
+=item B<metaeval>
+
+Evaluates a string that contains metadata.  This subroutine
+stores values inside I<%metadatafields> and I<%metadatakeys>.
+The hash key is a I<$unikey> corresponding to a unique id
+that is descriptive of the parser location inside the XML tree.
+
+Parameters:
+
+=over 4
+
+=item I<$metastring>
+
+A string that contains metadata.
+
+=back
+
+Returns:
+
+nothing
+
+=cut
+
+#########################################
+#########################################
 sub metaeval {
     my $metastring=shift;
    
@@ -130,14 +211,50 @@ sub metaeval {
        }
 }
 
-# -------------------------------------------------------- Read a metadata file
+#########################################
+#########################################
+
+=pod
+
+=item B<metaread>
+
+Read a metadata file
+
+Parameters:
+
+=over
+
+=item I<$logfile>
+
+File output stream to output errors and warnings to.
+
+=item I<$fn>
+
+File name (including path).
+
+=back
+
+Returns:
+
+=over 4
+
+=item Scalar string (if successful)
+
+XHTML text that indicates successful reading of the metadata.
+
+=back
+
+=cut
+
+#########################################
+#########################################
 sub metaread {
     my ($logfile,$fn)=@_;
     unless (-e $fn) {
-	print $logfile 'No file '.$fn."\n";
+	print($logfile 'No file '.$fn."\n");
         return '<br><b>No file:</b> <tt>'.$fn.'</tt>';
     }
-    print $logfile 'Processing '.$fn."\n";
+    print($logfile 'Processing '.$fn."\n");
     my $metastring;
     {
      my $metafh=Apache::File->new($fn);
@@ -147,7 +264,39 @@ sub metaread {
     return '<br><b>Processed file:</b> <tt>'.$fn.'</tt>';
 }
 
-# ---------------------------- convert 'time' format into a datetime sql format
+#########################################
+#########################################
+
+=pod
+
+=item B<sqltime>
+
+Convert 'time' format into a datetime sql format
+
+Parameters:
+
+=over 4
+
+=item I<$timef>
+
+Seconds since 00:00:00 UTC, January 1, 1970.
+
+=back
+
+Returns:
+
+=over 4
+
+=item Scalar string
+
+MySQL-compatible datetime string.
+
+=back
+
+=cut
+
+#########################################
+#########################################
 sub sqltime {
     my $timef=shift @_;
     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
@@ -156,17 +305,43 @@ sub sqltime {
     return "$year-$mon-$mday $hour:$min:$sec";
 }
 
-# --------------------------------------------------------- Various form fields
 
+#########################################
+#########################################
+
+=pod
+
+=item Form-field-generating subroutines.
+
+For input parameters, these subroutines take in values
+such as I<$name>, I<$value> and other form field metadata.
+The output (scalar string that is returned) is an XHTML
+string which presents the form field (foreseeably inside
+<form></form> tags).
+
+=over 4
+
+=item B<textfield>
+
+=item B<hiddenfield>
+
+=item B<selectbox>
+
+=back
+
+=cut
+
+#########################################
+#########################################
 sub textfield {
     my ($title,$name,$value)=@_;
     return "\n<p><b>$title:</b><br>".
-           '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
+           '<input type="text" name="'.$name.'" size=80 value="'.$value.'" />';
 }
 
 sub hiddenfield {
     my ($name,$value)=@_;
-    return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
+    return "\n".'<input type="hidden" name="'.$name.'" value="'.$value.'" />';
 }
 
 sub selectbox {
@@ -184,8 +359,19 @@ sub selectbox {
     return $selout.'</select>';
 }
 
-# -------------------------------------------------------- Publication Step One
+#########################################
+#########################################
 
+=pod
+
+=item B<urlfixup>
+
+Fix up a url?  First step of publication
+
+=cut
+
+#########################################
+#########################################
 sub urlfixup {
     my ($url,$target)=@_;
     unless ($url) { return ''; }
@@ -206,7 +392,19 @@ sub urlfixup {
     return $url;
 }
 
+#########################################
+#########################################
+
+=pod
+
+=item B<absoluteurl>
 
+Currently undocumented.
+
+=cut
+
+#########################################
+#########################################
 sub absoluteurl {
     my ($url,$target)=@_;
     unless ($url) { return ''; }
@@ -217,6 +415,394 @@ sub absoluteurl {
     return $url;
 }
 
+#########################################
+#########################################
+
+=pod
+
+=item B<set_allow>
+
+Currently undocumented    
+
+=cut
+
+#########################################
+#########################################
+sub set_allow {
+    my ($allow,$logfile,$target,$tag,$oldurl)=@_;
+    my $newurl=&urlfixup($oldurl,$target);
+    my $return_url=$oldurl;
+    print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n";
+    if ($newurl ne $oldurl) {
+	$return_url=$newurl;
+	print $logfile 'URL: '.$tag.':'.$oldurl.' - '.$newurl."\n";
+    }
+    if (($newurl !~ /^javascript:/i) &&
+	($newurl !~ /^mailto:/i) &&
+	($newurl !~ /^http:/i) &&
+	($newurl !~ /^\#/)) {
+	$$allow{&absoluteurl($newurl,$target)}=1;
+    }
+    return $return_url
+}
+
+#########################################
+#########################################
+
+=pod
+
+=item B<get_subscribed_hosts>
+
+Currently undocumented    
+
+=cut
+
+#########################################
+#########################################
+sub get_subscribed_hosts {
+    my ($target)=@_;
+    my @subscribed;
+    my $filename;
+    $target=~/(.*)\/([^\/]+)$/;
+    my $srcf=$2;
+    opendir(DIR,$1);
+    while ($filename=readdir(DIR)) {
+	if ($filename=~/$srcf\.(\w+)$/) {
+	    my $subhost=$1;
+	    if ($subhost ne 'meta' && $subhost ne 'subscription') {
+		push(@subscribed,$subhost);
+	    }
+	}
+    }
+    closedir(DIR);
+    my $sh;
+    if ( $sh=Apache::File->new("$target.subscription") ) {
+	&Apache::lonnet::logthis("opened $target.subscription");
+	while (my $subline=<$sh>) {
+	    &Apache::lonnet::logthis("Trying $subline");
+	    if ($subline =~ /(^\w+):/) { push(@subscribed,$1); } else {
+		&Apache::lonnet::logthis("No Match for $subline");
+	    }
+	}
+    } else {
+	&Apache::lonnet::logthis("Unable to open $target.subscription");
+    }
+    &Apache::lonnet::logthis("Got list of ".join(':',@subscribed));
+    return @subscribed;
+}
+
+
+#########################################
+#########################################
+
+=pod
+
+=item B<get_max_ids_indices>
+
+Currently undocumented    
+
+=cut
+
+#########################################
+#########################################
+sub get_max_ids_indices {
+    my ($content)=@_;
+    my $maxindex=10;
+    my $maxid=10;
+    my $needsfixup=0;
+
+    my $parser=HTML::LCParser->new($content);
+    my $token;
+    while ($token=$parser->get_token) {
+	if ($token->[0] eq 'S') {
+	    my $counter;
+	    if ($counter=$addid{$token->[1]}) {
+		if ($counter eq 'id') {
+		    if (defined($token->[2]->{'id'})) {
+			$maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
+		    } else {
+			$needsfixup=1;
+		    }
+		} else {
+		    if (defined($token->[2]->{'index'})) {
+			$maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
+		    } else {
+			$needsfixup=1;
+		    }
+		}
+	    }
+	}
+    }
+    return ($needsfixup,$maxid,$maxindex);
+}
+
+#########################################
+#########################################
+
+=pod
+
+=item B<get_all_text_unbalanced>
+
+Currently undocumented    
+
+=cut
+
+#########################################
+#########################################
+sub get_all_text_unbalanced {
+    #there is a copy of this in lonxml.pm
+    my($tag,$pars)= @_;
+    my $token;
+    my $result='';
+    $tag='<'.$tag.'>';
+    while ($token = $$pars[-1]->get_token) {
+	if (($token->[0] eq 'T')||($token->[0] eq 'C')||($token->[0] eq 'D')) {
+	    $result.=$token->[1];
+	} elsif ($token->[0] eq 'PI') {
+	    $result.=$token->[2];
+	} elsif ($token->[0] eq 'S') {
+	    $result.=$token->[4];
+	} elsif ($token->[0] eq 'E')  {
+	    $result.=$token->[2];
+	}
+	if ($result =~ /(.*)$tag(.*)/) {
+	    #&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2);
+	    #&Apache::lonnet::logthis('Result is :'.$1);
+	    $result=$1;
+	    my $redo=$tag.$2;
+	    push (@$pars,HTML::LCParser->new(\$redo));
+	    $$pars[-1]->xml_mode('1');
+	    last;
+	}
+    }
+    return $result
+}
+
+#########################################
+#########################################
+
+=pod
+
+=item B<fix_ids_and_indices>
+
+Currently undocumented    
+
+=cut
+
+#########################################
+#########################################
+#Arguably this should all be done as a lonnet::ssi instead
+sub fix_ids_and_indices {
+    my ($logfile,$source,$target)=@_;
+
+    my %allow;
+    my $content;
+    {
+	my $org=Apache::File->new($source);
+	$content=join('',<$org>);
+    }
+
+    my ($needsfixup,$maxid,$maxindex)=&get_max_ids_indices(\$content);
+
+    if ($needsfixup) {
+	print $logfile "Needs ID and/or index fixup\n".
+	    "Max ID   : $maxid (min 10)\n".
+                "Max Index: $maxindex (min 10)\n";
+    }
+    my $outstring='';
+    my @parser;
+    $parser[0]=HTML::LCParser->new(\$content);
+    $parser[-1]->xml_mode(1);
+    my $token;
+    while (@parser) {
+	while ($token=$parser[-1]->get_token) {
+	    if ($token->[0] eq 'S') {
+		my $counter;
+		my $tag=$token->[1];
+		my $lctag=lc($tag);
+		if ($lctag eq 'allow') {
+		    $allow{$token->[2]->{'src'}}=1;
+		    next;
+		}
+		my %parms=%{$token->[2]};
+		$counter=$addid{$tag};
+		if (!$counter) { $counter=$addid{$lctag}; }
+		if ($counter) {
+		    if ($counter eq 'id') {
+			unless (defined($parms{'id'})) {
+			    $maxid++;
+			    $parms{'id'}=$maxid;
+			    print $logfile 'ID: '.$tag.':'.$maxid."\n";
+			}
+		    } elsif ($counter eq 'index') {
+			unless (defined($parms{'index'})) {
+			    $maxindex++;
+			    $parms{'index'}=$maxindex;
+			    print $logfile 'Index: '.$tag.':'.$maxindex."\n";
+			}
+		    }
+		}
+		foreach my $type ('src','href','background','bgimg') {
+		    foreach my $key (keys(%parms)) {
+			if ($key =~ /^$type$/i) {
+			    $parms{$key}=&set_allow(\%allow,$logfile,
+						    $target,$tag,
+						    $parms{$key});
+			}
+		    }
+		}
+		# probably a <randomlabel> image type <label>
+		if ($lctag eq 'label' && defined($parms{'description'})) {
+		    my $next_token=$parser[-1]->get_token();
+		    if ($next_token->[0] eq 'T') {
+			$next_token->[1]=&set_allow(\%allow,$logfile,
+						    $target,$tag,
+						    $next_token->[1]);
+		    }
+		    $parser[-1]->unget_token($next_token);
+		}
+		if ($lctag eq 'applet') {
+		    my $codebase='';
+		    if (defined($parms{'codebase'})) {
+			my $oldcodebase=$parms{'codebase'};
+			unless ($oldcodebase=~/\/$/) {
+			    $oldcodebase.='/';
+			}
+			$codebase=&urlfixup($oldcodebase,$target);
+			$codebase=~s/\/$//;    
+			if ($codebase ne $oldcodebase) {
+			    $parms{'codebase'}=$codebase;
+			    print $logfile 'URL codebase: '.$tag.':'.
+				$oldcodebase.' - '.
+				    $codebase."\n";
+			}
+			$allow{&absoluteurl($codebase,$target).'/*'}=1;
+		    } else {
+			foreach ('archive','code','object') {
+			    if (defined($parms{$_})) {
+				my $oldurl=$parms{$_};
+				my $newurl=&urlfixup($oldurl,$target);
+				$newurl=~s/\/[^\/]+$/\/\*/;
+				print $logfile 'Allow: applet '.$_.':'.
+				    $oldurl.' allows '.
+					$newurl."\n";
+				$allow{&absoluteurl($newurl,$target)}=1;
+			    }
+			}
+		    }
+		}
+		my $newparmstring='';
+		my $endtag='';
+		foreach (keys %parms) {
+		    if ($_ eq '/') {
+			$endtag=' /';
+		    } else { 
+			my $quote=($parms{$_}=~/\"/?"'":'"');
+			$newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote;
+		    }
+		}
+		if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
+		$outstring.='<'.$tag.$newparmstring.$endtag.'>';
+		if ($lctag eq 'm') {
+		    $outstring.=&get_all_text_unbalanced('/m',\@parser);
+		}
+	    } elsif ($token->[0] eq 'E') {
+		if ($token->[2]) {
+		    unless ($token->[1] eq 'allow') {
+			$outstring.='</'.$token->[1].'>';
+		    }
+		}
+	    } else {
+		$outstring.=$token->[1];
+	    }
+	}
+	pop(@parser);
+    }
+
+    if ($needsfixup) {
+	print $logfile "End of ID and/or index fixup\n".
+	    "Max ID   : $maxid (min 10)\n".
+		"Max Index: $maxindex (min 10)\n";
+    } else {
+	print $logfile "Does not need ID and/or index fixup\n";
+    }
+
+    return ($outstring,%allow);
+}
+
+#########################################
+#########################################
+
+=pod
+
+=item B<store_metadata>
+
+Store the metadata in the metadata table in the loncapa database.
+Uses lonmysql to access the database.
+
+Inputs: \%metadata
+
+Returns: (error,status).  error is undef on success, status is undef on error.
+
+=cut
+
+#########################################
+#########################################
+sub store_metadata {
+    my %metadata = %{shift()};
+    my $error;
+    # Determine if the table exists
+    my $status = &Apache::lonmysql::check_table('metadata');
+    if (! defined($status)) {
+        $error='<font color="red">WARNING: Cannot connect to '.
+            'database!</font>';
+        &Apache::lonnet::logthis($error);
+        return ($error,undef);
+    }
+    if ($status == 0) {
+        # It would be nice to actually create the table....
+        $error ='<font color="red">WARNING: The metadata table does not '.
+            'exist in the LON-CAPA database.</font>';
+        &Apache::lonnet::logthis($error);
+        return ($error,undef);
+    }
+    # Remove old value from table
+    $status = &Apache::lonmysql::remove_from_table
+        ('metadata','url',$metadata{'url'});
+    if (! defined($status)) {
+        $error = '<font color="red">Error when removing old values from '.
+            'metadata table in LON-CAPA database.</font>';
+        &Apache::lonnet::logthis($error);
+        return ($error,undef);
+    }
+    # Store data in table.
+    $status = &Apache::lonmysql::store_row('metadata',\%metadata);
+    if (! defined($status)) {
+        $error='<font color="red">Error occured storing new values in '.
+            'metadata table in LON-CAPA database</font>';
+        &Apache::lonnet::logthis($error);
+        return ($error,undef);
+    }
+    return (undef,$status);
+}
+
+#########################################
+#########################################
+
+=pod
+
+=item B<publish>
+
+This is the workhorse function of this module.  This subroutine generates
+backup copies, performs any automatic processing (prior to publication,
+especially for rat and ssi files),
+
+I<Additional documentation needed.>
+
+=cut
+
+#########################################
+#########################################
 sub publish {
 
     my ($source,$target,$style)=@_;
@@ -225,7 +811,6 @@ sub publish {
     my $allmeta='';
     my $content='';
     my %allow=();
-    undef %allow;
 
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
 	return 
@@ -246,153 +831,9 @@ sub publish {
           return "<font color=red>Failed to write backup copy, $!,FAIL</font>";
         }
 # ------------------------------------------------------------- IDs and indices
-
-        my $maxindex=10;
-        my $maxid=10;
-
-        my $needsfixup=0;
-
-        {
-          my $org=Apache::File->new($source);
-          $content=join('',<$org>);
-        }
-        {
-          my $parser=HTML::LCParser->new(\$content);
-          my $token;
-          while ($token=$parser->get_token) {
-              if ($token->[0] eq 'S') {
-                  my $counter;
-		  if ($counter=$addid{$token->[1]}) {
-		      if ($counter eq 'id') {
-			  if (defined($token->[2]->{'id'})) {
-                             $maxid=
-		       ($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
-			 } else {
-                             $needsfixup=1;
-                         }
-                      } else {
- 			  if (defined($token->[2]->{'index'})) {
-                             $maxindex=
-	   ($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
-			  } else {
-                             $needsfixup=1;
-			  }
-		      }
-		  }
-              }
-          }
-      }
-      if ($needsfixup) {
-          print $logfile "Needs ID and/or index fixup\n".
-	        "Max ID   : $maxid (min 10)\n".
-                "Max Index: $maxindex (min 10)\n";
-      }
-          my $outstring='';
-          my $parser=HTML::LCParser->new(\$content);
-          $parser->xml_mode(1);
-          my $token;
-          while ($token=$parser->get_token) {
-              if ($token->[0] eq 'S') {
-                my $counter;
-                my $tag=$token->[1];
-                my $lctag=lc($tag);
-                unless ($lctag eq 'allow') {  
-                  my %parms=%{$token->[2]};
-                  $counter=$addid{$tag};
-                  if (!$counter) { $counter=$addid{$lctag}; }
-                  if ($counter) {
-		      if ($counter eq 'id') {
-			  unless (defined($parms{'id'})) {
-                              $maxid++;
-                              $parms{'id'}=$maxid;
-                              print $logfile 'ID: '.$tag.':'.$maxid."\n";
-                          }
-                      } elsif ($counter eq 'index') {
- 			  unless (defined($parms{'index'})) {
-                              $maxindex++;
-                              $parms{'index'}=$maxindex;
-                              print $logfile 'Index: '.$tag.':'.$maxindex."\n";
-			  }
-		      }
-		  }
-
-                  foreach my $type ('src','href','background','bgimg') {
-		      foreach my $key (keys(%parms)) {
-			  if ($key =~ /^$type$/i) {
-			      my $oldurl=$parms{$key};
-			      my $newurl=&urlfixup($oldurl,$target);
-			      if ($newurl ne $oldurl) {
-				  $parms{$key}=$newurl;
-				  print $logfile 'URL: '.$tag.':'.$oldurl.' - '.
-				      $newurl."\n";
-			      }
-			      if (($newurl !~ /^javascript:/i) &&
-				  ($newurl !~ /^mailto:/i) &&
-				  ($newurl !~ /^http:/i) &&
-				  ($newurl !~ /^\#/)) {
-				  $allow{&absoluteurl($newurl,$target)}=1;
-			      }
-			  }
-			  last;
-		      }
-                  }
-
-                  if ($lctag eq 'applet') {
-		      my $codebase='';
-                      if (defined($parms{'codebase'})) {
-		         my $oldcodebase=$parms{'codebase'};
-                         unless ($oldcodebase=~/\/$/) {
-                            $oldcodebase.='/';
-                         }
-                         $codebase=&urlfixup($oldcodebase,$target);
-                         $codebase=~s/\/$//;    
-                         if ($codebase ne $oldcodebase) {
-			     $parms{'codebase'}=$codebase;
-                             print $logfile 'URL codebase: '.$tag.':'.
-                                  $oldcodebase.' - '.
-				  $codebase."\n";
-			 }
-                         $allow{&absoluteurl($codebase,$target).'/*'}=1;
-		      } else {
-                        foreach ('archive','code','object') {
-                          if (defined($parms{$_})) {
-			      my $oldurl=$parms{$_};
-                              my $newurl=&urlfixup($oldurl,$target);
-			      $newurl=~s/\/[^\/]+$/\/\*/;
-                                  print $logfile 'Allow: applet '.$_.':'.
-                                  $oldurl.' allows '.
-				  $newurl."\n";
-                              $allow{&absoluteurl($newurl,$target)}=1;
-                          }
-                        }
-                      }
-                  }
-
-                  my $newparmstring='';
-                  my $endtag='';
-                  foreach (keys %parms) {
-                    if ($_ eq '/') {
-                      $endtag=' /';
-                    } else { 
-                      my $quote=($parms{$_}=~/\"/?"'":'"');
-                      $newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote;
-		    }
-                  }
-		  if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
-		  $outstring.='<'.$tag.$newparmstring.$endtag.'>';
-	         } else {
-		   $allow{$token->[2]->{'src'}}=1;
-		 }
-              } elsif ($token->[0] eq 'E') {
-		if ($token->[2]) {
-                  unless ($token->[1] eq 'allow') {
-                     $outstring.='</'.$token->[1].'>';
-		  }
-		}
-              } else {
-                  $outstring.=$token->[1];
-              }
-          }
+	
+	my $outstring;
+	($outstring,%allow)=&fix_ids_and_indices($logfile,$source,$target);
 # ------------------------------------------------------------ Construct Allows
     
 	$scrout.='<h3>Dependencies</h3>';
@@ -413,55 +854,52 @@ sub publish {
                if (
        &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                                             $thisdep.'.meta') eq '-1') {
-		   $scrout.=
-                           ' - <font color=red>Currently not available</font>';
+		   $scrout.= ' - <font color="red">Currently not available'.
+		       '</font>';
                } else {
                    my %temphash=(&Apache::lonnet::declutter($target).'___'.
                              &Apache::lonnet::declutter($thisdep).'___usage'
                                  => time);
                    $thisdep=~/^\/res\/(\w+)\/(\w+)\//;
                    if ((defined($1)) && (defined($2))) {
-                      &Apache::lonnet::put('resevaldata',\%temphash,$1,$2);
+                      &Apache::lonnet::put('nohist_resevaldata',\%temphash,
+					   $1,$2);
 		   }
 	       }
            }
         }
-        $allowstr=~s/\n+/\n/g;
-        $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;
+        $outstring=~s/\n*(\<\/[^\>]+\>)\s*$/$allowstr\n$1\n/s;
 
 	#Encode any High ASCII characters
 	$outstring=&HTML::Entities::encode($outstring,"\200-\377");
-# ------------------------------------------------------------- Write modified
+# ------------------------------------------------------------- Write modified.
 
         {
           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>";
+		 '<font color="red">No write permission to '.$source.
+		 ', FAIL</font>';
 	  }
-          print $org $outstring;
+          print($org $outstring);
         }
 	  $content=$outstring;
 
-      if ($needsfixup) {
-          print $logfile "End of ID and/or index fixup\n".
-	        "Max ID   : $maxid (min 10)\n".
-                "Max Index: $maxindex (min 10)\n";
-      } else {
-	  print $logfile "Does not need ID and/or index fixup\n";
-      }
     }
-# --------------------------------------------- Initial step done, now metadata
+# -------------------------------------------- Initial step done, now metadata.
 
-# ---------------------------------------- Storage for metadata keys and fields
+# --------------------------------------- Storage for metadata keys and fields.
 
      %metadatafields=();
      %metadatakeys=();
      
      my %oldparmstores=();
      
-     $scrout.='<h3>Metadata Information</h3>';
+     
+     $scrout.='<h3>Metadata Information ' .
+       Apache::loncommon::help_open_topic("Metadata_Description")
+       . '</h3>';
 
 # ------------------------------------------------ First, check out environment
      unless (-e $source.'.meta') {
@@ -515,7 +953,7 @@ sub publish {
         my $oldenv=$ENV{'request.uri'};
 
         $ENV{'request.uri'}=$target;
-        $allmeta=Apache::lonxml::xmlparse('meta',$content);
+        $allmeta=Apache::lonxml::xmlparse(undef,'meta',$content);
         $ENV{'request.uri'}=$oldenv;
 
         &metaeval($allmeta);
@@ -568,6 +1006,7 @@ sub publish {
 
 # --------------------------------------------------- Scan content for keywords
 
+        my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");
 	my $keywordout=<<"END";
 <script>
 function checkAll(field)
@@ -582,7 +1021,7 @@ function uncheckAll(field)
         field[i].checked = false ;
 }
 </script>
-<p><b>Keywords:</b> 
+<p><b>Keywords: $keywords_help</b> 
 <input type="button" value="check all" onclick="javascript:checkAll(document.pubform.keywords)"> 
 <input type="button" value="uncheck all" onclick="javascript:uncheckAll(document.pubform.keywords)"> 
 <br />
@@ -661,7 +1100,8 @@ END
 			   
 	$scrout.=&textfield('Publisher/Owner','owner',
                             $metadatafields{'owner'});
-# --------------------------------------------------- Correct copyright for rat        
+
+# -------------------------------------------------- Correct copyright for rat.
     if ($style eq 'rat') {
 	if ($metadatafields{'copyright'} eq 'public') { 
 	    delete $metadatafields{'copyright'};
@@ -677,12 +1117,51 @@ END
 			    \&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>';
+        '<p><input type="submit" value="Finalize Publication" /></p></form>';
 }
 
-# -------------------------------------------------------- Publication Step Two
+#########################################
+#########################################
+
+=pod 
+
+=item B<phasetwo>
+
+Render second interface showing status of publication steps.
+This is publication step two.
+
+Parameters:
+
+=over 4
+
+=item I<$source>
+
+=item I<$target>
+
+=item I<$style>
+
+=item I<$distarget>
+
+=back
+
+Returns:
+
+=over 4
+
+=item Scalar string
 
+String contains status (errors and warnings) and information associated with
+the server's attempts at publication.
+
+=cut
+
+#########################################
+#########################################
 sub phasetwo {
 
     my ($source,$target,$style,$distarget)=@_;
@@ -707,17 +1186,20 @@ sub phasetwo {
      $metadatafields{'abstract'}=$ENV{'form.abstract'};
      $metadatafields{'mime'}=$ENV{'form.mime'};
      $metadatafields{'language'}=$ENV{'form.language'};
-     $metadatafields{'creationdate'}=$ENV{'form.creationdate'};
-     $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};
+     $metadatafields{'creationdate'}=
+         &sqltime($ENV{'form.creationdate'});
+     $metadatafields{'lastrevisiondate'}=
+         &sqltime($ENV{'form.lastrevisiondate'});
      $metadatafields{'owner'}=$ENV{'form.owner'};
      $metadatafields{'copyright'}=$ENV{'form.copyright'};
      $metadatafields{'dependencies'}=$ENV{'form.dependencies'};
 
      my $allkeywords=$ENV{'form.addkey'};
-     if (exists($ENV{'form.keywords'}) && (ref($ENV{'form.keywords'}))) {
-         my @Keywords = @{$ENV{'form.keywords'}};
-         foreach (@Keywords) {
-             $allkeywords.=','.$_;
+     if (exists($ENV{'form.keywords'})) {
+         if (ref($ENV{'form.keywords'})) {
+             $allkeywords .= ','.join(',',@{$ENV{'form.keywords'}});
+         } else {
+             $allkeywords .= ','.$ENV{'form.keywords'};
          }
      }
      $allkeywords=~s/\W+/\,/;
@@ -753,65 +1235,23 @@ sub phasetwo {
      }
 
 # -------------------------------- Synchronize entry with SQL metadata database
-  my $warning;
-
-  unless ($metadatafields{'copyright'} eq 'priv') {
-
-    my $dbh;
-    {
-	unless (
-		$dbh = DBI->connect("DBI:mysql:loncapa","www",
-    $Apache::lonnet::perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})
-		) { 
-	    $warning='<font color=red>WARNING: Cannot connect to '.
-		'database!</font>';
-	}
-	else {
-	    my %sqldatafields;
-	    $sqldatafields{'url'}=$distarget;
-	    my $sth=$dbh->prepare(
-				  'delete from metadata where url like binary'.
-				  '"'.$sqldatafields{'url'}.'"');
-	    $sth->execute();
-	    foreach ('title','author','subject','keywords','notes','abstract',
-	     'mime','language','creationdate','lastrevisiondate','owner',
-	     'copyright') {
-		my $field=$metadatafields{$_}; $field=~s/\"/\'\'/g; 
-		$sqldatafields{$_}=$field;
-	    }
-	    
-	    $sth=$dbh->prepare('insert into metadata values ('.
-			       '"'.delete($sqldatafields{'title'}).'"'.','.
-			       '"'.delete($sqldatafields{'author'}).'"'.','.
-			       '"'.delete($sqldatafields{'subject'}).'"'.','.
-			       '"'.delete($sqldatafields{'url'}).'"'.','.
-			       '"'.delete($sqldatafields{'keywords'}).'"'.','.
-			       '"'.'current'.'"'.','.
-			       '"'.delete($sqldatafields{'notes'}).'"'.','.
-			       '"'.delete($sqldatafields{'abstract'}).'"'.','.
-			       '"'.delete($sqldatafields{'mime'}).'"'.','.
-			       '"'.delete($sqldatafields{'language'}).'"'.','.
-			       '"'.
-			       sqltime(delete($sqldatafields{'creationdate'}))
-			       .'"'.','.
-			       '"'.
-			       sqltime(delete(
-			       $sqldatafields{'lastrevisiondate'})).'"'.','.
-			       '"'.delete($sqldatafields{'owner'}).'"'.','.
-			       '"'.delete(
-			       $sqldatafields{'copyright'}).'"'.')');
-	    $sth->execute();
-	    $dbh->disconnect;
-	    $scrout.='<p>Synchronized SQL metadata database';
-	    print $logfile "\nSynchronized SQL metadata database";
-	}
+    my $warning;
+    $metadatafields{'url'} = $distarget;
+    $metadatafields{'version'} = 'current';
+    unless ($metadatafields{'copyright'} eq 'priv') {
+        my ($error,$success) = &store_metadata(\%metadatafields);
+        if ($success) {
+            $scrout.='<p>Synchronized SQL metadata database';
+            print $logfile "\nSynchronized SQL metadata database";
+        } else {
+            $warning.=$error;
+            print $logfile "\n".$error;
+        }
+    } else {
+        $scrout.='<p>Private Publication - did not synchronize database';
+        print $logfile "\nPrivate: Did not synchronize data into ".
+            "SQL metadata database";
     }
-
-} else {
-    $scrout.='<p>Private Publication - did not synchronize database';
-    print $logfile "\nPrivate: Did not synchronize data into ".
-	"SQL metadata database";
-}
 # ----------------------------------------------------------- Copy old versions
    
 if (-e $target) {
@@ -906,56 +1346,26 @@ if (-e $target) {
 
 # --------------------------------------------------- Send update notifications
 
-{
-
-    my $filename;
- 
-    $target=~/(.*)\/([^\/]+)$/;
-    my $srcf=$2;
-    opendir(DIR,$1);
-    while ($filename=readdir(DIR)) {
-       if ($filename=~/$srcf\.(\w+)$/) {
-	   my $subhost=$1;
-           if ($subhost ne 'meta') {
-	       $scrout.='<p>Notifying host '.$subhost.':';
-               print $logfile "\nNotifying host '.$subhost.':'";
-               my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
-               $scrout.=$reply;
-               print $logfile $reply;              
-           }
-       }
+    my @subscribed=&get_subscribed_hosts($target);
+    foreach my $subhost (@subscribed) {
+	$scrout.='<p>Notifying host '.$subhost.':';
+	print $logfile "\nNotifying host ".$subhost.':';
+	my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
+	$scrout.=$reply;
+	print $logfile $reply;
     }
-    closedir(DIR);
-
-}
 
 # ---------------------------------------- Send update notifications, meta only
 
-{
-
-    my $filename;
- 
-    $target=~/(.*)\/([^\/]+)$/;
-    my $srcf=$2.'.meta';
-    opendir(DIR,$1);
-    while ($filename=readdir(DIR)) {
-       if ($filename=~/$srcf\.(\w+)$/) {
-	   my $subhost=$1;
-           if ($subhost ne 'meta') {
-	       $scrout.=
-                '<p>Notifying host for metadata only '.$subhost.':';
-               print $logfile 
-                "\nNotifying host for metadata only '.$subhost.':'";
-               my $reply=&Apache::lonnet::critical(
-                                'update:'.$target.'.meta',$subhost);
-               $scrout.=$reply;
-               print $logfile $reply;              
-           }
-       }
+    my @subscribedmeta=&get_subscribed_hosts("$target.meta");
+    foreach my $subhost (@subscribedmeta) {
+	$scrout.='<p>Notifying host for metadata only '.$subhost.':';
+	print $logfile "\nNotifying host for metadata only ".$subhost.':';
+	my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
+					    $subhost);
+	$scrout.=$reply;
+	print $logfile $reply;
     }
-    closedir(DIR);
-
-}
 
 # ------------------------------------------------ Provide link to new resource
 
@@ -970,15 +1380,94 @@ if (-e $target) {
 
 
     return $warning.$scrout.
-      '<hr><a href="'.$thisdistarget.'"><font size=+2>View Published Version</font></a>'.
+      '<hr><a href="'.$thisdistarget.'"><font size="+2">'.
+      'View Published Version</font></a>'.
       '<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'.
       '<p><a href="'.$thissrcdir.
-      '"><font size=+2>Back to Source Directory</font></a>';
+      '"><font size="+2">Back to Source Directory</font></a>';
 
 }
 
-# ================================================================ Main Handler
+#########################################
+
+sub batchpublish {
+    my ($r,$srcfile)=@_;
+    my $thisdisfn=$srcfile;
+    $thisdisfn=~s/\/home\/korte\/public_html\///;
+    $srcfile=~s/\/+/\//g;
+    $r->print('<h2>Publishing <tt>'.$thisdisfn.'</tt></h2>');
+}
+
+#########################################
+
+sub publishdirectory {
+    my ($r,$fn,$thisdisfn)=@_;
+      $r->print('<h1>Directory <tt>'.$thisdisfn.'/</tt></h1>');
+
+      my $dirptr=16384;		# Mask indicating a directory in stat.cmode.
+
+      opendir(DIR,$fn);
+      my @files=sort(readdir(DIR));
+      foreach my $filename (@files) {
+         my ($cdev,$cino,$cmode,$cnlink,
+            $cuid,$cgid,$crdev,$csize,
+            $catime,$cmtime,$cctime,
+            $cblksize,$cblocks)=stat($fn.'/'.$filename);
+
+         my $extension='';
+         if ($filename=~/\.(\w+)$/) { $extension=$1; }
+         if ($cmode&$dirptr) {
+	   if (($filename!~/^\./) && ($ENV{'form.pubrec'})) {
+	      &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);
+	   }
+         } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
+                  ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
+             &batchpublish($r,$fn.'/'.$filename);
+             $r->rflush();
+         }
+      }
+      closedir(DIR);
+}
+#########################################
+
+=pod
+
+=item B<handler>
+
+A basic outline of the handler subroutine follows.
+
+=over 4
 
+=item *
+
+Get query string for limited number of parameters.
+
+=item *
+
+Check filename.
+
+=item *
+
+File is there and owned, init lookup tables.
+
+=item *
+
+Start page output.
+
+=item *
+
+Evaluate individual file, and then output information.
+
+=item *
+
+Publishing from $thisfn to $thistarget with $thisembstyle.
+
+=back
+
+=cut
+
+#########################################
+#########################################
 sub handler {
   my $r=shift;
 
@@ -990,17 +1479,8 @@ sub handler {
 
 # Get query string for limited number of parameters
 
-    foreach (split(/&/,$ENV{'QUERY_STRING'})) {
-       my ($name, $value) = split(/=/,$_);
-       $value =~ tr/+/ /;
-       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
-       if ($name eq 'filename') {
-           unless ($ENV{'form.'.$name}) {
-              $ENV{'form.'.$name}=$value;
-	   }
-       }
-    }
-
+    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+                                            ['filename']);
 
 # -------------------------------------------------------------- Check filename
 
@@ -1059,7 +1539,7 @@ sub handler {
 
 unless ($ENV{'form.phase'} eq 'two') {
 
-# --------------------------------- File is there and owned, init lookup tables
+# -------------------------------- File is there and owned, init lookup tables.
 
   %addid=();
 
@@ -1083,56 +1563,61 @@ unless ($ENV{'form.phase'} eq 'two') {
 
 }
 
-# ----------------------------------------------------------- Start page output
+# ---------------------------------------------------------- Start page output.
 
   $r->content_type('text/html');
   $r->send_http_header;
 
   $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
-  $r->print(
-   '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
+  $r->print(&Apache::loncommon::bodytag('Resource Publication'));
   my $thisfn=$fn;
-   
-# ------------------------------------------------------------- Individual file
-  {
-      $thisfn=~/\.(\w+)$/;
-      my $thistype=$1;
-      my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
 
-      my $thistarget=$thisfn;
+  my $thistarget=$thisfn;
       
-      $thistarget=~s/^\/home/$targetdir/;
-      $thistarget=~s/\/public\_html//;
+  $thistarget=~s/^\/home/$targetdir/;
+  $thistarget=~s/\/public\_html//;
 
-      my $thisdistarget=$thistarget;
-      $thisdistarget=~s/^$docroot//;
+  my $thisdistarget=$thistarget;
+  $thisdistarget=~s/^$docroot//;
 
-      my $thisdisfn=$thisfn;
-      $thisdisfn=~s/^\/home\/$cuname\/public_html\///;
+  my $thisdisfn=$thisfn;
+  $thisdisfn=~s/^\/home\/$cuname\/public_html\///;
+
+  if ($fn=~/\/$/) {
+# -------------------------------------------------------- This is a directory
+      &publishdirectory($r,$fn,$thisdisfn);
+
+  } else {
+# ---------------------- Evaluate individual file, and then output information.
+      $thisfn=~/\.(\w+)$/;
+      my $thistype=$1;
+      my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
 
       $r->print('<h2>Publishing '.
         &Apache::loncommon::filedescription($thistype).' <tt>'.
-        $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
+        '<a href="/~'.$cuname.'/'.$thisdisfn.'" target="cat">'.$thisdisfn.
+        '</a></tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
    
-       if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) {
-          $r->print('<h3><font color=red>Co-Author: '.$cuname.' at '.$cudom.
-               '</font></h3>');
+      if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) {
+          $r->print('<h3><font color="red">Co-Author: '.$cuname.' at '.$cudom.
+		    '</font></h3>');
       }
 
       if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
-          $r->print('<br><a href="/adm/diff?filename=/~'.$cuname.'/'.
+          $r->print('<br /><a href="/adm/diff?filename=/~'.$cuname.'/'.
                     $thisdisfn.
-  	  '&versionone=priv" target=cat>Diffs with Current Version</a><p>');
+  	  '&versionone=priv" target="cat">Diffs with Current Version</a><p>');
       }
   
-# ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
+# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.
 
        unless ($ENV{'form.phase'} eq 'two') {
          $r->print(
-          '<hr>'.&publish($thisfn,$thistarget,$thisembstyle));
+          '<hr />'.&publish($thisfn,$thistarget,$thisembstyle));
        } else {
          $r->print(
-          '<hr>'.&phasetwo($thisfn,$thistarget,$thisembstyle,$thisdistarget)); 
+          '<hr />'.&phasetwo($thisfn,$thistarget,
+			     $thisembstyle,$thisdistarget)); 
        }  
 
   }
@@ -1144,107 +1629,9 @@ unless ($ENV{'form.phase'} eq 'two') {
 1;
 __END__
 
-=head1 NAME
-
-Apache::lonpublisher - Publication Handler
-
-=head1 SYNOPSIS
-
-Invoked by /etc/httpd/conf/srm.conf:
-
- <Location /adm/publish>
- PerlAccessHandler       Apache::lonacc
- SetHandler perl-script
- PerlHandler Apache::lonpublisher
- ErrorDocument     403 /adm/login
- ErrorDocument     404 /adm/notfound.html
- ErrorDocument     406 /adm/unauthorized.html
- ErrorDocument	  500 /adm/errorhandler
- </Location>
-
-=head1 INTRODUCTION
-
-This module publishes a file.  This involves gathering metadata,
-versioning the file, copying file from construction space to
-publication space, and copying metadata from construction space
-to publication space.
-
-This is part of the LearningOnline Network with CAPA project
-described at http://www.lon-capa.org.
-
-=head1 HANDLER SUBROUTINE
-
-This routine is called by Apache and mod_perl.
-
-=over 4
-
-=item *
-
-Get query string for limited number of parameters
-
-=item *
-
-Check filename
-
-=item *
-
-File is there and owned, init lookup tables
-
-=item *
-
-Start page output
-
-=item *
-
-Individual file
-
-=item *
-
-publish from $thisfn to $thistarget with $thisembstyle
-
-=back
-
-=head1 OTHER SUBROUTINES
-
-=over 4
-
-=item *
-
-metaeval() : Evaluate string with metadata
-
-=item *
-
-metaread() : Read a metadata file
-
-=item *
-
-sqltime() : convert 'time' format into a datetime sql format
-
-=item *
-
-textfield() : form field
-
-=item *
-
-hiddenfield() : form field
-
-=item *
-
-selectbox() : form field
-
-=item *
-
-urlfixup() : fixup URL (Publication Step One)
-
-=item *
-
-publish() : publish (Publication Step One)
-
-=item *
-
-phasetwo() : render second interface showing status of publication steps
-(Publication Step Two)
+=pod
 
 =back
 
 =cut
+