Diff for /loncom/publisher/lonpublisher.pm between versions 1.295.2.1.2.1 and 1.303

version 1.295.2.1.2.1, 2023/01/23 02:24:50 version 1.303, 2023/07/14 22:19:22
Line 128  use Apache::lonlocal; Line 128  use Apache::lonlocal;
 use Apache::loncfile;  use Apache::loncfile;
 use LONCAPA::lonmetadata;  use LONCAPA::lonmetadata;
 use Apache::lonmsg;  use Apache::lonmsg;
 use vars qw(%metadatafields %metadatakeys);  use vars qw(%metadatafields %metadatakeys %addid $readit);
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
     
   
 my %addid;  
 my %nokey;  
   
 my $docroot;  my $docroot;
   
 my $cuname;  my $cuname;
Line 333  string which presents the form field (fo Line 329  string which presents the form field (fo
 #########################################  #########################################
 #########################################  #########################################
 sub textfield {  sub textfield {
     my ($title,$name,$value,$noline)=@_;      my ($title,$name,$value,$noline,$readonly)=@_;
     $value=~s/^\s+//gs;      $value=~s/^\s+//gs;
     $value=~s/\s+$//gs;      $value=~s/\s+$//gs;
     $value=~s/\s+/ /gs;      $value=~s/\s+/ /gs;
Line 345  sub textfield { Line 341  sub textfield {
 }  }
   
 sub text_with_browse_field {  sub text_with_browse_field {
     my ($title,$name,$value,$restriction,$noline)=@_;      my ($title,$name,$value,$restriction,$noline,$readonly)=@_;
     $value=~s/^\s+//gs;      $value=~s/^\s+//gs;
     $value=~s/\s+$//gs;      $value=~s/\s+$//gs;
     $value=~s/\s+/ /gs;      $value=~s/\s+/ /gs;
     $title=&mt($title);      $title=&mt($title);
     $env{'form.'.$name}=$value;      $env{'form.'.$name}=$value;
     return "\n".&Apache::lonhtmlcommon::row_title($title)      my $disabled;
           .'<input type="text" name="'.$name.'" size="80" value="'.$value.'" />'      if ($readonly) {
           .'<br />'          $disabled = ' disabled="disabled"';
       }
       my $output =
             "\n".&Apache::lonhtmlcommon::row_title($title)
             .'<input type="text" name="'.$name.'" size="80" value="'.$value.'"'.$disabled.' />';
       unless ($readonly) {
           $output .=
             '<br />'
   .'<a href="javascript:openbrowser(\'pubform\',\''.$name.'\',\''.$restriction.'\');">'    .'<a href="javascript:openbrowser(\'pubform\',\''.$name.'\',\''.$restriction.'\');">'
           .&mt('Select')            .&mt('Select')
           .'</a>&nbsp;'            .'</a>&nbsp;'
   .'<a href="javascript:opensearcher(\'pubform\',\''.$name.'\');">'    .'<a href="javascript:opensearcher(\'pubform\',\''.$name.'\');">'
           .&mt('Search')            .&mt('Search')
           .'</a>'            .'</a>';
           .&Apache::lonhtmlcommon::row_closure($noline);      }
       $output .= &Apache::lonhtmlcommon::row_closure($noline);
       return $output;
 }  }
   
 sub hiddenfield {  sub hiddenfield {
Line 376  sub checkbox { Line 381  sub checkbox {
 }  }
   
 sub selectbox {  sub selectbox {
     my ($title,$name,$value,$functionref,@idlist)=@_;      my ($title,$name,$value,$readonly,$functionref,@idlist)=@_;
     $title=&mt($title);      $title=&mt($title);
     $value=(split(/\s*,\s*/,$value))[-1];      $value=(split(/\s*,\s*/,$value))[-1];
     if (defined($value)) {      if (defined($value)) {
Line 391  sub selectbox { Line 396  sub selectbox {
         if ($id eq $value) {          if ($id eq $value) {
     $selout.=' selected="selected"';      $selout.=' selected="selected"';
         }          }
           if ($readonly) {
               $selout .= ' disabled="disabled"';
           }
         $selout.='>'.&{$functionref}($id).'</option>';          $selout.='>'.&{$functionref}($id).'</option>';
     }      }
     $selout.='</select>'.&Apache::lonhtmlcommon::row_closure();      $selout.='</select>'.&Apache::lonhtmlcommon::row_closure();
Line 1106  I<Additional documentation needed.> Line 1114  I<Additional documentation needed.>
 #########################################  #########################################
 sub publish {  sub publish {
   
     my ($source,$target,$style,$batch)=@_;      my ($source,$target,$style,$batch,$nokeyref)=@_;
     my $logfile;      my $logfile;
     my $scrout='';      my $scrout='';
     my $allmeta='';      my $allmeta='';
Line 1203  sub publish { Line 1211  sub publish {
   $content=$outstring;    $content=$outstring;
   
     }      }
   
   # ----------------------------------------------------- Course Authoring Space.
       my ($courseauthor,$crsaurights,$readonly);
       if ($env{'request.course.id'}) {
           my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
           my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
           my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'};
           if ($source =~ m{^\Q$docroot/priv/$cdom/$cnum/\E}) {
               $courseauthor = $cnum.':'.$cdom;
               $crsaurights = "/res/$cdom/$cnum/default.rights";
               $readonly = 1;
           }
       }
   
 # -------------------------------------------- Initial step done, now metadata.  # -------------------------------------------- Initial step done, now metadata.
   
 # --------------------------------------- Storage for metadata keys and fields.  # --------------------------------------- Storage for metadata keys and fields.
Line 1346  sub publish { Line 1368  sub publish {
         $textonly=~s/[^a-z^ü^ä^ö^ß\s]//g;  #dont delete german "Umlaute"          $textonly=~s/[^a-z^ü^ä^ö^ß\s]//g;  #dont delete german "Umlaute"
   
         foreach ($textonly=~m/[^\s]+/g) {  #match all but whitespaces          foreach ($textonly=~m/[^\s]+/g) {  #match all but whitespaces
             unless ($nokey{$_}) {              unless ($nokeyref->{$_}) {
                 $keywords{$_}=1;                  $keywords{$_}=1;
             }              }
         }          }
Line 1489  END Line 1511  END
     $defaultlanguage =~ s/,\s*$//g;      $defaultlanguage =~ s/,\s*$//g;
   
     $intr_scrout.=&selectbox('Language','language',      $intr_scrout.=&selectbox('Language','language',
      $defaultlanguage,       $defaultlanguage,'',
      \&Apache::loncommon::languagedescription,       \&Apache::loncommon::languagedescription,
      (&Apache::loncommon::languageids),       (&Apache::loncommon::languageids),
      );       );
Line 1506  END Line 1528  END
     if ($style eq 'prv') {      if ($style eq 'prv') {
         $pubowner_last = 1;          $pubowner_last = 1;
     }      }
       if ($courseauthor) {
           $metadatafields{'owner'} = $courseauthor;
       }
     $intr_scrout.=&textfield('Publisher/Owner','owner',      $intr_scrout.=&textfield('Publisher/Owner','owner',
      $metadatafields{'owner'},$pubowner_last);       $metadatafields{'owner'},$pubowner_last,$readonly);
   
 # ---------------------------------------------- Retrofix for unused copyright  # ---------------------------------------------- Retrofix for unused copyright
     if ($metadatafields{'copyright'} eq 'free') {      if ($metadatafields{'copyright'} eq 'free') {
Line 1520  END Line 1545  END
 # ------------------------------------------------ Dial in reasonable defaults  # ------------------------------------------------ Dial in reasonable defaults
     my $defaultoption=$metadatafields{'copyright'};      my $defaultoption=$metadatafields{'copyright'};
     unless ($defaultoption) { $defaultoption='default'; }      unless ($defaultoption) { $defaultoption='default'; }
       if ($courseauthor) {
           $defaultoption='custom';
           $metadatafields{'customdistributionfile'}=$crsaurights;
       }
     my $defaultsourceoption=$metadatafields{'sourceavail'};      my $defaultsourceoption=$metadatafields{'sourceavail'};
     unless ($defaultsourceoption) { $defaultsourceoption='closed'; }      unless ($defaultsourceoption) { $defaultsourceoption='closed'; }
     unless ($style eq 'prv') {      unless ($style eq 'prv') {
Line 1531  END Line 1560  END
  $defaultoption='default';   $defaultoption='default';
     }      }
     $intr_scrout.=&selectbox('Copyright/Distribution','copyright',      $intr_scrout.=&selectbox('Copyright/Distribution','copyright',
      $defaultoption,       $defaultoption,$readonly,
      \&Apache::loncommon::copyrightdescription,       \&Apache::loncommon::copyrightdescription,
     (grep !/^(public|priv)$/,(&Apache::loncommon::copyrightids)));      (grep !/^(public|priv)$/,(&Apache::loncommon::copyrightids)));
  } else {   } else {
     $intr_scrout.=&selectbox('Copyright/Distribution','copyright',      $intr_scrout.=&selectbox('Copyright/Distribution','copyright',
      $defaultoption,       $defaultoption,$readonly,
      \&Apache::loncommon::copyrightdescription,       \&Apache::loncommon::copyrightdescription,
      (grep !/^priv$/,(&Apache::loncommon::copyrightids)));       (grep !/^priv$/,(&Apache::loncommon::copyrightids)));
  }   }
Line 1545  END Line 1574  END
         my $replace=&mt('Copyright/Distribution:');          my $replace=&mt('Copyright/Distribution:');
  $intr_scrout =~ s/$replace/$replace.' '.$copyright_help/ge;   $intr_scrout =~ s/$replace/$replace.' '.$copyright_help/ge;
   
  $intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights');   $intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights','',$readonly);
  $intr_scrout.=&selectbox('Source Distribution','sourceavail',   $intr_scrout.=&selectbox('Source Distribution','sourceavail',
  $defaultsourceoption,   $defaultsourceoption,'',
  \&Apache::loncommon::source_copyrightdescription,   \&Apache::loncommon::source_copyrightdescription,
  (&Apache::loncommon::source_copyrightids));   (&Apache::loncommon::source_copyrightids));
 # $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights');  # $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights');
Line 1597  END Line 1626  END
     return($scrout,0);      return($scrout,0);
 }  }
   
   sub getnokey {
       my ($includedir) = @_;
       my $nokey={};
       my $fh=Apache::File->new($includedir.'/un_keyword.tab');
       while (<$fh>) {
           my $word=$_;
           chomp($word);
           $nokey->{$word}=1;
       }
       return $nokey;
   }
   
 #########################################  #########################################
 #########################################  #########################################
   
Line 1619  Parameters: Line 1660  Parameters:
   
 =item I<$distarget>  =item I<$distarget>
   
   =item I<$batch>
   
   =item I<$usebuffer>
   
 =back  =back
   
 Returns:  Returns:
   
 =over 4  =over 4
   
 =item integer  =item integer or array
   
   if $userbuffer arg is true, and if caller wants an array
   then the array ($output,$rtncode) will be returned, otherwise
   just the $rtncode will be returned.  $rtncode is an integer:
   
 0: fail  0: fail
 1: success  1: success
Line 1639  Returns: Line 1688  Returns:
 #########################################  #########################################
 sub phasetwo {  sub phasetwo {
   
     my ($r,$source,$target,$style,$distarget,$batch)=@_;      my ($r,$source,$target,$style,$distarget,$batch,$usebuffer)=@_;
     $source=~s/\/+/\//g;      $source=~s/\/+/\//g;
     $target=~s/\/+/\//g;      $target=~s/\/+/\//g;
 #  #
 # Unless trying to get rid of something, check name validity  # Unless trying to get rid of something, check name validity
 #  #
       my $output;
     unless ($env{'form.obsolete'}) {      unless ($env{'form.obsolete'}) {
  if ($target=~/(\_\_\_|\&\&\&|\:\:\:)/) {   if ($target=~/(\_\_\_|\&\&\&|\:\:\:)/) {
     $r->print('<span class="LC_error">'.      $output = '<span class="LC_error">'.
       &mt('Unsupported character combination [_1] in filename, FAIL.',"<tt>'.$1.'</tt>").        &mt('Unsupported character combination [_1] in filename, FAIL.',"<tt>'.$1.'</tt>").
       '</span>');        '</span>';
     return 0;              if ($usebuffer) {
                   if (wantarray) { 
                       return ($output,0);
                   } else {
                       return 0;
                   }
               } else {
                   $r->print($output);
           return 0;
               }
  }   }
  unless ($target=~/\.(\w+)$/) {   unless ($target=~/\.(\w+)$/) {
     $r->print('<span class="LC_error">'.&mt('No valid extension found in filename, FAIL').'</span>');              $output = '<span class="LC_error">'.&mt('No valid extension found in filename, FAIL').'</span>'; 
     return 0;              if ($usebuffer) {
                   if (wantarray) {
                       return ($output,0);
                   } else {
                       return 0;
                   }
               } else {
           $r->print($output);
           return 0;
               }
  }   }
  if ($target=~/\.(\d+)\.(\w+)$/) {   if ($target=~/\.(\d+)\.(\w+)$/) {
     $r->print('<span class="LC_error">'.&mt('Filename of resource contains internal version number. Cannot publish such resources, FAIL').'</span>');      $output = '<span class="LC_error">'.&mt('Filename of resource contains internal version number. Cannot publish such resources, FAIL').'</span>';
     return 0;              if ($usebuffer) {
                   if (wantarray) {
                       return ($output,0);
                   } else {
                       return 0;
                   }
               } else { 
                   $r->print($output);
           return 0;
               }
  }   }
     }      }
   
Line 1668  sub phasetwo { Line 1745  sub phasetwo {
     $distarget=~s/\/+/\//g;      $distarget=~s/\/+/\//g;
     my $logfile;      my $logfile;
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
  $r->print(          $output = '<span class="LC_error">'.
         '<span class="LC_error">'.    &mt('No write permission to user directory, FAIL').'</span>';
  &mt('No write permission to user directory, FAIL').'</span>');          if ($usebuffer) {
         return 0;              if (wantarray) {
                   return ($output,0);
               } else {
                   return 0;
               }
           } else {
               return 0;
           }
     }      }
           
     if ($source =~ /\.rights$/) {      if ($source =~ /\.rights$/) {
  $r->print('<p><span class="LC_warning">'.&mt('Warning: It can take up to 1 hour for rights changes to fully propagate.').'</span></p>');   $output = '<p><span class="LC_warning">'.&mt('Warning: It can take up to 1 hour for rights changes to fully propagate.').'</span></p>';
           unless ($usebuffer) {
               $r->print($output);
               $output = ''; 
           }
     }      }
   
     print $logfile       print $logfile 
Line 1737  sub phasetwo { Line 1825  sub phasetwo {
                                  $env{'user.domain'};                                   $env{'user.domain'};
     $metadatafields{'authorspace'}=$cuname.':'.$cudom;      $metadatafields{'authorspace'}=$cuname.':'.$cudom;
     $metadatafields{'domain'}=$cudom;      $metadatafields{'domain'}=$cudom;
       
       my $crsauthor;
       if ($env{'request.course.id'}) {
           my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
           my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
           if ($distarget =~ m{^/res/$cdom/$cnum}) {
               $crsauthor = 1;
               my $default_rights = "/res/$cdom/$cnum/default.rights";
               unless ($distarget eq $default_rights) {
                   $metadatafields{'copyright'} = 'custom';
                   $metadatafields{'customdistributionfile'} = $default_rights;
               }
           }
       }
   
     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'})) {
Line 1757  sub phasetwo { Line 1859  sub phasetwo {
     if ($metadatafields{'copyright'} eq 'custom') {      if ($metadatafields{'copyright'} eq 'custom') {
  my $file=$metadatafields{'customdistributionfile'};   my $file=$metadatafields{'customdistributionfile'};
  unless ($file=~/\.rights$/) {   unless ($file=~/\.rights$/) {
             $r->print(              $output .= '<span class="LC_error">'.&mt('No valid custom distribution rights file specified, FAIL').
                 '<span class="LC_error">'.&mt('No valid custom distribution rights file specified, FAIL').         '</span>';
  '</span>');              if ($usebuffer) {
     return 0;                  if (wantarray) {
                       return ($output,0);
                   } else {
                       return 0;
                   }
               } else {
                   $r->print($output);
           return 0;
               }
         }          }
     }      }
     {      {
         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')) {
             $r->print(               $output .= '<span class="LC_error">'.&mt('Could not write metadata, FAIL').
                 '<span class="LC_error">'.&mt('Could not write metadata, FAIL').         '</span>';
  '</span>');              if ($usebuffer) {
     return 0;                  if (wantarray) {
                       return ($output,0);
                   } else {
                       return 0;
                   }
               } else {
                   $r->print($output);
           return 0;
               }
         }          }
         foreach my $field (sort(keys(%metadatafields))) {          foreach my $field (sort(keys(%metadatafields))) {
             unless ($field=~/\./) {              unless ($field=~/\./) {
Line 1789  sub phasetwo { Line 1907  sub phasetwo {
                         .'</'.$tag.'>';                          .'</'.$tag.'>';
             }              }
         }          }
         $r->print('<p>'.&mt('Wrote Metadata').'</p>');  
           $output  .= '<p>'.&mt('Wrote Metadata').'</p>';
           unless ($usebuffer) {
               $r->print($output);
               $output = '';
           }
         print $logfile "\nWrote metadata";          print $logfile "\nWrote metadata";
     }      }
           
Line 1798  sub phasetwo { Line 1921  sub phasetwo {
     $metadatafields{'url'} = $distarget;      $metadatafields{'url'} = $distarget;
     $metadatafields{'version'} = 'current';      $metadatafields{'version'} = 'current';
   
     my ($error,$success) = &store_metadata(%metadatafields);      unless ($crsauthor) {
     if ($success) {          my ($error,$success) = &store_metadata(%metadatafields);
  $r->print('<p>'.&mt('Synchronized SQL metadata database').'</p>');          if ($success) {
  print $logfile "\nSynchronized SQL metadata database";      $output .= '<p>'.&mt('Synchronized SQL metadata database').'</p>';
     } else {      print $logfile "\nSynchronized SQL metadata database";
  $r->print($error);          } else {
  print $logfile "\n".$error;      $output .= $error;
       print $logfile "\n".$error;
           }
           unless ($usebuffer) {
               $r->print($output);
               $output = '';
           }
     }      }
 # --------------------------------------------- Delete author resource messages  # --------------------------------------------- Delete author resource messages
     my $delresult=&Apache::lonmsg::del_url_author_res_msg($target);       my $delresult=&Apache::lonmsg::del_url_author_res_msg($target); 
     $r->print('<p>'.&mt('Removing error messages:').' '.$delresult.'</p>');      $output .= '<p>'.&mt('Removing error messages:').' '.$delresult.'</p>';
       unless ($usebuffer) {
           $r->print($output);
           $output = '';
       }
     print $logfile "\nRemoving error messages: $delresult";      print $logfile "\nRemoving error messages: $delresult";
 # ----------------------------------------------------------- Copy old versions  # ----------------------------------------------------------- Copy old versions
         
Line 1822  sub phasetwo { Line 1955  sub phasetwo {
         my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'};          my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'};
         unless ($srcd=~/^\Q$docroot\E\/res/) {          unless ($srcd=~/^\Q$docroot\E\/res/) {
             print $logfile "\nPANIC: Target dir is ".$srcd;              print $logfile "\nPANIC: Target dir is ".$srcd;
             $r->print(              $output .= 
  "<span class=\"LC_error\">".&mt('Invalid target directory, FAIL')."</span>");   "<span class=\"LC_error\">".&mt('Invalid target directory, FAIL')."</span>";
     return 0;              if ($usebuffer) {
                   if (wantarray) {
                       return ($output,0);
                   } else {
                       return 0;
                   }
               } else {
                   $r->print($output);
           return 0;
               }
         }          }
         opendir(DIR,$srcd);          opendir(DIR,$srcd);
         while ($filename=readdir(DIR)) {          while ($filename=readdir(DIR)) {
Line 1839  sub phasetwo { Line 1981  sub phasetwo {
         }          }
         closedir(DIR);          closedir(DIR);
         $maxversion++;          $maxversion++;
         $r->print('<p>'.&mt('Creating old version [_1]',$maxversion).'</p>');          $output .= '<p>'.&mt('Creating old version [_1]',$maxversion).'</p>';
           unless ($usebuffer) {
               $r->print($output);
               $output = '';
           }
         print $logfile "\nCreating old version ".$maxversion."\n";          print $logfile "\nCreating old version ".$maxversion."\n";
                   
         my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;          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";
             $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old target file')));              $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied old target file'));
               unless ($usebuffer) {
                   $r->print($output);
                   $output = '';
               }
         } else {          } else {
     print $logfile "Unable to write ".$copyfile.':'.$!."\n";      print $logfile "Unable to write ".$copyfile.':'.$!."\n";
             $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1));              $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1);
     return 0;              if ($usebuffer) {
                   if (wantarray) {
                       return ($output,0);
                   } else {
                       return 0;
                   }
               } else {
                   $r->print($output); 
           return 0;
               }
         }          }
                   
 # --------------------------------------------------------------- Copy Metadata  # --------------------------------------------------------------- Copy Metadata
Line 1859  sub phasetwo { Line 2018  sub phasetwo {
                   
         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";
             $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata')));              $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata'));
               unless ($usebuffer) {
                   $r->print($output);
                   $output = '';
               }
         } 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') {
                 $r->print(&Apache::lonhtmlcommon::confirm_success(                  $output .= &Apache::lonhtmlcommon::confirm_success(
                            &mt('Failed to write old metadata copy').", $!",1));                                 &mt('Failed to write old metadata copy').", $!",1);
  return 0;                  if ($usebuffer) {
                       if (wantarray) {
                           return ($output,0);
                       } else {
                           return 0;
                       }
                   } else {
                       $r->print($output);
                       return 0;
                   }
     }      }
         }          }
           
           
     } else {      } else {
         $r->print('<p>'.&mt('Initial version').'</p>');          $output .= '<p>'.&mt('Initial version').'</p>';
           unless ($usebuffer) {
               $r->print($output);
               $output = '';
           }
         print $logfile "\nInitial version";          print $logfile "\nInitial version";
     }      }
   
Line 1887  sub phasetwo { Line 2061  sub phasetwo {
         if ((-e $path)!=1) {          if ((-e $path)!=1) {
             print $logfile "\nCreating directory ".$path;              print $logfile "\nCreating directory ".$path;
             mkdir($path,0777);              mkdir($path,0777);
             $r->print('<p>'              $output .= '<p>'
                      .&mt('Created directory [_1]'                        .&mt('Created directory [_1]'
                          ,'<span class="LC_filename">'.$parts[$count].'</span>')                             ,'<span class="LC_filename">'.$parts[$count].'</span>')
                      .'</p>'                        .'</p>';
             );              unless ($usebuffer) {
                   $r->print($output);
                   $output = '';
               }
         }          }
     }      }
           
     if (copy($source,$copyfile)) {      if (copy($source,$copyfile)) {
         print $logfile "\nCopied original source to ".$copyfile."\n";          print $logfile "\nCopied original source to ".$copyfile."\n";
         $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied source file')));          $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied source file'));
           unless ($usebuffer) {
               $r->print($output);
               $output = '';
           }
     } else {      } else {
         print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";          print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
         $r->print(&Apache::lonhtmlcommon::confirm_success(          $output .= &Apache::lonhtmlcommon::confirm_success(
     &mt('Failed to copy source').", $!",1));      &mt('Failed to copy source').", $!",1);
  return 0;          if ($usebuffer) {
               if (wantarray) {
                   return ($output,0);
               } else {
                   return 0;
               }
           } else {
               $r->print($output);
               return 0;
           }
     }      }
           
 # ---------------------------------------------- Delete local tmp-preview files  # ---------------------------------------------- Delete local tmp-preview files
Line 1913  sub phasetwo { Line 2103  sub phasetwo {
           
     if (copy($source.'.meta',$copyfile)) {      if (copy($source.'.meta',$copyfile)) {
         print $logfile "\nCopied original metadata to ".$copyfile."\n";          print $logfile "\nCopied original metadata to ".$copyfile."\n";
         $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied metadata')));          $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied metadata'));
           unless ($usebuffer) {
               $r->print($output);
               $output = '';
           }
     } else {      } else {
         print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";          print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
         $r->print(&Apache::lonhtmlcommon::confirm_success(          $output .= &Apache::lonhtmlcommon::confirm_success(
                   &mt('Failed to write metadata copy').", $!",1));                       &mt('Failed to write metadata copy').", $!",1);
  return 0;          if ($usebuffer) {
               if (wantarray) {
                   return ($output,0);
               } else {
                   return 0;
               }
           } else {
               $r->print($output);
               return 0;
           }
       }
       unless ($usebuffer) {
           $r->rflush;
     }      }
     $r->rflush;  
   
 # ------------------------------------------------------------- Trigger updates  # ------------------------------------------------------------- Trigger updates
     push(@{$modified_urls},[$target,$source]);      push(@{$modified_urls},[$target,$source]);
Line 1939  sub phasetwo { Line 2144  sub phasetwo {
   
 # ------------------------------------------------------------- Everything done  # ------------------------------------------------------------- Everything done
     $logfile->close();      $logfile->close();
     $r->print('<p class="LC_success">'.&mt('Done').'</p>');      $output .= '<p class="LC_success">'.&mt('Done').'</p>';
       unless ($usebuffer) {
           $r->print($output);
           $output = '';
       }
   
 # ------------------------------------------------ Provide link to new resource  # ------------------------------------------------ Provide link to new resource
     unless ($batch) {      unless ($batch) {
Line 1948  sub phasetwo { Line 2157  sub phasetwo {
         my $thissrcdir=$thissrc;          my $thissrcdir=$thissrc;
         $thissrcdir=~s/\/[^\/]+$/\//;          $thissrcdir=~s/\/[^\/]+$/\//;
                   
         $r->print(          $output .= 
             &Apache::lonhtmlcommon::actionbox([              &Apache::lonhtmlcommon::actionbox([
                 '<a href="'.$thisdistarget.'">'.                  '<a href="'.$thisdistarget.'">'.
                 &mt('View Published Version').                  &mt('View Published Version').
Line 1958  sub phasetwo { Line 2167  sub phasetwo {
                 '</a>',                  '</a>',
                 '<a href="'.$thissrcdir.'">'.                  '<a href="'.$thissrcdir.'">'.
                 &mt('Back to Source Directory').                  &mt('Back to Source Directory').
                 '</a>'])                  '</a>']);
         );          unless ($usebuffer) {
               $r->print($output);
               $output = '';
           }
       }
   
       if ($usebuffer) {
           if (wantarray) {
               return ($output,1);
           } else {
               return 1;
           }
       } else {
           if (wantarray) {
               return ('',1);
           } else {
               return 1;
           }
     }      }
     return 1;  
 }  }
   
 # =============================================================== Notifications  # =============================================================== Notifications
Line 2005  sub notify { Line 2230  sub notify {
 #########################################  #########################################
   
 sub batchpublish {  sub batchpublish {
     my ($r,$srcfile,$targetfile)=@_;      my ($r,$srcfile,$targetfile,$nokeyref,$usebuffer)=@_;
     #publication pollutes %env with form.* values      #publication pollutes %env with form.* values
     my %oldenv=%env;      my %oldenv=%env;
     $srcfile=~s/\/+/\//g;      $srcfile=~s/\/+/\//g;
     $targetfile=~s/\/+/\//g;      $targetfile=~s/\/+/\//g;
     $srcfile=~s/\/+/\//g;  
   
     my $docroot=$r->dir_config('lonDocRoot');      my $docroot=$r->dir_config('lonDocRoot');
     my $thisdistarget=$targetfile;      my $thisdistarget=$targetfile;
Line 2025  sub batchpublish { Line 2249  sub batchpublish {
   
     my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);      my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
             
     $r->print('<h2>'      my $output = '<h2>'
              .&mt('Publishing [_1]',&Apache::loncfile::display($srcfile))               .&mt('Publishing [_1]',&Apache::loncfile::display($srcfile))
              .'</h2>'               .'</h2>';
     );      unless ($usebuffer) {
           $r->print($output);
           $output = '';
       }
   
 # phase one takes  # phase one takes
 #  my ($source,$target,$style,$batch)=@_;  #  my ($source,$target,$style,$batch)=@_;
     my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1);      my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1,$nokeyref);
     $r->print('<p>'.$outstring.'</p>');      
       if ($usebuffer) {
           $output .= '<p>'.$outstring.'</p>';
       } else {
           $r->print('<p>'.$outstring.'</p>');
       }
 # phase two takes  # phase two takes
 # my ($source,$target,$style,$distarget,batch)=@_;  # my ($source,$target,$style,$distarget,batch)=@_;
 # $env{'form.allmeta'},$env{'form.title'},$env{'form.author'},...  # $env{'form.allmeta'},$env{'form.title'},$env{'form.author'},...
     if (!$error) {      if (!$error) {
  $r->print('<p>');          if ($usebuffer) {
  &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);      my ($result,$error) = &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1,$usebuffer);
  $r->print('</p>');      $output .= '<p>'.$result.'</p>';
           } else {
               &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
           }
     }      }
     %env=%oldenv;      %env=%oldenv;
     return '';      if ($usebuffer) {
           return $output;
       } else {
           return '';
       } 
 }  }
   
 #########################################  #########################################
   
 sub publishdirectory {  sub publishdirectory {
     my ($r,$fn,$thisdisfn)=@_;      my ($r,$fn,$thisdisfn,$nokeyref,$crsauthor)=@_;
     $fn=~s/\/+/\//g;      $fn=~s/\/+/\//g;
     $thisdisfn=~s/\/+/\//g;      $thisdisfn=~s/\/+/\//g;
     my $thisdisresdir=$thisdisfn;      my $thisdisresdir=$thisdisfn;
Line 2064  sub publishdirectory { Line 2303  sub publishdirectory {
             .'<span class="LC_filename">'.$thisdisresdir.'</span>'              .'<span class="LC_filename">'.$thisdisresdir.'</span>'
     );      );
     my %reasons = &Apache::lonlocal::texthash(      my %reasons = &Apache::lonlocal::texthash(
                       mod => 'Authoring Space file postdates published file',                        mod => 'Authoring Space file postdates published file', 
                       modmeta => 'Authoring Space metadata file postdates published file',                        modmeta => 'Authoring Space metadata file postdates published file',
                       unpub => 'Resource is unpublished',                        unpub => 'Resource is unpublished',
     );      );
Line 2090  sub publishdirectory { Line 2329  sub publishdirectory {
                   &checkbox('excludemodmeta','exclude files with modified metadata').                    &checkbox('excludemodmeta','exclude files with modified metadata').
                   '</fieldset>'.                    '</fieldset>'.
                   '<fieldset><legend>'.&mt('Actions').'</legend>'.                    '<fieldset><legend>'.&mt('Actions').'</legend>'.
                   &checkbox('obsolete','make file(s) obsolete').'<br />'.                    &checkbox('obsolete','make file(s) obsolete').'<br />');
                   &common_access('dist',&mt('apply common copyright/distribution'),          unless ($crsauthor) {
                                  ['default','domain','public','custom']).'<br />'.              $r->print(&common_access('dist',&mt('apply common copyright/distribution'),
                   &common_access('source',&mt('apply common source availability'),                                       ['default','domain','public','custom']).'<br />');
           }
           $r->print(&common_access('source',&mt('apply common source availability'),
                                  ['closed','open']).                                   ['closed','open']).
                   '</fieldset>'                    '</fieldset>'
         );          );
Line 2122  sub publishdirectory { Line 2363  sub publishdirectory {
     if ($filename=~/\.(\w+)$/) { $extension=$1; }      if ($filename=~/\.(\w+)$/) { $extension=$1; }
     if ($cmode&$dirptr) {      if ($cmode&$dirptr) {
  if (($filename!~/^\./) && ($env{'form.pubrec'})) {   if (($filename!~/^\./) && ($env{'form.pubrec'})) {
     &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);      &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename,$nokeyref,$crsauthor);
  }   }
     } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&      } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
      ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {       ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
Line 2148  sub publishdirectory { Line 2389  sub publishdirectory {
                         if ( $meta_rmtime<$meta_cmtime ) {                          if ( $meta_rmtime<$meta_cmtime ) {
                             if ($env{'form.excludemodmeta'}) {                              if ($env{'form.excludemodmeta'}) {
                                 $skipthis='modmeta';                                  $skipthis='modmeta';
                                 $publishthis=0;                                  $publishthis=0; 
                             } else {                              } else {
                                 $publishthis=1;                                  $publishthis=1;
                             }                              }
Line 2189  sub publishdirectory { Line 2430  sub publishdirectory {
  }   }
   
  if ($publishthis) {   if ($publishthis) {
     &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);      &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename,$nokeyref);
  } else {   } else {
                     my $reason;                      my $reason;
                     if ($skipthis) {                      if ($skipthis) {
Line 2361  sub handler { Line 2602  sub handler {
  return HTTP_NOT_FOUND;   return HTTP_NOT_FOUND;
     }       } 
   
 # -------------------------------- File is there and owned, init lookup tables.  # --------------------------------- File is there and owned, start page output
   
     %addid=();  
       
     {  
  my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');  
  while (<$fh>=~/(\w+)\s+(\w+)/) {  
     $addid{$1}=$2;  
  }  
     }  
   
     %nokey=();  
   
     {  
  my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');  
  while (<$fh>) {  
     my $word=$_;  
     chomp($word);  
     $nokey{$word}=1;  
  }  
     }  
   
 # ---------------------------------------------------------- Start page output.  
   
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
     $r->send_http_header;      $r->send_http_header;
       
     # Breadcrumbs      # Breadcrumbs
     &Apache::lonhtmlcommon::clear_breadcrumbs();      &Apache::lonhtmlcommon::clear_breadcrumbs();
       my $crumbtext = 'Authoring Space';
       my $crumbhref = &Apache::loncommon::authorspace($fn);
       my $crsauthor;
       if ($env{'request.course.id'}) {
           my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
           my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
           if ($crumbhref eq "/priv/$cdom/$cnum/") {
               $crumbtext = 'Course Authoring Space';
               $crsauthor = 1;
           }
       }
     &Apache::lonhtmlcommon::add_breadcrumb({      &Apache::lonhtmlcommon::add_breadcrumb({
         'text'  => 'Authoring Space',          'text'  => $crumbtext,
         'href'  => &Apache::loncommon::authorspace($fn),          'href'  => $crumbhref,
     });      });
     &Apache::lonhtmlcommon::add_breadcrumb({      &Apache::lonhtmlcommon::add_breadcrumb({
         'text'  => 'Resource Publication',          'text'  => 'Resource Publication',
Line 2458  END Line 2688  END
     my $thistarget=$fn;      my $thistarget=$fn;
     $thistarget=~s/^\/priv\//\/res\//;      $thistarget=~s/^\/priv\//\/res\//;
     my $thisdistarget=&HTML::Entities::encode($thistarget,'<>&"');      my $thisdistarget=&HTML::Entities::encode($thistarget,'<>&"');
       my $nokeyref = &getnokey($r->dir_config('lonIncludes'));
   
     if ($fn=~/\/$/) {      if ($fn=~/\/$/) {
 # -------------------------------------------------------- This is a directory  # -------------------------------------------------------- This is a directory
  &publishdirectory($r,$docroot.$fn,$thisdisfn);   &publishdirectory($r,$docroot.$fn,$thisdisfn,$nokeyref,$crsauthor);
         $r->print(          $r->print(
             '<br /><br />'.              '<br /><br />'.
             &Apache::lonhtmlcommon::actionbox([              &Apache::lonhtmlcommon::actionbox([
Line 2534  ENDDIFF Line 2765  ENDDIFF
     }      }
     unless ($errorcount) {      unless ($errorcount) {
  my ($outstring,$error)=   my ($outstring,$error)=
     &publish($docroot.$fn,$docroot.$thistarget,$thisembstyle);      &publish($docroot.$fn,$docroot.$thistarget,$thisembstyle,undef,$nokeyref);
  $r->print($outstring);   $r->print($outstring);
     } else {      } else {
  $r->print('<h3 class="LC_error">'.   $r->print('<h3 class="LC_error">'.
Line 2542  ENDDIFF Line 2773  ENDDIFF
   '</h3>');    '</h3>');
     }      }
  } else {   } else {
     &phasetwo($r,$docroot.$fn,$docroot.$thistarget,$thisembstyle,$thisdistarget);       my ($output,$error) = &phasetwo($r,$docroot.$fn,$docroot.$thistarget,
                                               $thisembstyle,$thisdistarget);
               $r->print($output);
  }   }
     }      }
     $r->print(&Apache::loncommon::end_page());      $r->print(&Apache::loncommon::end_page());
Line 2550  ENDDIFF Line 2783  ENDDIFF
     return OK;      return OK;
 }  }
   
   BEGIN {
   
   # ----------------------------------- Read addid.tab
       unless ($readit) {
           %addid=();
   
           {
               my $tabdir = $Apache::lonnet::perlvar{'lonTabDir'};
               my $fh=Apache::File->new($tabdir.'/addid.tab');
               while (<$fh>=~/(\w+)\s+(\w+)/) {
                   $addid{$1}=$2;
               }
           }
       }
       $readit=1;
   }
   
   
 1;  1;
 __END__  __END__
   

Removed from v.1.295.2.1.2.1  
changed lines
  Added in v.1.303


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