[BACK]Return to lonpublisher.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / publisher

Diff for /loncom/publisher/lonpublisher.pm between versions 1.6 and 1.7

version 1.6, 2000/11/30 16:22:13 version 1.7, 2000/11/30 23:01:41
Line 19  use Apache::lonhomework; Line 19  use Apache::lonhomework;
 my %addid;  my %addid;
 my %nokey;  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 {  sub publish {
   
     my ($source,$target,$style)=@_;      my ($source,$target,$style)=@_;
Line 26  sub publish { Line 77  sub publish {
     my $scrout='';      my $scrout='';
   
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      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       print $logfile 
 "\n\n================== Publish ".localtime()." =================\n";  "\n\n================== Publish ".localtime()." =================\n";
Line 45  sub publish { Line 97  sub publish {
     print $logfile "Copied original file to ".$copyfile."\n";      print $logfile "Copied original file to ".$copyfile."\n";
         } else {          } else {
     print $logfile "Unable to write backup ".$copyfile."\n";      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  # ------------------------------------------------------------- IDs and indices
   
Line 132  sub publish { Line 184  sub publish {
           my $org;            my $org;
           unless ($org=Apache::File->new('>'.$source)) {            unless ($org=Apache::File->new('>'.$source)) {
              print $logfile "No write permit to $source\n";               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;            print $org $outstring;
         }          }
Line 143  sub publish { Line 196  sub publish {
       } else {        } else {
   print $logfile "Does not need ID and/or index fixup\n";    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  # -------------------------------------------------- Parse content for metadata
   
  my $allmeta='';   my $allmeta='';
Line 151  sub publish { Line 256  sub publish {
         } else {          } else {
             $allmeta=Apache::lonxml::xmlparse('meta',$content);              $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:  # DEBUG:
   
         $scrout=$allmeta;          $scrout.=$allmeta;
   
 # --------------------------------------------------- Scan content for keywords  # --------------------------------------------------- Scan content for keywords
   
    my $keywordout='<table border=2><tr>';
           my $colcount=0;
           
  {   {
     my $textonly=$content;      my $textonly=$content;
             $textonly=~s/\<script[^\<]+\<\/script\>//g;              $textonly=~s/\<script[^\<]+\<\/script\>//g;
Line 173  sub publish { Line 315  sub publish {
                 }                   } 
             } ($textonly=~m/(\w+)/g);              } ($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;      return $scrout;
 }  }
Line 289  sub handler { Line 441  sub handler {
   
 # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle  # ------------ 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));
               
   }      }  
   
Removed from v.1.6  
changed lines
  Added in v.1.7

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>