--- loncom/publisher/lonpublisher.pm	2002/03/25 17:09:21	1.75
+++ loncom/publisher/lonpublisher.pm	2002/07/26 19:35:20	1.85
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Publication Handler
 #
-# $Id: lonpublisher.pm,v 1.75 2002/03/25 17:09:21 matthew Exp $
+# $Id: lonpublisher.pm,v 1.85 2002/07/26 19:35:20 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -68,7 +68,7 @@ use strict;
 use Apache::File;
 use File::Copy;
 use Apache::Constants qw(:common :http :methods);
-use HTML::TokeParser;
+use HTML::LCParser;
 use Apache::lonxml;
 use Apache::lonhomework;
 use Apache::loncacc;
@@ -91,7 +91,7 @@ my $cudom;
 sub metaeval {
     my $metastring=shift;
    
-        my $parser=HTML::TokeParser->new(\$metastring);
+        my $parser=HTML::LCParser->new(\$metastring);
         my $token;
         while ($token=$parser->get_token) {
            if ($token->[0] eq 'S') {
@@ -217,6 +217,56 @@ sub absoluteurl {
     return $url;
 }
 
+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
+}
+
+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 publish {
 
     my ($source,$target,$style)=@_;
@@ -257,7 +307,7 @@ sub publish {
           $content=join('',<$org>);
         }
         {
-          my $parser=HTML::TokeParser->new(\$content);
+          my $parser=HTML::LCParser->new(\$content);
           my $token;
           while ($token=$parser->get_token) {
               if ($token->[0] eq 'S') {
@@ -288,7 +338,7 @@ sub publish {
                 "Max Index: $maxindex (min 10)\n";
       }
           my $outstring='';
-          my $parser=HTML::TokeParser->new(\$content);
+          my $parser=HTML::LCParser->new(\$content);
           $parser->xml_mode(1);
           my $token;
           while ($token=$parser->get_token) {
@@ -318,25 +368,25 @@ sub publish {
 
                   foreach my $type ('src','href','background','bgimg') {
 		      foreach my $key (keys(%parms)) {
+			  print $logfile "for $type, and $key\n";
 			  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;
-			      }
+			      print $logfile "calling set_allow\n";
+			      $parms{$key}=&set_allow(\%allow,$logfile,
+						      $target,$tag,
+						      $parms{$key});
 			  }
-			  last;
 		      }
                   }
-
+		  # 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'})) {
@@ -426,9 +476,10 @@ 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");
 # ------------------------------------------------------------- Write modified
 
         {
@@ -459,7 +510,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') {
@@ -513,7 +567,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);
@@ -554,7 +608,7 @@ sub publish {
 # ------------------------------------------------------- Now have all metadata
 
         $scrout.=
-     '<form action="/adm/publish" method="post">'.
+     '<form name="pubform" action="/adm/publish" method="post">'.
        '<p><input type="submit" value="Finalize Publication" /></p>'.
           &hiddenfield('phase','two').
           &hiddenfield('filename',$ENV{'form.filename'}).
@@ -566,7 +620,27 @@ sub publish {
 
 # --------------------------------------------------- Scan content for keywords
 
-	my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';
+        my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");
+	my $keywordout=<<"END";
+<script>
+function checkAll(field)
+{
+    for (i = 0; i < field.length; i++)
+        field[i].checked = true ;
+}
+
+function uncheckAll(field)
+{
+    for (i = 0; i < field.length; i++)
+        field[i].checked = false ;
+}
+</script>
+<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 />
+END
+        $keywordout.='<table border=2><tr>';
         my $colcount=0;
         my %keywords=();
         
@@ -592,7 +666,7 @@ sub publish {
             }
 
             foreach (sort keys %keywords) {
-                $keywordout.='<td><input type=checkbox name="key.'.$_.'"';
+                $keywordout.='<td><input type=checkbox name="keywords" value="'.$_.'"';
                 if ($metadatafields{'keywords'}) {
                    if ($metadatafields{'keywords'}=~/$_/) { 
                       $keywordout.=' checked'; 
@@ -641,6 +715,7 @@ sub publish {
 	$scrout.=&textfield('Publisher/Owner','owner',
                             $metadatafields{'owner'});
 # --------------------------------------------------- Correct copyright for rat        
+
     if ($style eq 'rat') {
 	if ($metadatafields{'copyright'} eq 'public') { 
 	    delete $metadatafields{'copyright'};
@@ -656,6 +731,9 @@ sub publish {
 			    \&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>';
 }
@@ -667,7 +745,6 @@ sub phasetwo {
     my ($source,$target,$style,$distarget)=@_;
     my $logfile;
     my $scrout='';
-
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
 	return 
          '<font color=red>No write permission to user directory, FAIL</font>';
@@ -694,9 +771,10 @@ sub phasetwo {
      $metadatafields{'dependencies'}=$ENV{'form.dependencies'};
 
      my $allkeywords=$ENV{'form.addkey'};
-     foreach (keys %ENV) {
-         if ($_=~/^form\.key\.(\w+)/) {
-	     $allkeywords.=','.$1;
+     if (exists($ENV{'form.keywords'}) && (ref($ENV{'form.keywords'}))) {
+         my @Keywords = @{$ENV{'form.keywords'}};
+         foreach (@Keywords) {
+             $allkeywords.=','.$_;
          }
      }
      $allkeywords=~s/\W+/\,/;
@@ -722,7 +800,9 @@ sub phasetwo {
                $value=~s/\"/\'\'/g;
                print $mfh ' '.$_.'="'.$value.'"';
            }
-	   print $mfh '>'.$metadatafields{$unikey}.'</'.$tag.'>';
+	   print $mfh '>'.
+	     &HTML::Entities::encode($metadatafields{$unikey})
+	       .'</'.$tag.'>';
          }
        }
        $scrout.='<p>Wrote Metadata';
@@ -883,56 +963,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
 
@@ -967,17 +1017,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