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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.11 and 1.12

version 1.11, 2000/12/02 20:55:16 version 1.12, 2000/12/04 12:27:58
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,12/01,12/02 Gerd Kortemeyer  # 11/28,11/29,11/30,12/01,12/02,12/04 Gerd Kortemeyer
   
 package Apache::lonpublisher;  package Apache::lonpublisher;
   
Line 15  use Apache::Constants qw(:common :http : Line 15  use Apache::Constants qw(:common :http :
 use HTML::TokeParser;  use HTML::TokeParser;
 use Apache::lonxml;  use Apache::lonxml;
 use Apache::structuretags;  use Apache::structuretags;
   use Apache::inputtags;
 use Apache::response;  use Apache::response;
   
 my %addid;  my %addid;
Line 25  my %cprtag; Line 26  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 60  sub metaeval { Line 65  sub metaeval {
        }         }
 }  }
   
   # -------------------------------------------------------- Read a metadata file
   
 sub metaread {  sub metaread {
     my ($logfile,$fn)=@_;      my ($logfile,$fn)=@_;
     unless (-e $fn) {      unless (-e $fn) {
Line 76  sub metaread { Line 83  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 {  sub textfield {
     my ($title,$name,$value)=@_;      my ($title,$name,$value)=@_;
     return "\n<p><b>$title:</b><br>".      return "\n<p><b>$title:</b><br>".
Line 98  sub selectbox { Line 107  sub selectbox {
     return $selout.'</select>';      return $selout.'</select>';
 }  }
   
   # -------------------------------------------------------- Publication Step One
   
 sub publish {  sub publish {
   
     my ($source,$target,$style)=@_;      my ($source,$target,$style)=@_;
Line 307  sub publish { Line 318  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 350  sub publish { Line 361  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.'.$_.'"';
                 if ($metadatafields{'keywords'}=~/$_/) {                   if ($metadatafields{'keywords'}=~/$_/) { 
                    $keywordout.=' checked';                      $keywordout.=' checked'; 
                 }                  }
Line 369  sub publish { Line 383  sub publish {
                   
  $scrout.=$keywordout;   $scrout.=$keywordout;
   
           $scrout.=&textfield('Additional Keywords','addkey','');
   
         $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});          $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
   
         $scrout.=          $scrout.=
Line 401  sub publish { Line 417  sub publish {
       '<p><input type="submit" value="Finalize Publication"></form>';        '<p><input type="submit" value="Finalize Publication"></form>';
 }  }
   
   # -------------------------------------------------------- Publication Step Two
   
 sub phasetwo {  sub phasetwo {
   
     my ($source,$target,$style)=@_;      my ($source,$target,$style)=@_;
Line 422  sub phasetwo { Line 440  sub phasetwo {
      $metadatafields{'title'}=$ENV{'form.title'};       $metadatafields{'title'}=$ENV{'form.title'};
      $metadatafields{'author'}=$ENV{'form.author'};       $metadatafields{'author'}=$ENV{'form.author'};
      $metadatafields{'subject'}=$ENV{'form.subject'};       $metadatafields{'subject'}=$ENV{'form.subject'};
      $metadatafields{'keywords'}=$ENV{'form.keywords'};  
      $metadatafields{'notes'}=$ENV{'form.notes'};       $metadatafields{'notes'}=$ENV{'form.notes'};
      $metadatafields{'abstract'}=$ENV{'form.abstract'};       $metadatafields{'abstract'}=$ENV{'form.abstract'};
      $metadatafields{'mime'}=$ENV{'form.mime'};       $metadatafields{'mime'}=$ENV{'form.mime'};
Line 431  sub phasetwo { Line 448  sub phasetwo {
      $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};       $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};
      $metadatafields{'owner'}=$ENV{'form.owner'};       $metadatafields{'owner'}=$ENV{'form.owner'};
      $metadatafields{'copyright'}=$ENV{'form.copyright'};       $metadatafields{'copyright'}=$ENV{'form.copyright'};
        
        my $allkeywords=$ENV{'form.addkey'};
      map {       map {
          print $logfile "\n".$_.': '.$metadatafields{$_}.           if ($_=~/^form\.key\.(\w+)/) {
            "\n".$_.'.keys: '.$metadatakeys{$_};       $allkeywords.=','.$1;
      } sort keys %metadatafields;           }
        } 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;
   
           {
       my $org=Apache::File->new($target);
               my $cop;
               unless ($cop=Apache::File->new('>'.$copyfile)) {
                   print $logfile "Unable to open for write ".$copyfile."\n";
                   return "<font color=red>Failed to open '.$copyfile.
                          ', FAIL</font>";
               }
               while (my $line=<$org>) { print $cop $line; }
           }
           if (-e $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';
           {
       my $org=Apache::File->new($target.'.meta');
               my $cop=Apache::File->new('>'.$copyfile);
               while (my $line=<$org>) { print $cop $line; }
           }
           if (-e $copyfile) {
       print $logfile "Copied old target  metadata to ".$copyfile."\n";
               $scrout.='<p>Copied old metadata';
           } else {
       print $logfile "Unable to write metadata ".$copyfile."\n";
               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);
                  }
              }
   
           {
       my $org=Apache::File->new($source);
               my $cop;
               unless ($cop=Apache::File->new('>'.$copyfile)) {
                   print $logfile "Unable to open for write ".$copyfile."\n";
                   return "<font color=red>Failed to open '.$copyfile.
                          ', FAIL</font>";
               }
               while (my $line=<$org>) { print $cop $line; }
           }
           if (-e $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
   
    my $copyfile=$target.'.meta';
           {
       my $org=Apache::File->new($source.'.meta');
               my $cop=Apache::File->new('>'.$copyfile);
               while (my $line=<$org>) { print $cop $line; }
           }
           if (-e $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 472  sub handler { Line 669  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'}.
Removed from v.1.11  
changed lines
  Added in v.1.12

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