--- loncom/publisher/lonpublisher.pm	2001/12/25 21:58:54	1.67
+++ loncom/publisher/lonpublisher.pm	2002/04/17 16:21:46	1.78
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Publication Handler
 #
-# $Id: lonpublisher.pm,v 1.67 2001/12/25 21:58:54 www Exp $
+# $Id: lonpublisher.pm,v 1.78 2002/04/17 16:21:46 matthew Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -43,6 +43,9 @@
 # 12/06,12/07 Gerd Kortemeyer
 # 12/15,12/16 Scott Harrison
 # 12/25 Gerd Kortemeyer
+# YEAR=2002
+# 1/16,1/17 Scott Harrison
+# 1/17 Gerd Kortemeyer
 #
 ###
 
@@ -65,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;
@@ -88,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') {
@@ -146,8 +149,9 @@ sub metaread {
 
 # ---------------------------- convert 'time' format into a datetime sql format
 sub sqltime {
+    my $timef=shift @_;
     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
-	localtime(@_[0]);
+	localtime($timef);
     $mon++; $year+=1900;
     return "$year-$mon-$mday $hour:$min:$sec";
 }
@@ -185,6 +189,11 @@ sub selectbox {
 sub urlfixup {
     my ($url,$target)=@_;
     unless ($url) { return ''; }
+    #javascript code needs no fixing
+    if ($url =~ /^javascript:/i) { return $url; }
+    if ($url =~ /^mailto:/i) { return $url; }
+    #internal document links need no fixing
+    if ($url =~ /^\#/) { return $url; } 
     my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);
     foreach (values %Apache::lonnet::hostname) {
 	if ($_ eq $host) {
@@ -194,6 +203,13 @@ sub urlfixup {
     }
     if ($url=~/^http\:\/\//) { return $url; }
     $url=~s/\~$cuname/res\/$cudom\/$cuname/;
+    return $url;
+}
+
+
+sub absoluteurl {
+    my ($url,$target)=@_;
+    unless ($url) { return ''; }
     if ($target) {
 	$target=~s/\/[^\/]+$//;
        $url=&Apache::lonnet::hreflocation($target,$url);
@@ -241,7 +257,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') {
@@ -272,7 +288,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) {
@@ -298,19 +314,27 @@ sub publish {
                               print $logfile 'Index: '.$tag.':'.$maxindex."\n";
 			  }
 		      }
-		  } 
-                  
-                  foreach ('src','href','background') {
-                      if (defined($parms{$_})) {
-			  my $oldurl=$parms{$_};
-                          my $newurl=&urlfixup($oldurl,$target);
-                          if ($newurl ne $oldurl) {
-			      $parms{$_}=$newurl;
-                              print $logfile 'URL: '.$tag.':'.$oldurl.' - '.
-				  $newurl."\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;
+			      }
 			  }
-                          $allow{$newurl}=1;
-                      }
+			  last;
+		      }
                   }
 
                   if ($lctag eq 'applet') {
@@ -328,7 +352,7 @@ sub publish {
                                   $oldcodebase.' - '.
 				  $codebase."\n";
 			 }
-                         $allow{$codebase.'/*'}=1;
+                         $allow{&absoluteurl($codebase,$target).'/*'}=1;
 		      } else {
                         foreach ('archive','code','object') {
                           if (defined($parms{$_})) {
@@ -338,7 +362,7 @@ sub publish {
                                   print $logfile 'Allow: applet '.$_.':'.
                                   $oldurl.' allows '.
 				  $newurl."\n";
-                              $allow{$newurl}=1;
+                              $allow{&absoluteurl($newurl,$target)}=1;
                           }
                         }
                       }
@@ -373,8 +397,9 @@ sub publish {
     
 	$scrout.='<h3>Dependencies</h3>';
         my $allowstr='';
-        foreach (keys %allow) {
+        foreach (sort(keys(%allow))) {
 	   my $thisdep=$_;
+	   if ($thisdep !~ /[^\s]/) { next; }
            unless ($style eq 'rat') { 
               $allowstr.="\n".'<allow src="'.$thisdep.'" />';
 	   }
@@ -401,8 +426,11 @@ sub publish {
 	       }
            }
         }
+        $allowstr=~s/\n+/\n/g;
         $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;
 
+	#Encode any High ASCII characters
+	$outstring=&HTML::Entities::encode($outstring,"\200-\377");
 # ------------------------------------------------------------- Write modified
 
         {
@@ -510,7 +538,7 @@ sub publish {
                      $chparms;
         }
 
-        my $chparms='';
+        $chparms='';
         foreach (sort keys %oldparmstores) {
 	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
                 unless (($metadatafields{$_.'.name'}) ||
@@ -528,7 +556,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'}).
@@ -540,7 +568,26 @@ sub publish {
 
 # --------------------------------------------------- Scan content for keywords
 
-	my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';
+	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:</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=();
         
@@ -566,13 +613,13 @@ 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'; 
                    }
 	        } elsif (&Apache::loncommon::keyword($_)) {
-		    $keywordout.=' checked';
+	            $keywordout.=' checked';
                 } 
                 $keywordout.='>'.$_.'</td>';
                 if ($colcount>10) {
@@ -600,7 +647,7 @@ sub publish {
 
         $scrout.=&selectbox('Language','language',
                             $metadatafields{'language'},
-			    \&{Apache::loncommon::languagedescription},
+			    \&Apache::loncommon::languagedescription,
 			    (&Apache::loncommon::languageids),
 			     );
 
@@ -621,13 +668,13 @@ sub publish {
 	}
         $scrout.=&selectbox('Copyright/Distribution','copyright',
                             $metadatafields{'copyright'},
-			    \&{Apache::loncommon::copyrightdescription},
+			    \&Apache::loncommon::copyrightdescription,
 		     (grep !/^public$/,(&Apache::loncommon::copyrightids)));
     }
     else {
         $scrout.=&selectbox('Copyright/Distribution','copyright',
                             $metadatafields{'copyright'},
-			    \&{Apache::loncommon::copyrightdescription},
+			    \&Apache::loncommon::copyrightdescription,
 			     (&Apache::loncommon::copyrightids));
     }
     return $scrout.
@@ -641,7 +688,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>';
@@ -668,9 +714,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'})) {
+         my @Keywords = @{$ENV{'form.keywords'}};
+         foreach (@Keywords) {
+             $allkeywords.=','.$_;
          }
      }
      $allkeywords=~s/\W+/\,/;
@@ -696,7 +743,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';
@@ -921,7 +970,7 @@ if (-e $target) {
 
 
     return $warning.$scrout.
-      '<hr><a href="'.$thisdistarget.'"><font size=+2>View Target</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>';