--- loncom/publisher/lonpublisher.pm	2000/11/30 16:22:13	1.6
+++ loncom/publisher/lonpublisher.pm	2000/11/30 23:01:41	1.7
@@ -19,6 +19,57 @@ use Apache::lonhomework;
 my %addid;
 my %nokey;
 
+my %metadatafields;
+my %metadatakeys;
+
+sub metaeval {
+    my $metastring=shift;
+   
+        my $parser=HTML::TokeParser->new(\$metastring);
+        my $token;
+        while ($token=$parser->get_token) {
+           if ($token->[0] eq 'S') {
+	      my $entry=$token->[1];
+              my $unikey=$entry;
+              if (defined($token->[2]->{'part'})) { 
+                 $unikey.='_'.$token->[2]->{'part'}; 
+	      }
+              if (defined($token->[2]->{'name'})) { 
+                 $unikey.='_'.$token->[2]->{'name'}; 
+	      }
+               map {
+		  $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
+                  if ($metadatakeys{$unikey}) {
+		      $metadatakeys{$unikey}.=','.$_;
+                  } else {
+                      $metadatakeys{$unikey}=$_;
+                  }
+              } @{$token->[3]};
+              if ($metadatafields{$unikey}) {
+                 $metadatafields{$unikey}.=','.$parser->get_text('/'.$entry);
+	      } else {
+                 $metadatafields{$unikey}=$parser->get_text('/'.$entry);
+              }
+          }
+       }
+}
+
+sub metaread {
+    my ($logfile,$fn)=@_;
+    unless (-e $fn) {
+	print $logfile 'No file '.$fn."\n";
+        return '<br><b>No file:</b> <tt>'.$fn.'</tt>';
+    }
+    print $logfile 'Processing '.$fn."\n";
+    my $metastring;
+    {
+     my $metafh=Apache::File->new($fn);
+     $metastring=join('',<$metafh>);
+    }
+    &metaeval($metastring);
+    return '<br><b>Processed file:</b> <tt>'.$fn.'</tt>';
+}
+
 sub publish {
 
     my ($source,$target,$style)=@_;
@@ -26,7 +77,8 @@ sub publish {
     my $scrout='';
 
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
-	return 'No write permission to user directory, FAIL';
+	return 
+         '<font color=red>No write permission to user directory, FAIL</font>';
     }
     print $logfile 
 "\n\n================== Publish ".localtime()." =================\n";
@@ -45,7 +97,7 @@ sub publish {
 	    print $logfile "Copied original file to ".$copyfile."\n";
         } else {
 	    print $logfile "Unable to write backup ".$copyfile."\n";
-            return "Failed to write backup copy, FAIL";
+            return "<font color=red>Failed to write backup copy, FAIL</font>";
         }
 # ------------------------------------------------------------- IDs and indices
 
@@ -132,7 +184,8 @@ sub publish {
           my $org;
           unless ($org=Apache::File->new('>'.$source)) {
              print $logfile "No write permit to $source\n";
-             return "No write permission to $source, FAIL";
+             return 
+              "<font color=red>No write permission to $source, FAIL</font>";
 	  }
           print $org $outstring;
         }
@@ -143,6 +196,58 @@ sub publish {
       } else {
 	  print $logfile "Does not need ID and/or index fixup\n";
       }
+
+# --------------------------------------------- Initial step done, now metadata
+
+# ---------------------------------------- Storage for metadata keys and fields
+
+        %metadatafields=();
+        %metadatakeys=();
+
+# ------------------------------------------------ First, check out environment
+
+        $metadatafields{'author'}=$ENV{'environment.firstname'}.' '.
+	                          $ENV{'environment.middlename'}.' '.
+		                  $ENV{'environment.lastname'}.' '.
+		                  $ENV{'environment.generation'};
+
+# ------------------------------------------------ Check out directory hierachy
+
+        my $thisdisfn=$source;
+        $thisdisfn=~s/^\/home\/$ENV{'user.name'}\///;
+
+        my @urlparts=split(/\//,$thisdisfn);
+        $#urlparts--;
+
+        my $currentpath='/home/'.$ENV{'user.name'}.'/';
+
+        map {
+	    $currentpath.=$_.'/';
+            $scrout.=&metaread($logfile,$currentpath.'default.meta');
+        } @urlparts;
+
+# ------------------- Clear out parameters and stores (there should not be any)
+
+        map {
+	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
+		delete $metadatafields{$_};
+            }
+        } keys %metadatafields;
+
+# ---------------------- Read previous metafile, remember parameters and stores
+
+        $scrout.=&metaread($logfile,$source.'.meta');
+        my %oldparmstores=();
+
+        map {
+	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
+                $oldparmstores{$_}=1;
+		delete $metadatafields{$_};
+            }
+        } keys %metadatafields;
+        
+
+
 # -------------------------------------------------- Parse content for metadata
 
 	my $allmeta='';
@@ -151,12 +256,49 @@ sub publish {
         } else {
             $allmeta=Apache::lonxml::xmlparse('meta',$content);
 	}
+        &metaeval($allmeta);
+
+# ---------------- Find and document discrepancies in the parameters and stores
+
+        my $chparms='';
+        map {
+	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
+                unless ($_=~/\.\w+$/) { 
+                   unless ($oldparmstores{$_}) {
+		      print $logfile 'New: '.$_."\n";
+                      $chparms.=$_.' ';
+                   }
+	        }
+            }
+        } sort keys %metadatafields;
+        if ($chparms) {
+	    $scrout.='<p><b>New parameters or stored values:</b> '.
+                     $chparms;
+        }
+
+        my $chparms='';
+        map {
+	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
+                unless (($metadatafields{$_}) || ($_=~/\.\w+$/)) {
+		    print $logfile 'Obsolete: '.$_."\n";
+                    $chparms.=$_.' ';
+                }
+            }
+        } sort keys %oldparmstores;
+        if ($chparms) {
+	    $scrout.='<p><b>Obsolete parameters or stored values:</b> '.
+                     $chparms;
+        }
 
 # DEBUG:
 
-        $scrout=$allmeta;
+        $scrout.=$allmeta;
 
 # --------------------------------------------------- Scan content for keywords
+
+	my $keywordout='<table border=2><tr>';
+        my $colcount=0;
+        
 	{
 	    my $textonly=$content;
             $textonly=~s/\<script[^\<]+\<\/script\>//g;
@@ -173,13 +315,23 @@ sub publish {
                 } 
             } ($textonly=~m/(\w+)/g);
 
-# DEBUG:
 
-	       $scrout.=join('<br>',sort keys %keywords);
+            map {
+                $keywordout.='<td><input type=checkbox name="'.$_.'">'.$_.
+                             '</td>';
+                if ($colcount>10) {
+		    $keywordout.="</tr><tr>\n";
+                    $colcount=0;
+                }
+                $colcount++;
+            } sort keys %keywords;
+            $keywordout.='</tr></table>';
 
         }         
         
-
+# DEGUG
+ 
+	$scrout.=$keywordout;
     }
     return $scrout;
 }
@@ -289,7 +441,7 @@ sub handler {
 
 # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
 
-      $r->print('<b>Result:</b> '.&publish($thisfn,$thistarget,$thisembstyle));
+      $r->print('<hr>'.&publish($thisfn,$thistarget,$thisembstyle));
       
   }