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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.94 and 1.97

version 1.94, 2002/09/10 14:52:35 version 1.97, 2002/09/18 15:43:06
Line 805  I<Additional documentation needed.> Line 805  I<Additional documentation needed.>
 #########################################  #########################################
 sub publish {  sub publish {
   
     my ($source,$target,$style)=@_;      my ($source,$target,$style,$batch)=@_;
     my $logfile;      my $logfile;
     my $scrout='';      my $scrout='';
     my $allmeta='';      my $allmeta='';
Line 896  sub publish { Line 896  sub publish {
             
      my %oldparmstores=();       my %oldparmstores=();
             
            unless ($batch) {
      $scrout.='<h3>Metadata Information ' .       $scrout.='<h3>Metadata Information ' .
        Apache::loncommon::help_open_topic("Metadata_Description")         Apache::loncommon::help_open_topic("Metadata_Description")
        . '</h3>';         . '</h3>';
       }
   
 # ------------------------------------------------ First, check out environment  # ------------------------------------------------ First, check out environment
      unless (-e $source.'.meta') {       unless (-e $source.'.meta') {
Line 993  sub publish { Line 994  sub publish {
   
 # ------------------------------------------------------- Now have all metadata  # ------------------------------------------------------- Now have all metadata
   
           my %keywords=();
           
    if (length($content)<500000) {
       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;
   
               foreach ($textonly=~m/(\w+)/g) {
    unless ($nokey{$_}) {
                      $keywords{$_}=1;
                   } 
               }
           }
   
               
               foreach (split(/\W+/,$metadatafields{'keywords'})) {
    $keywords{$_}=1;
               }
   # --------------------------------------------------- Now we also have keywords
   # =============================================================================
   # INTERACTIVE MODE
   #
      unless ($batch) {
         $scrout.=          $scrout.=
      '<form name="pubform" action="/adm/publish" method="post">'.       '<form name="pubform" action="/adm/publish" method="post">'.
        '<p><input type="submit" value="Finalize Publication" /></p>'.         '<p><input type="submit" value="Finalize Publication" /></p>'.
Line 1028  function uncheckAll(field) Line 1056  function uncheckAll(field)
 END  END
         $keywordout.='<table border=2><tr>';          $keywordout.='<table border=2><tr>';
         my $colcount=0;          my $colcount=0;
         my %keywords=();  
           
  if (length($content)<500000) {  
     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;  
   
             foreach ($textonly=~m/(\w+)/g) {  
  unless ($nokey{$_}) {  
                    $keywords{$_}=1;  
                 }   
             }  
         }  
   
               
             foreach (split(/\W+/,$metadatafields{'keywords'})) {  
  $keywords{$_}=1;  
             }  
   
             foreach (sort keys %keywords) {              foreach (sort keys %keywords) {
                 $keywordout.='<td><input type=checkbox name="keywords" value="'.$_.'"';                  $keywordout.='<td><input type=checkbox name="keywords" value="'.$_.'"';
Line 1123  END Line 1129  END
     $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;      $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;
     return $scrout.      return $scrout.
         '<p><input type="submit" value="Finalize Publication" /></p></form>';          '<p><input type="submit" value="Finalize Publication" /></p></form>';
   # =============================================================================
   # BATCH MODE
   #
     } else {
   # Transfer metadata directly to environment for stage 2
       foreach (keys %metadatafields) {
    $ENV{'form.'.$_}=$metadatafields{$_};
       }
       $ENV{'form.addkey'}='';
       $ENV{'form.keywords'}='';
       foreach (keys %keywords) {
           if ($metadatafields{'keywords'}) {
              if ($metadatafields{'keywords'}=~/$_/) { 
                 $ENV{'form.keywords'}.=$_.','; 
              }
    } elsif (&Apache::loncommon::keyword($_)) {
       $ENV{'form.keywords'}.=$_.',';
           } 
       }
       $ENV{'form.keywords'}=~s/\,$//;
       unless ($ENV{'form.creationdate'}) { $ENV{'form.creationdate'}=time; }
       $ENV{'form.lastrevisiondate'}=time;
       if ((($style eq 'rat') && ($ENV{'form.copyright'} eq 'public')) ||
           (!$ENV{'form.copyright'})) { 
    $ENV{'form.copyright'}='default';
       } 
       $ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta);
       return $scrout;
     }
 }  }
   
 #########################################  #########################################
Line 1164  the server's attempts at publication. Line 1199  the server's attempts at publication.
 #########################################  #########################################
 sub phasetwo {  sub phasetwo {
   
     my ($source,$target,$style,$distarget)=@_;      my ($source,$target,$style,$distarget,$batch)=@_;
     my $logfile;      my $logfile;
     my $scrout='';      my $scrout='';
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
Line 1324  if (-e $target) { Line 1359  if (-e $target) {
            }             }
   
         if (copy($source,$copyfile)) {          if (copy($source,$copyfile)) {
     print $logfile "Copied original source to ".$copyfile."\n";      print $logfile "\nCopied original source to ".$copyfile."\n";
             $scrout.='<p>Copied source file';              $scrout.='<p>Copied source file';
         } else {          } else {
     print $logfile "Unable to write ".$copyfile.':'.$!."\n";      print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
             return "<font color=red>Failed to copy source, $!, FAIL</font>";              return "<font color=red>Failed to copy source, $!, FAIL</font>";
         }          }
   
Line 1336  if (-e $target) { Line 1371  if (-e $target) {
         $copyfile=$copyfile.'.meta';          $copyfile=$copyfile.'.meta';
   
         if (copy($source.'.meta',$copyfile)) {          if (copy($source.'.meta',$copyfile)) {
     print $logfile "Copied original metadata to ".$copyfile."\n";      print $logfile "\nCopied original metadata to ".$copyfile."\n";
             $scrout.='<p>Copied metadata';              $scrout.='<p>Copied metadata';
         } else {          } else {
     print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";      print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
             return               return 
           "<font color=red>Failed to write metadata copy, $!, FAIL</font>";            "<font color=red>Failed to write metadata copy, $!, FAIL</font>";
         }          }
Line 1368  if (-e $target) { Line 1403  if (-e $target) {
     }      }
   
 # ------------------------------------------------ Provide link to new resource  # ------------------------------------------------ Provide link to new resource
     unless ($batch) {
     my $thisdistarget=$target;      my $thisdistarget=$target;
     $thisdistarget=~s/^$docroot//;      $thisdistarget=~s/^$docroot//;
   
Line 1385  if (-e $target) { Line 1420  if (-e $target) {
       '<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'.        '<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'.
       '<p><a href="'.$thissrcdir.        '<p><a href="'.$thissrcdir.
       '"><font size="+2">Back to Source Directory</font></a>';        '"><font size="+2">Back to Source Directory</font></a>';
     } else {
       return $warning.$scrout;
     }
 }  }
   
   #########################################
   
   sub batchpublish {
       my ($r,$srcfile,$targetfile)=@_;
       my $thisdisfn=$srcfile;
       $thisdisfn=~s/\/home\/korte\/public_html\///;
       $srcfile=~s/\/+/\//g;
   
       my $docroot=$r->dir_config('lonDocRoot');
       my $thisdistarget=$targetfile;
       $thisdistarget=~s/^$docroot//;
   
   
       undef %metadatafields;
       undef %metadatakeys;
        %metadatafields=();
        %metadatakeys=();
         $srcfile=~/\.(\w+)$/;
         my $thistype=$1;
   
   
         my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
        
       $r->print('<h2>Publishing <tt>'.$thisdisfn.'</tt></h2>');
   
   # phase one takes
   #  my ($source,$target,$style,$batch)=@_;
       $r->print('<p>'.&publish($srcfile,$targetfile,$thisembstyle,1).'</p>');
   # phase two takes
   # my ($source,$target,$style,$distarget,batch)=@_;
   # $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},...
       $r->print(
   '<p>'.&phasetwo($srcfile,$targetfile,$thisembstyle,$thisdistarget,1).'</p>');
       return '';
   }
   
 #########################################  #########################################
   
   sub publishdirectory {
       my ($r,$fn,$thisdisfn)=@_;
       my $resdir=
       $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.
         $thisdisfn;
         $r->print('<h1>Directory <tt>'.$thisdisfn.'/</tt></h1>'.
                   'Target: <tt>'.$resdir.'</tt><br />');
   
         my $dirptr=16384; # Mask indicating a directory in stat.cmode.
   
         opendir(DIR,$fn);
         my @files=sort(readdir(DIR));
         foreach my $filename (@files) {
            my ($cdev,$cino,$cmode,$cnlink,
               $cuid,$cgid,$crdev,$csize,
               $catime,$cmtime,$cctime,
               $cblksize,$cblocks)=stat($fn.'/'.$filename);
   
            my $extension='';
            if ($filename=~/\.(\w+)$/) { $extension=$1; }
            if ($cmode&$dirptr) {
      if (($filename!~/^\./) && ($ENV{'form.pubrec'})) {
         &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);
      }
            } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
                     ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
   # find out publication status and/or exiting metadata
        my $publishthis=0;
                if (-e $resdir.'/'.$filename) {
           my ($rdev,$rino,$rmode,$rnlink,
           $ruid,$rgid,$rrdev,$rsize,
           $ratime,$rmtime,$rctime,
           $rblksize,$rblocks)=stat($resdir.'/'.$filename);
           if ($rmtime<$cmtime) {
   # previously published, modified now
       $publishthis=1;
                   }
        } else {
   # never published
    $publishthis=1;
        }
                if ($publishthis) {
                   &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);
        } else {
                    $r->print('<br />Skipping '.$filename.'<br />');
                }
                $r->rflush();
            }
         }
         closedir(DIR);
   }
 #########################################  #########################################
   
 =pod  =pod
Line 1531  unless ($ENV{'form.phase'} eq 'two') { Line 1655  unless ($ENV{'form.phase'} eq 'two') {
   $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(    $r->print(&Apache::loncommon::bodytag('Resource Publication'));
     '<body bgcolor="#FFFFFF"><img align="right" '.  
     'src="/adm/lonIcons/lonlogos.gif" />');  
   my $thisfn=$fn;    my $thisfn=$fn;
      
 # ---------------------- Evaluate individual file, and then output information.  
   {  
       $thisfn=~/\.(\w+)$/;  
       my $thistype=$1;  
       my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);  
   
       my $thistarget=$thisfn;    my $thistarget=$thisfn;
               
       $thistarget=~s/^\/home/$targetdir/;    $thistarget=~s/^\/home/$targetdir/;
       $thistarget=~s/\/public\_html//;    $thistarget=~s/\/public\_html//;
   
     my $thisdistarget=$thistarget;
     $thisdistarget=~s/^$docroot//;
   
     my $thisdisfn=$thisfn;
     $thisdisfn=~s/^\/home\/$cuname\/public_html\///;
   
       my $thisdistarget=$thistarget;    if ($fn=~/\/$/) {
       $thisdistarget=~s/^$docroot//;  # -------------------------------------------------------- This is a directory
         &publishdirectory($r,$fn,$thisdisfn);
   
       my $thisdisfn=$thisfn;    } else {
       $thisdisfn=~s/^\/home\/$cuname\/public_html\///;  # ---------------------- Evaluate individual file, and then output information.
         $thisfn=~/\.(\w+)$/;
         my $thistype=$1;
         my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
   
       $r->print('<h2>Publishing '.        $r->print('<h2>Publishing '.
         &Apache::loncommon::filedescription($thistype).' <tt>'.          &Apache::loncommon::filedescription($thistype).' <tt>'.
         $thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');          '<a href="/~'.$cuname.'/'.$thisdisfn.'" target="cat">'.$thisdisfn.
           '</a></tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');
         
       if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) {        if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) {
           $r->print('<h3><font color="red">Co-Author: '.$cuname.' at '.$cudom.            $r->print('<h3><font color="red">Co-Author: '.$cuname.' at '.$cudom.
Removed from v.1.94  
changed lines
  Added in v.1.97

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