--- loncom/publisher/lonpublisher.pm	2000/11/29 12:28:46	1.2
+++ loncom/publisher/lonpublisher.pm	2000/12/02 20:55:16	1.11
@@ -5,7 +5,7 @@
 #
 # 05/29/00,05/30,10/11 Gerd Kortemeyer)
 #
-# 11/28,11/29 Gerd Kortemeyer
+# 11/28,11/29,11/30,12/01,12/02 Gerd Kortemeyer
 
 package Apache::lonpublisher;
 
@@ -13,19 +13,431 @@ use strict;
 use Apache::File;
 use Apache::Constants qw(:common :http :methods);
 use HTML::TokeParser;
+use Apache::lonxml;
+use Apache::structuretags;
+use Apache::response;
+
+my %addid;
+my %nokey;
+my %language;
+my %cprtag;
+
+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}) {
+		  my $newentry=$parser->get_text('/'.$entry);
+                  unless ($metadatafields{$unikey}=~/$newentry/) {
+                     $metadatafields{$unikey}.=', '.$newentry;
+		  }
+	      } 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 textfield {
+    my ($title,$name,$value)=@_;
+    return "\n<p><b>$title:</b><br>".
+           '<input type=text name="'.$name.'" size=80 value="'.$value.'">';
+}
+
+sub hiddenfield {
+    my ($name,$value)=@_;
+    return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';
+}
+
+sub selectbox {
+    my ($title,$name,$value,%options)=@_;
+    my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';
+    map {
+        $selout.='<option value="'.$_.'"';
+        if ($_ eq $value) { $selout.=' selected'; }
+        $selout.='>'.$options{$_}.'</option>';
+    } sort keys %options;
+    return $selout.'</select>';
+}
 
 sub publish {
+
     my ($source,$target,$style)=@_;
     my $logfile;
+    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";
+"\n\n================= Publish ".localtime()." Phase One  ================\n";
+
+    if (($style eq 'ssi') || ($style eq 'rat')) {
+# ------------------------------------------------------- This needs processing
+
+# ----------------------------------------------------------------- Backup Copy
+	my $copyfile=$source.'.save';
+        {
+	    my $org=Apache::File->new($source);
+            my $cop=Apache::File->new('>'.$copyfile);
+            while (my $line=<$org>) { print $cop $line; }
+        }
+        if (-e $copyfile) {
+	    print $logfile "Copied original file to ".$copyfile."\n";
+        } else {
+	    print $logfile "Unable to write backup ".$copyfile."\n";
+            return "<font color=red>Failed to write backup copy, FAIL</font>";
+        }
+# ------------------------------------------------------------- IDs and indices
+
+        my $maxindex=10;
+        my $maxid=10;
+        my $content='';
+        my $needsfixup=0;
+
+        {
+          my $org=Apache::File->new($source);
+          $content=join('',<$org>);
+        }
+        {
+          my $parser=HTML::TokeParser->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::TokeParser->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'})) {
+			      $outstring.=$token->[4];
+			  } else {
+                              $maxid++;
+                              my $thisid=' id="'.$maxid.'"';
+			      my $fixup=$token->[4];
+                              $fixup=~s/(\<\w+)/$1$thisid/;
+                              $outstring.=$fixup;
+                              print $logfile 'ID: '.$fixup."\n";
+                          }
+                      } else {
+ 			  if (defined($token->[2]->{'index'})) {
+			      $outstring.=$token->[4];
+			  } else {
+                              $maxindex++;
+                              my $thisindex=' index="'.$maxindex.'"';
+			      my $fixup=$token->[4];
+                              $fixup=~s/(\<\w+)/$1$thisindex/;
+                              $outstring.=$fixup;
+                              print $logfile 'Index: '.$fixup."\n";
+			  }
+		      }
+		  } else {
+                      $outstring.=$token->[4];
+                  }
+              } elsif ($token->[0] eq 'E') {
+                  $outstring.=$token->[2];
+              } else {
+                  $outstring.=$token->[1];
+              }
+          }
+        {
+          my $org;
+          unless ($org=Apache::File->new('>'.$source)) {
+             print $logfile "No write permit to $source\n";
+             return 
+              "<font color=red>No write permission to $source, FAIL</font>";
+	  }
+          print $org $outstring;
+        }
+	  $content=$outstring;
+          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
+
+# ---------------------------------------- Storage for metadata keys and fields
+
+     %metadatafields=();
+     %metadatakeys=();
+     
+     my %oldparmstores=();
+
+# ------------------------------------------------ First, check out environment
+     unless (-e $source.'.meta') {
+        $metadatafields{'author'}=$ENV{'environment.firstname'}.' '.
+	                          $ENV{'environment.middlename'}.' '.
+		                  $ENV{'environment.lastname'}.' '.
+		                  $ENV{'environment.generation'};
+        $metadatafields{'author'}=~s/\s+/ /g;
+        $metadatafields{'author'}=~s/\s+$//;
+        $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'};
+
+# ------------------------------------------------ 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;
+
+    } else {
+# ---------------------- Read previous metafile, remember parameters and stores
+
+        $scrout.=&metaread($logfile,$source.'.meta');
+
+        map {
+	    if (($_=~/^parameter/) || ($_=~/^stores/)) {
+                $oldparmstores{$_}=1;
+		delete $metadatafields{$_};
+            }
+        } keys %metadatafields;
+        
+    }
+
+# -------------------------------------------------- Parse content for metadata
+
+        my $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;
+        }
+
+# ------------------------------------------------------- Now have all metadata
+
+        $scrout.=
+     '<form action="/adm/publish" method="post">'.
+          &hiddenfield('phase','two').
+          &hiddenfield('filename',$ENV{'form.filename'}).
+	  &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).
+          &textfield('Title','title',$metadatafields{'title'}).
+          &textfield('Author(s)','author',$metadatafields{'author'}).
+	  &textfield('Subject','subject',$metadatafields{'subject'});
+
+# --------------------------------------------------- Scan content for keywords
+
+	my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';
+        my $colcount=0;
+        
+	{
+	    my $textonly=$content;
+            $textonly=~s/\<script[^\<]+\<\/script\>//g;
+            $textonly=~s/\<m\>[^\<]+\<\/m\>//g;
+            $textonly=~s/\<[^\>]*\>//g;
+            $textonly=~tr/A-Z/a-z/;
+            $textonly=~s/[\$\&][a-z]\w*//g;
+            $textonly=~s/[^a-z\s]//g;
+
+            my %keywords=();
+            map {
+		unless ($nokey{$_}) {
+                   $keywords{$_}=1;
+                } 
+            } ($textonly=~m/(\w+)/g);
+
+
+            map {
+                $keywordout.='<td><input type=checkbox name="'.$_.'"';
+                if ($metadatafields{'keywords'}=~/$_/) { 
+                   $keywordout.=' checked'; 
+                }
+                $keywordout.='>'.$_.'</td>';
+                if ($colcount>10) {
+		    $keywordout.="</tr><tr>\n";
+                    $colcount=0;
+                }
+                $colcount++;
+            } sort keys %keywords;
+            $keywordout.='</tr></table>';
+
+        }         
+        
+	$scrout.=$keywordout;
+
+        $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
+
+        $scrout.=
+             '<p><b>Abstract:</b><br><textarea cols=80 rows=5 name=abstract>'.
+              $metadatafields{'abstract'}.'</textarea>';
+
+	$source=~/\.(\w+)$/;
+
+	$scrout.=&hiddenfield('mime',$1);
+
+        $scrout.=&selectbox('Language','language',
+                            $metadatafields{'language'},%language);
+
+        unless ($metadatafields{'creationdate'}) {
+	    $metadatafields{'creationdate'}=time;
+        }
+        $scrout.=&hiddenfield('creationdate',$metadatafields{'creationdate'});
+
+        $scrout.=&hiddenfield('lastrevisiondate',time);
+
+			   
+	$scrout.=&textfield('Publisher/Owner','owner',
+                            $metadatafields{'owner'});
+
+        $scrout.=&selectbox('Copyright/Distribution','copyright',
+                            $metadatafields{'copyright'},%cprtag);
+
+    }
+    return $scrout.
+      '<p><input type="submit" value="Finalize Publication"></form>';
+}
+
+sub phasetwo {
+
+    my ($source,$target,$style)=@_;
+    my $logfile;
+    my $scrout='';
+
+    unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
+	return 
+         '<font color=red>No write permission to user directory, FAIL</font>';
+    }
+    print $logfile 
+"\n================= Publish ".localtime()." Phase Two  ================\n";
+
+     %metadatafields=();
+     %metadatakeys=();
+
+     &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));
+
+     $metadatafields{'title'}=$ENV{'form.title'};
+     $metadatafields{'author'}=$ENV{'form.author'};
+     $metadatafields{'subject'}=$ENV{'form.subject'};
+     $metadatafields{'keywords'}=$ENV{'form.keywords'};
+     $metadatafields{'notes'}=$ENV{'form.notes'};
+     $metadatafields{'abstract'}=$ENV{'form.abstract'};
+     $metadatafields{'mime'}=$ENV{'form.mime'};
+     $metadatafields{'language'}=$ENV{'form.language'};
+     $metadatafields{'creationdate'}=$ENV{'form.creationdate'};
+     $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};
+     $metadatafields{'owner'}=$ENV{'form.owner'};
+     $metadatafields{'copyright'}=$ENV{'form.copyright'};
+     
+     map {
+         print $logfile "\n".$_.': '.$metadatafields{$_}.
+	           "\n".$_.'.keys: '.$metadatakeys{$_};
+     } sort keys %metadatafields;
+
 
-    my $version='';
-   
-    return 'Version '.$version.', SUCCESS';
 }
 
 # ================================================================ Main Handler
@@ -49,6 +461,14 @@ sub handler {
      return HTTP_NOT_FOUND;
   } 
 
+  unless ($ENV{'user.home'} eq $r->dir_config('lonHostID')) {
+     $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
+         ' trying to publish file '.$ENV{'form.filename'}.
+         ' ('.$fn.') - not homeserver ('.$ENV{'user.home'}.')', 
+         $r->filename); 
+     return HTTP_NOT_ACCEPTABLE;
+  }
+
   $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
 
   my $targetdir='';
@@ -72,8 +492,52 @@ sub handler {
      return HTTP_NOT_FOUND;
   } 
 
+unless ($ENV{'form.phase'} eq 'two') {
+
 # --------------------------------- File is there and owned, init lookup tables
 
+  %addid=();
+
+  {
+      my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
+      while (<$fh>=~/(\w+)\s+(\w+)/) {
+          $addid{$1}=$2;
+      }
+  }
+
+  %nokey=();
+
+  {
+     my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
+      map {
+          my $word=$_;
+          chomp($word);
+          $nokey{$word}=1;
+      } <$fh>;
+  }
+
+  %language=();
+
+  {
+     my $fh=Apache::File->new($r->dir_config('lonTabDir').'/language.tab');
+      map {
+          $_=~/(\w+)\s+([\w\s\-]+)/;
+          $language{$1}=$2;
+      } <$fh>;
+  }
+
+  %cprtag=();
+
+  {
+     my $fh=Apache::File->new($r->dir_config('lonIncludes').'/copyright.tab');
+      map {
+          $_=~/(\w+)\s+([\w\s\-]+)/;
+          $cprtag{$1}=$2;
+      } <$fh>;
+  }
+
+}
+
 # ----------------------------------------------------------- Start page output
 
   $r->content_type('text/html');
@@ -103,13 +567,16 @@ sub handler {
       $r->print('<h2>Publishing '.
         &Apache::lonnet::filedescription($thistype).' <tt>'.
         $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
-
+  
 # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
 
-      $r->print('<b>Result:</b> '.&publish($thisfn,$thistarget,$thisembstyle));
-      
-  }  
+       unless ($ENV{'form.phase'} eq 'two') {
+          $r->print('<hr>'.&publish($thisfn,$thistarget,$thisembstyle));
+       } else {
+          $r->print('<hr>'.&phasetwo($thisfn,$thistarget,$thisembstyle));      
+       }  
 
+  }
   $r->print('</body></html>');
 
   return OK;