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

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

version 1.7, 2000/11/30 23:01:41 version 1.17, 2001/01/30 21:03:55
Line 5 Line 5
 #  #
 # 05/29/00,05/30,10/11 Gerd Kortemeyer)  # 05/29/00,05/30,10/11 Gerd Kortemeyer)
 #  #
 # 11/28,11/29,11/30 Gerd Kortemeyer  # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
   
 package Apache::lonpublisher;  package Apache::lonpublisher;
   
 use strict;  use strict;
 use Apache::File;  use Apache::File;
   use File::Copy;
 use Apache::Constants qw(:common :http :methods);  use Apache::Constants qw(:common :http :methods);
 use HTML::TokeParser;  use HTML::TokeParser;
 use Apache::lonxml;  use Apache::lonxml;
Line 18  use Apache::lonhomework; Line 19  use Apache::lonhomework;
   
 my %addid;  my %addid;
 my %nokey;  my %nokey;
   my %language;
   my %cprtag;
   
 my %metadatafields;  my %metadatafields;
 my %metadatakeys;  my %metadatakeys;
   
   my $docroot;
   
   # ----------------------------------------------- Evaluate string with metadata
   
 sub metaeval {  sub metaeval {
     my $metastring=shift;      my $metastring=shift;
         
Line 46  sub metaeval { Line 53  sub metaeval {
                   }                    }
               } @{$token->[3]};                } @{$token->[3]};
               if ($metadatafields{$unikey}) {                if ($metadatafields{$unikey}) {
                  $metadatafields{$unikey}.=','.$parser->get_text('/'.$entry);    my $newentry=$parser->get_text('/'.$entry);
                     unless ($metadatafields{$unikey}=~/$newentry/) {
                        $metadatafields{$unikey}.=', '.$newentry;
     }
       } else {        } else {
                  $metadatafields{$unikey}=$parser->get_text('/'.$entry);                   $metadatafields{$unikey}=$parser->get_text('/'.$entry);
               }                }
Line 54  sub metaeval { Line 64  sub metaeval {
        }         }
 }  }
   
   # -------------------------------------------------------- Read a metadata file
   
 sub metaread {  sub metaread {
     my ($logfile,$fn)=@_;      my ($logfile,$fn)=@_;
     unless (-e $fn) {      unless (-e $fn) {
Line 70  sub metaread { Line 82  sub metaread {
     return '<br><b>Processed file:</b> <tt>'.$fn.'</tt>';      return '<br><b>Processed file:</b> <tt>'.$fn.'</tt>';
 }  }
   
   # --------------------------------------------------------- Various form fields
   
   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>';
   }
   
   # -------------------------------------------------------- Publication Step One
   
 sub publish {  sub publish {
   
     my ($source,$target,$style)=@_;      my ($source,$target,$style)=@_;
Line 81  sub publish { Line 119  sub publish {
          '<font color=red>No write permission to user directory, FAIL</font>';           '<font color=red>No write permission to user directory, FAIL</font>';
     }      }
     print $logfile       print $logfile 
 "\n\n================== Publish ".localtime()." =================\n";  "\n\n================= Publish ".localtime()." Phase One  ================\n";
   
     if (($style eq 'ssi') || ($style eq 'rat')) {      if (($style eq 'ssi') || ($style eq 'rat')) {
 # ------------------------------------------------------- This needs processing  # ------------------------------------------------------- This needs processing
   
 # ----------------------------------------------------------------- Backup Copy  # ----------------------------------------------------------------- Backup Copy
  my $copyfile=$source.'.save';   my $copyfile=$source.'.save';
         {          if (copy($source,$copyfile)) {
     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";      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 "<font color=red>Failed to write backup copy, FAIL</font>";            return "<font color=red>Failed to write backup copy, $!,FAIL</font>";
         }          }
 # ------------------------------------------------------------- IDs and indices  # ------------------------------------------------------------- IDs and indices
   
Line 201  sub publish { Line 234  sub publish {
   
 # ---------------------------------------- Storage for metadata keys and fields  # ---------------------------------------- Storage for metadata keys and fields
   
         %metadatafields=();       %metadatafields=();
         %metadatakeys=();       %metadatakeys=();
        
        my %oldparmstores=();
   
 # ------------------------------------------------ First, check out environment  # ------------------------------------------------ First, check out environment
        unless (-e $source.'.meta') {
         $metadatafields{'author'}=$ENV{'environment.firstname'}.' '.          $metadatafields{'author'}=$ENV{'environment.firstname'}.' '.
                           $ENV{'environment.middlename'}.' '.                            $ENV{'environment.middlename'}.' '.
                   $ENV{'environment.lastname'}.' '.                    $ENV{'environment.lastname'}.' '.
                   $ENV{'environment.generation'};                    $ENV{'environment.generation'};
           $metadatafields{'author'}=~s/\s+/ /g;
           $metadatafields{'author'}=~s/\s+$//;
           $metadatafields{'owner'}=$ENV{'user.name'}.'@'.$ENV{'user.domain'};
   
 # ------------------------------------------------ Check out directory hierachy  # ------------------------------------------------ Check out directory hierachy
   
Line 234  sub publish { Line 272  sub publish {
             }              }
         } keys %metadatafields;          } keys %metadatafields;
   
       } else {
 # ---------------------- Read previous metafile, remember parameters and stores  # ---------------------- Read previous metafile, remember parameters and stores
   
         $scrout.=&metaread($logfile,$source.'.meta');          $scrout.=&metaread($logfile,$source.'.meta');
         my %oldparmstores=();  
   
         map {          map {
     if (($_=~/^parameter/) || ($_=~/^stores/)) {      if (($_=~/^parameter/) || ($_=~/^stores/)) {
Line 246  sub publish { Line 284  sub publish {
             }              }
         } keys %metadatafields;          } keys %metadatafields;
                   
       }
   
 # -------------------------------------------------- Parse content for metadata  # -------------------------------------------------- Parse content for metadata
   
  my $allmeta='';          my $allmeta=Apache::lonxml::xmlparse('meta',$content);
         if ($source=~/\.problem$/) {  
     $allmeta=Apache::lonhomework::subhandler('meta',$content);  
         } else {  
             $allmeta=Apache::lonxml::xmlparse('meta',$content);  
  }  
         &metaeval($allmeta);          &metaeval($allmeta);
   
 # ---------------- Find and document discrepancies in the parameters and stores  # ---------------- Find and document discrepancies in the parameters and stores
Line 279  sub publish { Line 312  sub publish {
         my $chparms='';          my $chparms='';
         map {          map {
     if (($_=~/^parameter/) || ($_=~/^stores/)) {      if (($_=~/^parameter/) || ($_=~/^stores/)) {
                 unless (($metadatafields{$_}) || ($_=~/\.\w+$/)) {                  unless (($metadatafields{$_.'.name'}) || ($_=~/\.\w+$/)) {
     print $logfile 'Obsolete: '.$_."\n";      print $logfile 'Obsolete: '.$_."\n";
                     $chparms.=$_.' ';                      $chparms.=$_.' ';
                 }                  }
Line 290  sub publish { Line 323  sub publish {
                      $chparms;                       $chparms;
         }          }
   
 # DEBUG:  # ------------------------------------------------------- Now have all metadata
   
         $scrout.=$allmeta;          $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  # --------------------------------------------------- Scan content for keywords
   
  my $keywordout='<table border=2><tr>';   my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';
         my $colcount=0;          my $colcount=0;
                   
  {   {
Line 315  sub publish { Line 355  sub publish {
                 }                   } 
             } ($textonly=~m/(\w+)/g);              } ($textonly=~m/(\w+)/g);
   
               map {
    $keywords{$_}=1;
               } split(/\W+/,$metadatafields{'keywords'});
   
             map {              map {
                 $keywordout.='<td><input type=checkbox name="'.$_.'">'.$_.                  $keywordout.='<td><input type=checkbox name="key.'.$_.'"';
                              '</td>';                  if ($metadatafields{'keywords'}=~/$_/) { 
                      $keywordout.=' checked'; 
                   }
                   $keywordout.='>'.$_.'</td>';
                 if ($colcount>10) {                  if ($colcount>10) {
     $keywordout.="</tr><tr>\n";      $keywordout.="</tr><tr>\n";
                     $colcount=0;                      $colcount=0;
Line 329  sub publish { Line 375  sub publish {
   
         }                   }         
                   
 # DEGUG  
    
  $scrout.=$keywordout;   $scrout.=$keywordout;
   
           $scrout.=&textfield('Additional Keywords','addkey','');
   
           $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;      return $scrout.
         '<p><input type="submit" value="Finalize Publication"></form>';
   }
   
   # -------------------------------------------------------- Publication Step Two
   
   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{'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'};
   
        my $allkeywords=$ENV{'form.addkey'};
        map {
            if ($_=~/^form\.key\.(\w+)/) {
        $allkeywords.=','.$1;
            }
        } keys %ENV;
        $allkeywords=~s/\W+/\,/;
        $allkeywords=~s/^\,//;
        $metadatafields{'keywords'}=$allkeywords;
    
        {
          print $logfile "\nWrite metadata file for ".$source;
          my $mfh;
          unless ($mfh=Apache::File->new('>'.$source.'.meta')) {
    return 
            '<font color=red>Could not write metadata, FAIL</font>';
          }    
          map {
    unless ($_=~/\./) {
              my $unikey=$_;
              $unikey=~/^([A-Za-z]+)/;
              my $tag=$1;
              $tag=~tr/A-Z/a-z/;
              print $mfh "\n\<$tag";
              map {
                  my $value=$metadatafields{$unikey.'.'.$_};
                  $value=~s/\"/\'\'/g;
                  print $mfh ' '.$_.'="'.$value.'"';
              } split(/\,/,$metadatakeys{$unikey});
      print $mfh '>'.$metadatafields{$unikey}.'</'.$tag.'>';
            }
          } sort keys %metadatafields;
          $scrout.='<p>Wrote Metadata';
          print $logfile "\nWrote metadata";
        }
   
   # ----------------------------------------------------------- Copy old versions
      
   if (-e $target) {
       my $filename;
       my $maxversion=0;
       $target=~/(.*)\/([^\/]+)\.(\w+)$/;
       my $srcf=$2;
       my $srct=$3;
       my $srcd=$1;
       unless ($srcd=~/^\/home\/httpd\/html\/res/) {
    print $logfile "\nPANIC: Target dir is ".$srcd;
           return "<font color=red>Invalid target directory, FAIL</font>";
       }
       opendir(DIR,$srcd);
       while ($filename=readdir(DIR)) {
          if ($filename=~/$srcf\.(\d+)\.$srct$/) {
      $maxversion=($1>$maxversion)?$1:$maxversion;
          }
       }
       closedir(DIR);
       $maxversion++;
       $scrout.='<p>Creating old version '.$maxversion;
       print $logfile "\nCreating old version ".$maxversion;
   
       my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;
   
           if (copy($target,$copyfile)) {
       print $logfile "Copied old target to ".$copyfile."\n";
               $scrout.='<p>Copied old target file';
           } else {
       print $logfile "Unable to write ".$copyfile.':'.$!."\n";
              return "<font color=red>Failed to copy old target, $!, FAIL</font>";
           }
   
   # --------------------------------------------------------------- Copy Metadata
   
    $copyfile=$copyfile.'.meta';
   
           if (copy($target.'.meta',$copyfile)) {
       print $logfile "Copied old target metadata to ".$copyfile."\n";
               $scrout.='<p>Copied old metadata';
           } else {
       print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
               if (-e $target.'.meta') {
                  return 
          "<font color=red>Failed to write old metadata copy, $!, FAIL</font>";
       }
           }
   
   
   } else {
       $scrout.='<p>Initial version';
       print $logfile "\nInitial version";
   }
   
   # ---------------------------------------------------------------- Write Source
    my $copyfile=$target;
   
              my @parts=split(/\//,$copyfile);
              my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
   
              my $count;
              for ($count=5;$count<$#parts;$count++) {
                  $path.="/$parts[$count]";
                  if ((-e $path)!=1) {
                      print $logfile "\nCreating directory ".$path;
                      $scrout.='<p>Created directory '.$parts[$count];
      mkdir($path,0777);
                  }
              }
   
           if (copy($source,$copyfile)) {
       print $logfile "Copied original source to ".$copyfile."\n";
               $scrout.='<p>Copied source file';
           } else {
       print $logfile "Unable to write ".$copyfile.':'.$!."\n";
               return "<font color=red>Failed to copy source, $!, FAIL</font>";
           }
   
   # --------------------------------------------------------------- Copy Metadata
   
           $copyfile=$copyfile.'.meta';
   
           if (copy($source.'.meta',$copyfile)) {
       print $logfile "Copied original metadata to ".$copyfile."\n";
               $scrout.='<p>Copied metadata';
           } else {
       print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
               return 
             "<font color=red>Failed to write metadata copy, $!, FAIL</font>";
           }
   
   # --------------------------------------------------- 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;              
              }
          }
       }
       closedir(DIR);
   
   }
   
   # ------------------------------------------------ Provide link to new resource
   
       my $thisdistarget=$target;
       $thisdistarget=~s/^$docroot//;
   
       return $scrout.
    '<p><a href="'.$thisdistarget.'"><font size=+2>View Target</font></a>';
 }  }
   
 # ================================================================ Main Handler  # ================================================================ Main Handler
Line 347  sub handler { Line 616  sub handler {
      return OK;       return OK;
   }    }
   
   unless ($ENV{'form.pubdir'}) {
 # -------------------------------------------------------------- Check filename  # -------------------------------------------------------------- Check filename
   
   my $fn=$ENV{'form.filename'};    my $fn=$ENV{'form.filename'};
Line 368  sub handler { Line 638  sub handler {
   $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;    $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
   
   my $targetdir='';    my $targetdir='';
   my $docroot=$r->dir_config('lonDocRoot');     $docroot=$r->dir_config('lonDocRoot'); 
   if ($1 ne $ENV{'user.name'}) {    if ($1 ne $ENV{'user.name'}) {
      $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.       $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
          ' trying to publish unowned file '.$ENV{'form.filename'}.           ' trying to publish unowned file '.$ENV{'form.filename'}.
Line 388  sub handler { Line 658  sub handler {
      return HTTP_NOT_FOUND;       return HTTP_NOT_FOUND;
   }     } 
   
   unless ($ENV{'form.phase'} eq 'two') {
   
 # --------------------------------- File is there and owned, init lookup tables  # --------------------------------- File is there and owned, init lookup tables
   
   %addid=();    %addid=();
Line 409  sub handler { Line 681  sub handler {
           $nokey{$word}=1;            $nokey{$word}=1;
       } <$fh>;        } <$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  # ----------------------------------------------------------- Start page output
   
   $r->content_type('text/html');    $r->content_type('text/html');
   $r->send_http_header;    $r->send_http_header;
   
   $r->print('<html><head><title>LON-CAPA Publishing</title></head>');    $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
   $r->print('<body bgcolor="#FFFFFF">');    $r->print(
      '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
   my $thisfn=$fn;    my $thisfn=$fn;
         
 # ------------------------------------------------------------- Individual file  # ------------------------------------------------------------- Individual file
Line 438  sub handler { Line 734  sub handler {
       $r->print('<h2>Publishing '.        $r->print('<h2>Publishing '.
         &Apache::lonnet::filedescription($thistype).' <tt>'.          &Apache::lonnet::filedescription($thistype).' <tt>'.
         $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');          $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
     
 # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle  # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle
   
       $r->print('<hr>'.&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>');    $r->print('</body></html>');
   } else {
   
     my $fn=$ENV{'form.filename'};
   
     $fn=~s/\/[^\/]+$//;
     my $thisprefix=$fn;
     $thisprefix=~s/\/\~/\/priv\//;
   
     $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
   
     unless ($fn) { 
        $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
            ' trying to publish empty directory', $r->filename); 
        return HTTP_NOT_FOUND;
     } 
   
   # ----------------------------------------------------------- Start page output
   
     $r->content_type('text/html');
     $r->send_http_header;
   
     $r->print('<html><head><title>LON-CAPA Publishing Directory</title></head>');
     $r->print(
      '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');
   
     my $thisdisfn=$fn;
     $thisdisfn=~s/^\/home\/$ENV{'user.name'}\/public_html\///;
     
     $r->print('<h1>Publishing directory <tt>'.$thisdisfn.'</tt></h1>');
     my $i=0;
     $r->print('<script>');
       my $filename;
       opendir(DIR,$fn);
          while ($filename=readdir(DIR)) {
              $filename=~/\.(\w+)$/;
              if ((&Apache::lonnet::fileembstyle($1)) && ($1 ne 'meta')) {
         $r->print(<<ENDOPEN);
         pub$i=window.open("$thisprefix/$filename","LONCAPApub$i",
                                   "menubar=no,height=450,width=650");
   ENDOPEN
                 $i++;     
      }
          }
       closedir(DIR);
     $r->print('</script>');
   
     $r->print('</body></html>');
     
   }
   return OK;    return OK;
 }  }
   
Removed from v.1.7  
changed lines
  Added in v.1.17

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