--- loncom/publisher/lonpublisher.pm	2002/05/17 22:08:01	1.81
+++ loncom/publisher/lonpublisher.pm	2002/08/09 18:03:05	1.91
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Publication Handler
 #
-# $Id: lonpublisher.pm,v 1.81 2002/05/17 22:08:01 albertel Exp $
+# $Id: lonpublisher.pm,v 1.91 2002/08/09 18:03:05 matthew Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -61,6 +61,43 @@
 ##                                                                           ##
 ###############################################################################
 
+
+######################################################################
+######################################################################
+
+=pod 
+
+=head1 Name
+
+lonpublisher - LON-CAPA publishing handler
+
+=head1 Synopsis
+
+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.
+
+=head1 Description
+
+lonpublisher is many things to many people.  
+To all people it is woefully documented.  
+This documentation conforms to this standard.
+
+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 Internal Functions
+
+=over 4
+
+=cut
+
+######################################################################
+######################################################################
+
+
 package Apache::lonpublisher;
 
 # ------------------------------------------------- modules used by this module
@@ -75,6 +112,7 @@ use Apache::loncacc;
 use DBI;
 use Apache::lonnet();
 use Apache::loncommon();
+use Apache::lonmysql;
 
 my %addid;
 my %nokey;
@@ -87,7 +125,19 @@ my $docroot;
 my $cuname;
 my $cudom;
 
-# ----------------------------------------------- Evaluate string with metadata
+#########################################
+#########################################
+
+=pod
+
+=item metaeval
+
+Evaluate string with metadata
+
+=cut
+
+#########################################
+#########################################
 sub metaeval {
     my $metastring=shift;
    
@@ -130,7 +180,19 @@ sub metaeval {
        }
 }
 
-# -------------------------------------------------------- Read a metadata file
+#########################################
+#########################################
+
+=pod
+
+=item metaread
+
+Read a metadata file
+
+=cut
+
+#########################################
+#########################################
 sub metaread {
     my ($logfile,$fn)=@_;
     unless (-e $fn) {
@@ -147,7 +209,19 @@ sub metaread {
     return '<br><b>Processed file:</b> <tt>'.$fn.'</tt>';
 }
 
-# ---------------------------- convert 'time' format into a datetime sql format
+#########################################
+#########################################
+
+=pod
+
+=item sqltime
+
+Convert 'time' format into a datetime sql format
+
+=cut
+
+#########################################
+#########################################
 sub sqltime {
     my $timef=shift @_;
     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
@@ -156,8 +230,28 @@ sub sqltime {
     return "$year-$mon-$mday $hour:$min:$sec";
 }
 
-# --------------------------------------------------------- Various form fields
 
+#########################################
+#########################################
+
+=pod
+
+=item Form field generating functions
+
+=over 4
+
+=item textfield
+
+=item hiddenfield
+
+=item selectbox
+
+=back
+
+=cut
+
+#########################################
+#########################################
 sub textfield {
     my ($title,$name,$value)=@_;
     return "\n<p><b>$title:</b><br>".
@@ -184,8 +278,19 @@ sub selectbox {
     return $selout.'</select>';
 }
 
-# -------------------------------------------------------- Publication Step One
+#########################################
+#########################################
+
+=pod
+
+=item urlfixup
+
+Fix up a url?  First step of publication
 
+=cut
+
+#########################################
+#########################################
 sub urlfixup {
     my ($url,$target)=@_;
     unless ($url) { return ''; }
@@ -206,7 +311,19 @@ sub urlfixup {
     return $url;
 }
 
+#########################################
+#########################################
+
+=pod
+
+=item absoluteurl
+
+Currently undocumented    
 
+=cut
+
+#########################################
+#########################################
 sub absoluteurl {
     my ($url,$target)=@_;
     unless ($url) { return ''; }
@@ -217,6 +334,19 @@ sub absoluteurl {
     return $url;
 }
 
+#########################################
+#########################################
+
+=pod
+
+=item set_allow
+
+Currently undocumented    
+
+=cut
+
+#########################################
+#########################################
 sub set_allow {
     my ($allow,$logfile,$target,$tag,$oldurl)=@_;
     my $newurl=&urlfixup($oldurl,$target);
@@ -235,6 +365,359 @@ sub set_allow {
     return $return_url
 }
 
+#########################################
+#########################################
+
+=pod
+
+=item 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("Un able to open $target.subscription");
+    }
+    &Apache::lonnet::logthis("Got list of ".join(':',@subscribed));
+    return @subscribed;
+}
+
+
+#########################################
+#########################################
+
+=pod
+
+=item 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 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 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 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 publish
+
+Currently undocumented.  This is the workhorse function of this module.
+
+=cut
+
+#########################################
+#########################################
 sub publish {
 
     my ($source,$target,$style)=@_;
@@ -243,7 +726,6 @@ sub publish {
     my $allmeta='';
     my $content='';
     my %allow=();
-    undef %allow;
 
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
 	return 
@@ -264,153 +746,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)) {
-			  print $logfile "for $type, and $key\n";
-			  if ($key =~ /^$type$/i) {
-			      print $logfile "calling set_allow\n";
-			      $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->get_token();
-		      if ($next_token->[0] eq 'T') {
-			  $next_token->[1]=&set_allow(\%allow,$logfile,
-						      $target,$tag,
-						      $next_token->[1]);
-		      }
-		      $parser->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.'>';
-	         } 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>';
@@ -444,8 +782,7 @@ sub publish {
 	       }
            }
         }
-        $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");
@@ -462,13 +799,6 @@ sub publish {
         }
 	  $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
 
@@ -479,7 +809,10 @@ sub publish {
      
      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') {
@@ -533,7 +866,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);
@@ -586,6 +919,7 @@ sub publish {
 
 # --------------------------------------------------- Scan content for keywords
 
+        my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");
 	my $keywordout=<<"END";
 <script>
 function checkAll(field)
@@ -600,7 +934,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 />
@@ -680,6 +1014,7 @@ END
 	$scrout.=&textfield('Publisher/Owner','owner',
                             $metadatafields{'owner'});
 # --------------------------------------------------- Correct copyright for rat        
+
     if ($style eq 'rat') {
 	if ($metadatafields{'copyright'} eq 'public') { 
 	    delete $metadatafields{'copyright'};
@@ -695,12 +1030,27 @@ 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>';
 }
 
-# -------------------------------------------------------- Publication Step Two
+#########################################
+#########################################
+
+=pod 
+
+=item phasetwo
+
+Render second interface showing status of publication steps.
+This is publication step two.
 
+=cut
+
+#########################################
+#########################################
 sub phasetwo {
 
     my ($source,$target,$style,$distarget)=@_;
@@ -771,65 +1121,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) {
@@ -924,56 +1232,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
 
@@ -995,8 +1273,36 @@ if (-e $target) {
 
 }
 
-# ================================================================ Main Handler
 
+#########################################
+#########################################
+
+=pod
+
+=item 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 Individual file
+
+=item publish from $thisfn to $thistarget with $thisembstyle
+
+=back
+
+=cut
+
+#########################################
+#########################################
 sub handler {
   my $r=shift;
 
@@ -1153,107 +1459,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
+