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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.93 and 1.100

version 1.93, 2002/08/12 14:48:32 version 1.100, 2002/10/07 21:07:08
Line 67 Line 67
   
 =pod   =pod 
   
 =head1 Name  =head1 NAME
   
 lonpublisher - LON-CAPA publishing handler  lonpublisher - LON-CAPA publishing handler
   
 =head1 Synopsis  =head1 SYNOPSIS
   
 lonpublisher takes the proper steps to add resources to the LON-CAPA  B<lonpublisher> is used by B<mod_perl> inside B<Apache>.  This is the
   invocation by F<loncapa_apache.conf>:
   
     <Location /adm/publish>
     PerlAccessHandler       Apache::lonacc
     SetHandler perl-script
     PerlHandler Apache::lonpublisher
     ErrorDocument     403 /adm/login
     ErrorDocument     404 /adm/notfound.html
     ErrorDocument     406 /adm/unauthorized.html
     ErrorDocument     500 /adm/errorhandler
     </Location>
   
   =head1 DESCRIPTION
   
   B<lonpublisher> takes the proper steps to add resources to the LON-CAPA
 digital library.  This includes updating the metadata table in the  digital library.  This includes updating the metadata table in the
 LON-CAPA database.  LON-CAPA database.
   
 =head1 Description  B<lonpublisher> is many things to many people.  
   
 lonpublisher is many things to many people.    
 To all people it is woefully documented.    
 This documentation conforms to this standard.  
   
 This module publishes a file.  This involves gathering metadata,  This module publishes a file.  This involves gathering metadata,
 versioning the file, copying file from construction space to  versioning the file, copying file from construction space to
 publication space, and copying metadata from construction space  publication space, and copying metadata from construction space
 to publication space.  to publication space.
   
 =head2 Internal Functions  =head2 SUBROUTINES
   
   Many of the undocumented subroutines implement various magical
   parsing shortcuts.
   
 =over 4  =over 4
   
Line 130  my $cudom; Line 144  my $cudom;
   
 =pod  =pod
   
 =item metaeval  =item B<metaeval>
   
   Evaluates a string that contains metadata.  This subroutine
   stores values inside I<%metadatafields> and I<%metadatakeys>.
   The hash key is a I<$unikey> corresponding to a unique id
   that is descriptive of the parser location inside the XML tree.
   
 Evaluate string with metadata  Parameters:
   
   =over 4
   
   =item I<$metastring>
   
   A string that contains metadata.
   
   =back
   
   Returns:
   
   nothing
   
 =cut  =cut
   
Line 185  sub metaeval { Line 216  sub metaeval {
   
 =pod  =pod
   
 =item metaread  =item B<metaread>
   
 Read a metadata file  Read a metadata file
   
   Parameters:
   
   =over
   
   =item I<$logfile>
   
   File output stream to output errors and warnings to.
   
   =item I<$fn>
   
   File name (including path).
   
   =back
   
   Returns:
   
   =over 4
   
   =item Scalar string (if successful)
   
   XHTML text that indicates successful reading of the metadata.
   
   =back
   
 =cut  =cut
   
 #########################################  #########################################
Line 196  Read a metadata file Line 251  Read a metadata file
 sub metaread {  sub metaread {
     my ($logfile,$fn)=@_;      my ($logfile,$fn)=@_;
     unless (-e $fn) {      unless (-e $fn) {
  print $logfile 'No file '.$fn."\n";   print($logfile 'No file '.$fn."\n");
         return '<br><b>No file:</b> <tt>'.$fn.'</tt>';          return '<br><b>No file:</b> <tt>'.$fn.'</tt>';
     }      }
     print $logfile 'Processing '.$fn."\n";      print($logfile 'Processing '.$fn."\n");
     my $metastring;      my $metastring;
     {      {
      my $metafh=Apache::File->new($fn);       my $metafh=Apache::File->new($fn);
Line 214  sub metaread { Line 269  sub metaread {
   
 =pod  =pod
   
 =item sqltime  =item B<sqltime>
   
 Convert 'time' format into a datetime sql format  Convert 'time' format into a datetime sql format
   
   Parameters:
   
   =over 4
   
   =item I<$timef>
   
   Seconds since 00:00:00 UTC, January 1, 1970.
   
   =back
   
   Returns:
   
   =over 4
   
   =item Scalar string
   
   MySQL-compatible datetime string.
   
   =back
   
 =cut  =cut
   
 #########################################  #########################################
Line 236  sub sqltime { Line 311  sub sqltime {
   
 =pod  =pod
   
 =item Form field generating functions  =item Form-field-generating subroutines.
   
   For input parameters, these subroutines take in values
   such as I<$name>, I<$value> and other form field metadata.
   The output (scalar string that is returned) is an XHTML
   string which presents the form field (foreseeably inside
   <form></form> tags).
   
 =over 4  =over 4
   
 =item textfield  =item B<textfield>
   
 =item hiddenfield  =item B<hiddenfield>
   
 =item selectbox  =item B<selectbox>
   
 =back  =back
   
Line 255  sub sqltime { Line 336  sub sqltime {
 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>".
            '<input type=text name="'.$name.'" size=80 value="'.$value.'">';             '<input type="text" name="'.$name.'" size=80 value="'.$value.'" />';
 }  }
   
 sub hiddenfield {  sub hiddenfield {
     my ($name,$value)=@_;      my ($name,$value)=@_;
     return "\n".'<input type=hidden name="'.$name.'" value="'.$value.'">';      return "\n".'<input type="hidden" name="'.$name.'" value="'.$value.'" />';
 }  }
   
 sub selectbox {  sub selectbox {
Line 283  sub selectbox { Line 364  sub selectbox {
   
 =pod  =pod
   
 =item urlfixup  =item B<urlfixup>
   
 Fix up a url?  First step of publication  Fix up a url?  First step of publication
   
Line 316  sub urlfixup { Line 397  sub urlfixup {
   
 =pod  =pod
   
 =item absoluteurl  =item B<absoluteurl>
   
 Currently undocumented      Currently undocumented.
   
 =cut  =cut
   
Line 339  sub absoluteurl { Line 420  sub absoluteurl {
   
 =pod  =pod
   
 =item set_allow  =item B<set_allow>
   
 Currently undocumented      Currently undocumented    
   
Line 370  sub set_allow { Line 451  sub set_allow {
   
 =pod  =pod
   
 =item get_subscribed_hosts  =item B<get_subscribed_hosts>
   
 Currently undocumented      Currently undocumented    
   
Line 388  sub get_subscribed_hosts { Line 469  sub get_subscribed_hosts {
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
  if ($filename=~/$srcf\.(\w+)$/) {   if ($filename=~/$srcf\.(\w+)$/) {
     my $subhost=$1;      my $subhost=$1;
     if ($subhost ne 'meta' && $subhost ne 'subscription') {      if (($subhost ne 'meta' && $subhost ne 'subscription') &&
                   ($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) {
  push(@subscribed,$subhost);   push(@subscribed,$subhost);
     }      }
  }   }
Line 399  sub get_subscribed_hosts { Line 481  sub get_subscribed_hosts {
  &Apache::lonnet::logthis("opened $target.subscription");   &Apache::lonnet::logthis("opened $target.subscription");
  while (my $subline=<$sh>) {   while (my $subline=<$sh>) {
     &Apache::lonnet::logthis("Trying $subline");      &Apache::lonnet::logthis("Trying $subline");
     if ($subline =~ /(^\w+):/) { push(@subscribed,$1); } else {      if ($subline =~ /(^\w+):/) { 
                   if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) { 
                      push(@subscribed,$1);
           }
               } else {
  &Apache::lonnet::logthis("No Match for $subline");   &Apache::lonnet::logthis("No Match for $subline");
     }      }
  }   }
     } else {      } else {
  &Apache::lonnet::logthis("Un able to open $target.subscription");   &Apache::lonnet::logthis("Unable to open $target.subscription");
     }      }
     &Apache::lonnet::logthis("Got list of ".join(':',@subscribed));      &Apache::lonnet::logthis("Got list of ".join(':',@subscribed));
     return @subscribed;      return @subscribed;
Line 416  sub get_subscribed_hosts { Line 502  sub get_subscribed_hosts {
   
 =pod  =pod
   
 =item get_max_ids_indices  =item B<get_max_ids_indices>
   
 Currently undocumented      Currently undocumented    
   
Line 460  sub get_max_ids_indices { Line 546  sub get_max_ids_indices {
   
 =pod  =pod
   
 =item get_all_text_unbalanced  =item B<get_all_text_unbalanced>
   
 Currently undocumented      Currently undocumented    
   
Line 502  sub get_all_text_unbalanced { Line 588  sub get_all_text_unbalanced {
   
 =pod  =pod
   
 =item fix_ids_and_indices  =item B<fix_ids_and_indices>
   
 Currently undocumented      Currently undocumented    
   
Line 654  sub fix_ids_and_indices { Line 740  sub fix_ids_and_indices {
   
 =pod  =pod
   
 =item store_metadata  =item B<store_metadata>
   
 Store the metadata in the metadata table in the loncapa database.  Store the metadata in the metadata table in the loncapa database.
 Uses lonmysql to access the database.  Uses lonmysql to access the database.
Line 710  sub store_metadata { Line 796  sub store_metadata {
   
 =pod  =pod
   
 =item publish  =item B<publish>
   
   This is the workhorse function of this module.  This subroutine generates
   backup copies, performs any automatic processing (prior to publication,
   especially for rat and ssi files),
   
 Currently undocumented.  This is the workhorse function of this module.  I<Additional documentation needed.>
   
 =cut  =cut
   
Line 720  Currently undocumented.  This is the wor Line 810  Currently undocumented.  This is the wor
 #########################################  #########################################
 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 769  sub publish { Line 859  sub publish {
                if (                 if (
        &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.         &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                                             $thisdep.'.meta') eq '-1') {                                              $thisdep.'.meta') eq '-1') {
    $scrout.=     $scrout.= ' - <font color="red">Currently not available'.
                            ' - <font color=red>Currently not available</font>';         '</font>';
                } else {                 } else {
                    my %temphash=(&Apache::lonnet::declutter($target).'___'.                     my %temphash=(&Apache::lonnet::declutter($target).'___'.
                              &Apache::lonnet::declutter($thisdep).'___usage'                               &Apache::lonnet::declutter($thisdep).'___usage'
Line 787  sub publish { Line 877  sub publish {
   
  #Encode any High ASCII characters   #Encode any High ASCII characters
  $outstring=&HTML::Entities::encode($outstring,"\200-\377");   $outstring=&HTML::Entities::encode($outstring,"\200-\377");
 # ------------------------------------------------------------- Write modified  # ------------------------------------------------------------- Write modified.
   
         {          {
           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                return 
               "<font color=red>No write permission to $source, FAIL</font>";   '<font color="red">No write permission to '.$source.
    ', FAIL</font>';
   }    }
           print $org $outstring;            print($org $outstring);
         }          }
   $content=$outstring;    $content=$outstring;
   
     }      }
 # --------------------------------------------- Initial step done, now metadata  # -------------------------------------------- Initial step done, now metadata.
   
 # ---------------------------------------- Storage for metadata keys and fields  # --------------------------------------- Storage for metadata keys and fields.
   
      %metadatafields=();       %metadatafields=();
      %metadatakeys=();       %metadatakeys=();
             
      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 907  sub publish { Line 999  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 942  function uncheckAll(field) Line 1061  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 1014  END Line 1111  END
         
  $scrout.=&textfield('Publisher/Owner','owner',   $scrout.=&textfield('Publisher/Owner','owner',
                             $metadatafields{'owner'});                              $metadatafields{'owner'});
 # --------------------------------------------------- Correct copyright for rat          
   
   # -------------------------------------------------- Correct copyright for rat.
     if ($style eq 'rat') {      if ($style eq 'rat') {
  if ($metadatafields{'copyright'} eq 'public') {    if ($metadatafields{'copyright'} eq 'public') { 
     delete $metadatafields{'copyright'};      delete $metadatafields{'copyright'};
Line 1032  END Line 1129  END
      (&Apache::loncommon::copyrightids));       (&Apache::loncommon::copyrightids));
     }      }
   
     my $copyright_help = Apache::loncommon::help_open_topic("Publishing_Copyright");      my $copyright_help =
           Apache::loncommon::help_open_topic('Publishing_Copyright');
     $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 1043  END Line 1170  END
   
 =pod   =pod 
   
 =item phasetwo  =item B<phasetwo>
   
 Render second interface showing status of publication steps.  Render second interface showing status of publication steps.
 This is publication step two.  This is publication step two.
   
   Parameters:
   
   =over 4
   
   =item I<$source>
   
   =item I<$target>
   
   =item I<$style>
   
   =item I<$distarget>
   
   =back
   
   Returns:
   
   =over 4
   
   =item Scalar string
   
   String contains status (errors and warnings) and information associated with
   the server's attempts at publication.     
   
 =cut  =cut
   
   #'stupid emacs
 #########################################  #########################################
 #########################################  #########################################
 sub phasetwo {  sub phasetwo {
   
     my ($source,$target,$style,$distarget)=@_;      my ($r,$source,$target,$style,$distarget,$batch)=@_;
     my $logfile;      my $logfile;
     my $scrout='';  
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
  return    return 
          '<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================= Publish ".localtime()." Phase Two  ================\n";          "\n================= Publish ".localtime()." Phase Two  ================\n";
       
      %metadatafields=();      %metadatafields=();
      %metadatakeys=();      %metadatakeys=();
       
      &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));      &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));
       
      $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{'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'};
      $metadatafields{'language'}=$ENV{'form.language'};      $metadatafields{'language'}=$ENV{'form.language'};
      $metadatafields{'creationdate'}=      $metadatafields{'creationdate'}=
          &sqltime($ENV{'form.creationdate'});          &sqltime($ENV{'form.creationdate'});
      $metadatafields{'lastrevisiondate'}=      $metadatafields{'lastrevisiondate'}=
          &sqltime($ENV{'form.lastrevisiondate'});          &sqltime($ENV{'form.lastrevisiondate'});
      $metadatafields{'owner'}=$ENV{'form.owner'};      $metadatafields{'owner'}=$ENV{'form.owner'};
      $metadatafields{'copyright'}=$ENV{'form.copyright'};      $metadatafields{'copyright'}=$ENV{'form.copyright'};
      $metadatafields{'dependencies'}=$ENV{'form.dependencies'};      $metadatafields{'dependencies'}=$ENV{'form.dependencies'};
       
      my $allkeywords=$ENV{'form.addkey'};      my $allkeywords=$ENV{'form.addkey'};
      if (exists($ENV{'form.keywords'})) {      if (exists($ENV{'form.keywords'})) {
          if (ref($ENV{'form.keywords'})) {          if (ref($ENV{'form.keywords'})) {
              $allkeywords .= ','.join(',',@{$ENV{'form.keywords'}});              $allkeywords .= ','.join(',',@{$ENV{'form.keywords'}});
          } else {          } else {
              $allkeywords .= ','.$ENV{'form.keywords'};              $allkeywords .= ','.$ENV{'form.keywords'};
          }          }
      }      }
      $allkeywords=~s/\W+/\,/;      $allkeywords=~s/\W+/\,/;
      $allkeywords=~s/^\,//;      $allkeywords=~s/^\,//;
      $metadatafields{'keywords'}=$allkeywords;      $metadatafields{'keywords'}=$allkeywords;
        
      {      {
        print $logfile "\nWrite metadata file for ".$source;          print $logfile "\nWrite metadata file for ".$source;
        my $mfh;          my $mfh;
        unless ($mfh=Apache::File->new('>'.$source.'.meta')) {          unless ($mfh=Apache::File->new('>'.$source.'.meta')) {
  return               return 
          '<font color=red>Could not write metadata, FAIL</font>';                  '<font color=red>Could not write metadata, FAIL</font>';
        }          }
        foreach (sort keys %metadatafields) {          foreach (sort keys %metadatafields) {
  unless ($_=~/\./) {              unless ($_=~/\./) {
            my $unikey=$_;                  my $unikey=$_;
            $unikey=~/^([A-Za-z]+)/;                  $unikey=~/^([A-Za-z]+)/;
            my $tag=$1;                  my $tag=$1;
            $tag=~tr/A-Z/a-z/;                  $tag=~tr/A-Z/a-z/;
            print $mfh "\n\<$tag";                  print $mfh "\n\<$tag";
            foreach (split(/\,/,$metadatakeys{$unikey})) {                  foreach (split(/\,/,$metadatakeys{$unikey})) {
                my $value=$metadatafields{$unikey.'.'.$_};                      my $value=$metadatafields{$unikey.'.'.$_};
                $value=~s/\"/\'\'/g;                      $value=~s/\"/\'\'/g;
                print $mfh ' '.$_.'="'.$value.'"';                      print $mfh ' '.$_.'="'.$value.'"';
            }                  }
    print $mfh '>'.                  print $mfh '>'.
      &HTML::Entities::encode($metadatafields{$unikey})                      &HTML::Entities::encode($metadatafields{$unikey})
        .'</'.$tag.'>';                          .'</'.$tag.'>';
          }              }
        }          }
        $scrout.='<p>Wrote Metadata';          $r->print('<p>Wrote Metadata');
        print $logfile "\nWrote metadata";          print $logfile "\nWrote metadata";
      }      }
       
 # -------------------------------- Synchronize entry with SQL metadata database  # -------------------------------- Synchronize entry with SQL metadata database
     my $warning;  
     $metadatafields{'url'} = $distarget;      $metadatafields{'url'} = $distarget;
     $metadatafields{'version'} = 'current';      $metadatafields{'version'} = 'current';
     unless ($metadatafields{'copyright'} eq 'priv') {      unless ($metadatafields{'copyright'} eq 'priv') {
         my ($error,$success) = &store_metadata(\%metadatafields);          my ($error,$success) = &store_metadata(\%metadatafields);
         if ($success) {          if ($success) {
             $scrout.='<p>Synchronized SQL metadata database';              $r->print('<p>Synchronized SQL metadata database');
             print $logfile "\nSynchronized SQL metadata database";              print $logfile "\nSynchronized SQL metadata database";
         } else {          } else {
             $warning.=$error;              $r->print($error);
             print $logfile "\n".$error;              print $logfile "\n".$error;
         }          }
     } else {      } else {
         $scrout.='<p>Private Publication - did not synchronize database';          $r->print('<p>Private Publication - did not synchronize database');
         print $logfile "\nPrivate: Did not synchronize data into ".          print $logfile "\nPrivate: Did not synchronize data into ".
             "SQL metadata database";              "SQL metadata database";
     }      }
 # ----------------------------------------------------------- Copy old versions  # ----------------------------------------------------------- Copy old versions
         
 if (-e $target) {      if (-e $target) {
     my $filename;          my $filename;
     my $maxversion=0;          my $maxversion=0;
     $target=~/(.*)\/([^\/]+)\.(\w+)$/;          $target=~/(.*)\/([^\/]+)\.(\w+)$/;
     my $srcf=$2;          my $srcf=$2;
     my $srct=$3;          my $srct=$3;
     my $srcd=$1;          my $srcd=$1;
     unless ($srcd=~/^\/home\/httpd\/html\/res/) {          unless ($srcd=~/^\/home\/httpd\/html\/res/) {
  print $logfile "\nPANIC: Target dir is ".$srcd;              print $logfile "\nPANIC: Target dir is ".$srcd;
         return "<font color=red>Invalid target directory, FAIL</font>";              return "<font color=red>Invalid target directory, FAIL</font>";
     }          }
     opendir(DIR,$srcd);          opendir(DIR,$srcd);
     while ($filename=readdir(DIR)) {          while ($filename=readdir(DIR)) {
        if ($filename=~/$srcf\.(\d+)\.$srct$/) {              if (-l $srcd.'/'.$filename) {
    $maxversion=($1>$maxversion)?$1:$maxversion;                  unlink($srcd.'/'.$filename);
        }                  unlink($srcd.'/'.$filename.'.meta');
     }              } else {
     closedir(DIR);                  if ($filename=~/$srcf\.(\d+)\.$srct$/) {
     $maxversion++;                      $maxversion=($1>$maxversion)?$1:$maxversion;
     $scrout.='<p>Creating old version '.$maxversion;                  }
     print $logfile "\nCreating old version ".$maxversion;              }
           }
     my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;          closedir(DIR);
           $maxversion++;
           $r->print('<p>Creating old version '.$maxversion);
           print $logfile "\nCreating old version ".$maxversion;
           
           my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;
           
         if (copy($target,$copyfile)) {          if (copy($target,$copyfile)) {
     print $logfile "Copied old target to ".$copyfile."\n";      print $logfile "Copied old target to ".$copyfile."\n";
             $scrout.='<p>Copied old target file';              $r->print('<p>Copied old target file');
         } else {          } else {
     print $logfile "Unable to write ".$copyfile.':'.$!."\n";      print $logfile "Unable to write ".$copyfile.':'.$!."\n";
            return "<font color=red>Failed to copy old target, $!, FAIL</font>";              return "<font color=red>Failed to copy old target, $!, FAIL</font>";
         }          }
           
 # --------------------------------------------------------------- Copy Metadata  # --------------------------------------------------------------- Copy Metadata
   
  $copyfile=$copyfile.'.meta';   $copyfile=$copyfile.'.meta';
           
         if (copy($target.'.meta',$copyfile)) {          if (copy($target.'.meta',$copyfile)) {
     print $logfile "Copied old target metadata to ".$copyfile."\n";      print $logfile "Copied old target metadata to ".$copyfile."\n";
             $scrout.='<p>Copied old metadata';              $r->print('<p>Copied old metadata')
         } else {          } else {
     print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";      print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
             if (-e $target.'.meta') {              if (-e $target.'.meta') {
                return                   return 
        "<font color=red>Failed to write old metadata copy, $!, FAIL</font>";                      "<font color=red>Failed to write old metadata copy, $!, FAIL</font>";
     }      }
         }          }
           
           
 } else {      } else {
     $scrout.='<p>Initial version';          $r->print('<p>Initial version');
     print $logfile "\nInitial version";          print $logfile "\nInitial version";
 }      }
   
 # ---------------------------------------------------------------- Write Source  # ---------------------------------------------------------------- Write Source
  my $copyfile=$target;      my $copyfile=$target;
       
            my @parts=split(/\//,$copyfile);      my @parts=split(/\//,$copyfile);
            my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";      my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
       
            my $count;      my $count;
            for ($count=5;$count<$#parts;$count++) {      for ($count=5;$count<$#parts;$count++) {
                $path.="/$parts[$count]";          $path.="/$parts[$count]";
                if ((-e $path)!=1) {          if ((-e $path)!=1) {
                    print $logfile "\nCreating directory ".$path;              print $logfile "\nCreating directory ".$path;
                    $scrout.='<p>Created directory '.$parts[$count];              $r->print('<p>Created directory '.$parts[$count]);
    mkdir($path,0777);              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>";  
         }          }
       }
       
       if (copy($source,$copyfile)) {
           print $logfile "\nCopied original source to ".$copyfile."\n";
           $r->print('<p>Copied source file');
       } else {
           print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
           return "<font color=red>Failed to copy source, $!, FAIL</font>";
       }
       
 # --------------------------------------------------------------- Copy Metadata  # --------------------------------------------------------------- Copy Metadata
   
         $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';          $r->print('<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>";
         }      }
       $r->rflush;
 # --------------------------------------------------- Send update notifications  # --------------------------------------------------- Send update notifications
   
     my @subscribed=&get_subscribed_hosts($target);      my @subscribed=&get_subscribed_hosts($target);
     foreach my $subhost (@subscribed) {      foreach my $subhost (@subscribed) {
  $scrout.='<p>Notifying host '.$subhost.':';   $r->print('<p>Notifying host '.$subhost.':');$r->rflush;
  print $logfile "\nNotifying host ".$subhost.':';   print $logfile "\nNotifying host ".$subhost.':';
  my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);   my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
  $scrout.=$reply;   $r->print($reply);$r->rflush;
  print $logfile $reply;   print $logfile $reply;
     }      }
       
 # ---------------------------------------- Send update notifications, meta only  # ---------------------------------------- Send update notifications, meta only
   
     my @subscribedmeta=&get_subscribed_hosts("$target.meta");      my @subscribedmeta=&get_subscribed_hosts("$target.meta");
     foreach my $subhost (@subscribedmeta) {      foreach my $subhost (@subscribedmeta) {
  $scrout.='<p>Notifying host for metadata only '.$subhost.':';   $r->print('<p>Notifying host for metadata only '.$subhost.':');$r->rflush;
  print $logfile "\nNotifying host for metadata only ".$subhost.':';   print $logfile "\nNotifying host for metadata only ".$subhost.':';
  my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',   my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
     $subhost);      $subhost);
  $scrout.=$reply;   $r->print($reply);$r->rflush;
  print $logfile $reply;   print $logfile $reply;
     }      }
       
 # ------------------------------------------------ Provide link to new resource  # ------------------------------------------------ Provide link to new resource
       unless ($batch) {
           my $thisdistarget=$target;
           $thisdistarget=~s/^$docroot//;
           
           my $thissrc=$source;
           $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/;
           
           my $thissrcdir=$thissrc;
           $thissrcdir=~s/\/[^\/]+$/\//;
           
           
           $r->print(
              '<hr><a href="'.$thisdistarget.'"><font size="+2">'.
              'View Published Version</font></a>'.
              '<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'.
              '<p><a href="'.$thissrcdir.
                      '"><font size="+2">Back to Source Directory</font></a>');
       }
   }
   
     my $thisdistarget=$target;  #########################################
   
   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//;      $thisdistarget=~s/^$docroot//;
   
     my $thissrc=$source;  
     $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/;  
   
     my $thissrcdir=$thissrc;      undef %metadatafields;
     $thissrcdir=~s/\/[^\/]+$/\//;      undef %metadatakeys;
        %metadatafields=();
        %metadatakeys=();
         $srcfile=~/\.(\w+)$/;
         my $thistype=$1;
   
   
     return $warning.$scrout.        my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
       '<hr><a href="'.$thisdistarget.'"><font size=+2>View Published Version</font></a>'.       
       '<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'.      $r->print('<h2>Publishing <tt>'.$thisdisfn.'</tt></h2>');
       '<p><a href="'.$thissrcdir.  
       '"><font size=+2>Back to Source Directory</font></a>';  
   
   # 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($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
       $r->print('</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
   
 =item handler  =item B<handler>
   
 A basic outline of the handler subroutine follows.  A basic outline of the handler subroutine follows.
   
 =over 4  =over 4
   
 =item Get query string for limited number of parameters  =item *
   
   Get query string for limited number of parameters.
   
   =item *
   
   Check filename.
   
   =item *
   
 =item Check filename  File is there and owned, init lookup tables.
   
 =item File is there and owned, init lookup tables  =item *
   
 =item Start page output  Start page output.
   
 =item Individual file  =item *
   
 =item publish from $thisfn to $thistarget with $thisembstyle  Evaluate individual file, and then output information.
   
   =item *
   
   Publishing from $thisfn to $thistarget with $thisembstyle.
   
 =back  =back
   
Line 1378  sub handler { Line 1634  sub handler {
   
 unless ($ENV{'form.phase'} eq 'two') {  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 1402  unless ($ENV{'form.phase'} eq 'two') { Line 1658  unless ($ENV{'form.phase'} eq 'two') {
   
 }  }
   
 # ----------------------------------------------------------- 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(    $r->print(&Apache::loncommon::bodytag('Resource Publication'));
    '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');  
   my $thisfn=$fn;    my $thisfn=$fn;
      
 # ------------------------------------------------------------- Individual file  
   {  
       $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;    my $thisdistarget=$thistarget;
       $thisdistarget=~s/^$docroot//;    $thisdistarget=~s/^$docroot//;
   
       my $thisdisfn=$thisfn;    my $thisdisfn=$thisfn;
       $thisdisfn=~s/^\/home\/$cuname\/public_html\///;    $thisdisfn=~s/^\/home\/$cuname\/public_html\///;
   
     if ($fn=~/\/$/) {
   # -------------------------------------------------------- This is a directory
         &publishdirectory($r,$fn,$thisdisfn);
   
     } else {
   # ---------------------- 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.
                '</font></h3>');      '</font></h3>');
       }        }
   
       if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {        if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
           $r->print('<br><a href="/adm/diff?filename=/~'.$cuname.'/'.            $r->print('<br /><a href="/adm/diff?filename=/~'.$cuname.'/'.
                     $thisdisfn.                      $thisdisfn.
    '&versionone=priv" target=cat>Diffs with Current Version</a><p>');     '&versionone=priv" target="cat">Diffs with Current Version</a><p>');
       }        }
       
 # ------------ We are publishing from $thisfn to $thistarget with $thisembstyle  # ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.
   
        unless ($ENV{'form.phase'} eq 'two') {         unless ($ENV{'form.phase'} eq 'two') {
          $r->print(           $r->print(
           '<hr>'.&publish($thisfn,$thistarget,$thisembstyle));            '<hr />'.&publish($thisfn,$thistarget,$thisembstyle));
        } else {         } else {
          $r->print(             $r->print('<hr />');
           '<hr>'.&phasetwo($thisfn,$thistarget,$thisembstyle,$thisdistarget));              &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget); 
        }           }  
   
   }    }
Removed from v.1.93  
changed lines
  Added in v.1.100

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