--- loncom/publisher/lonpublisher.pm	2002/07/17 18:23:45	1.84
+++ loncom/publisher/lonpublisher.pm	2002/08/07 19:45:05	1.86
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Publication Handler
 #
-# $Id: lonpublisher.pm,v 1.84 2002/07/17 18:23:45 bowersj2 Exp $
+# $Id: lonpublisher.pm,v 1.86 2002/08/07 19:45:05 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -235,6 +235,208 @@ sub set_allow {
     return $return_url
 }
 
+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;
+}
+
+
+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);
+}
+
+#Arguably this should all be done as an 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)) {
+			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[-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.'>';
+	    } 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);
+}
+
 sub publish {
 
     my ($source,$target,$style)=@_;
@@ -243,7 +445,6 @@ sub publish {
     my $allmeta='';
     my $content='';
     my %allow=();
-    undef %allow;
 
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
 	return 
@@ -264,153 +465,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>';
@@ -461,13 +518,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
 
@@ -931,56 +981,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