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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.283 and 1.296

version 1.283, 2013/07/15 16:13:31 version 1.296, 2016/06/19 01:08:01
Line 102  to publication space. Line 102  to publication space.
 Many of the undocumented subroutines implement various magical  Many of the undocumented subroutines implement various magical
 parsing shortcuts.  parsing shortcuts.
   
 =over 4  
   
 =cut  =cut
   
 ######################################################################  ######################################################################
Line 130  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 149  my $lock; Line 143  my $lock;
   
 =pod  =pod
   
   =over 4
   
 =item B<metaeval>  =item B<metaeval>
   
 Evaluates a string that contains metadata.  This subroutine  Evaluates a string that contains metadata.  This subroutine
Line 200  sub metaeval { Line 196  sub metaeval {
     if (defined($token->[2]->{'name'})) {       if (defined($token->[2]->{'name'})) { 
  $unikey.="\0".$token->[2]->{'name'};    $unikey.="\0".$token->[2]->{'name'}; 
     }      }
     foreach (@{$token->[3]}) {      foreach my $item (@{$token->[3]}) {
  $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};   $metadatafields{$unikey.'.'.$item}=$token->[2]->{$item};
  if ($metadatakeys{$unikey}) {   if ($metadatakeys{$unikey}) {
     $metadatakeys{$unikey}.=','.$_;      $metadatakeys{$unikey}.=','.$item;
  } else {   } else {
     $metadatakeys{$unikey}=$_;      $metadatakeys{$unikey}=$item;
  }   }
     }      }
     my $newentry=$parser->get_text('/'.$entry);      my $newentry=$parser->get_text('/'.$entry);
Line 293  sub coursedependencies { Line 289  sub coursedependencies {
     my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,      my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
        $aauthor,$regexp);         $aauthor,$regexp);
     my %courses=();      my %courses=();
     foreach (keys %evaldata) {      foreach my $item (keys(%evaldata)) {
  if ($_=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) {   if ($item=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) {
     $courses{$1}=1;      $courses{$1}=1;
         }          }
     }      }
Line 318  string which presents the form field (fo Line 314  string which presents the form field (fo
   
 =item B<textfield>  =item B<textfield>
   
   =item B<text_with_browse_field>
   
 =item B<hiddenfield>  =item B<hiddenfield>
   
   =item B<checkbox>
   
 =item B<selectbox>  =item B<selectbox>
   
 =back  =back
Line 382  sub selectbox { Line 382  sub selectbox {
     }      }
     my $selout="\n".&Apache::lonhtmlcommon::row_title($title)      my $selout="\n".&Apache::lonhtmlcommon::row_title($title)
               .'<select name="'.$name.'">';                .'<select name="'.$name.'">';
     foreach (@idlist) {      foreach my $id (@idlist) {
         $selout.='<option value="'.$_.'"';          $selout.='<option value="'.$id.'"';
         if ($_ eq $value) {          if ($id eq $value) {
     $selout.=' selected="selected"';      $selout.=' selected="selected"';
         }          }
         $selout.='>'.&{$functionref}($_).'</option>';          $selout.='>'.&{$functionref}($id).'</option>';
     }      }
     $selout.='</select>'.&Apache::lonhtmlcommon::row_closure();      $selout.='</select>'.&Apache::lonhtmlcommon::row_closure();
     return $selout;      return $selout;
Line 399  sub select_level_form { Line 399  sub select_level_form {
     if (!defined($value)) { $env{'form.'.$name}=0; }      if (!defined($value)) { $env{'form.'.$name}=0; }
     return  &Apache::loncommon::select_level_form($value,$name);      return  &Apache::loncommon::select_level_form($value,$name);
 }  }
   
   sub common_access {
       my ($name,$text,$options)=@_;
       return unless (ref($options) eq 'ARRAY');
       my $formname = 'pubdirpref';
       my $chkname = 'common'.$name;
       my $chkid = 'LC_'.$chkname;
       my $divid = $chkid.'div';
       my $customdivid = 'LC_customfile'; 
       my $selname = $chkname.'select';
       my $selid = $chkid.'select';
       my $selonchange;
       if ($name eq 'dist') {
           $selonchange = ' onchange="showHideCustom(this,'."'$customdivid'".');"';
       }
       my %lt = &Apache::lonlocal::texthash(
                                               'default' => 'System wide - can be used for any courses system wide',
                                               'domain'  => 'Domain only - use limited to courses in the domai',
                                               'custom'  => 'Customized right of use ...',
                                               'public'  => 'Public - no authentication or authorization required for use',
                                               'closed'  => 'Closed - XML source is closed to everyone',
                                               'open'    => 'Open - XML source is open to people who want to use it',
                                               'sel'     => 'Select',
                                           );
       my $output = <<"END";
   <br />
   <span class="LC_nobreak">
   <label>
   <input type="checkbox" name="commonaccess" value="$name" id="$chkid"  
   onclick="showHideAccess(this,'$divid');" />
   $text</label></span>
   <div id="$divid" style="padding:0;clear:both;margin:0;border:0;display:none">
   <select name="$selname" id="$selid" $selonchange>
   <option value="" selected="selected">$lt{'sel'}</option>
   END
       foreach my $val (@{$options}) {
           $output .= '<option value="'.$val.'">'.$lt{$val}.'</option>'."\n";
       }
       $output .= '
   </select>';
       if ($name eq 'dist') {
           $output .= <<"END";
   <div id="$customdivid" style="padding:0;clear:both;margin:0;border:0;display:none">
   <input type="text" name="commoncustomrights" size="60" value="" />
   <a href="javascript:openbrowser('$formname','commoncustomrights','rights');">
   $lt{'sel'}</a></div>
   END
       }
       $output .= '
   </div>
   ';
   }
   
 #########################################  #########################################
 #########################################  #########################################
   
Line 468  Currently undocumented Line 521  Currently undocumented
 #########################################  #########################################
 #########################################  #########################################
 sub set_allow {  sub set_allow {
     my ($allow,$logfile,$target,$tag,$oldurl)=@_;      my ($allow,$logfile,$target,$tag,$oldurl,$type)=@_;
     my $newurl=&urlfixup($oldurl,$target);      my $newurl=&urlfixup($oldurl,$target);
     my $return_url=$oldurl;      my $return_url=$oldurl;
     print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n";      print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n";
Line 480  sub set_allow { Line 533  sub set_allow {
  ($newurl !~ /^mailto:/i) &&   ($newurl !~ /^mailto:/i) &&
  ($newurl !~ /^(?:http|https|ftp):/i) &&   ($newurl !~ /^(?:http|https|ftp):/i) &&
  ($newurl !~ /^\#/)) {   ($newurl !~ /^\#/)) {
           if (($type eq 'src') || ($type eq 'href')) {
               if ($newurl =~ /^([^?]+)\?[^?]*$/) {
                   $newurl = $1;
               }
           }
  $$allow{&absoluteurl($newurl,$target)}=1;   $$allow{&absoluteurl($newurl,$target)}=1;
     }      }
     return $return_url;      return $return_url;
Line 721  sub fix_ids_and_indices { Line 779  sub fix_ids_and_indices {
     foreach my $type ('src','href','background','bgimg') {      foreach my $type ('src','href','background','bgimg') {
  foreach my $key (keys(%parms)) {   foreach my $key (keys(%parms)) {
     if ($key =~ /^$type$/i) {      if ($key =~ /^$type$/i) {
                                   next if (($lctag eq 'img') && ($type eq 'src') && 
                                            ($parms{$key} =~ m{^data\:image/gif;base64,}));
  $parms{$key}=&set_allow(\%allow,$logfile,   $parms{$key}=&set_allow(\%allow,$logfile,
  $target,$tag,   $target,$tag,
  $parms{$key});   $parms{$key},$type);
     }      }
  }   }
     }      }
Line 780  sub fix_ids_and_indices { Line 840  sub fix_ids_and_indices {
  }   }
  my $newparmstring='';   my $newparmstring='';
  my $endtag='';   my $endtag='';
  foreach (keys %parms) {   foreach my $parkey (keys(%parms)) {
     if ($_ eq '/') {      if ($parkey eq '/') {
  $endtag=' /';   $endtag=' /';
     } else {       } else { 
  my $quote=($parms{$_}=~/\"/?"'":'"');   my $quote=($parms{$parkey}=~/\"/?"'":'"');
  $newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote;   $newparmstring.=' '.$parkey.'='.$quote.$parms{$parkey}.$quote;
     }      }
  }   }
  if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }   if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
  $outstring.='<'.$tag.$newparmstring.$endtag.'>';   $outstring.='<'.$tag.$newparmstring.$endtag.'>';
  if ($lctag eq 'm' || $lctag eq 'script' || $lctag eq 'answer'    if ($lctag eq 'm' || $lctag eq 'answer' || $lctag eq 'display' ||
                     || $lctag eq 'display' || $lctag eq 'tex') {                      $lctag eq 'tex') {
     $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);      $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);
  }                  } elsif ($lctag eq 'script') {
                       if ($parms{'type'} eq 'loncapa/perl') {
                           $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);
                       } else {
                           my $script = &get_all_text_unbalanced('/'.$lctag,\@parser);
                           if ($script =~ m{\.set\w+(Src|Swf)\(["']}i) {
                               my @srcs = split(/\.set/i,$script);
                               if (scalar(@srcs) > 1) {
                                   foreach my $item (@srcs) {
                                       if ($item =~ m{^(FlashPlayerSwf|MediaSrc|XMPSrc|ConfigurationSrc|PosterImageSrc)\((['"])(?:(?!\2).)+\2\)}is) {
                                           my $srctype = $1;
                                           my $quote = $2;
                                           my ($url) = ($item =~ m{^\Q$srctype($quote\E([^$quote]+)\Q$quote)\E});
                                           $url = &urlfixup($url);
                                           unless ($url=~m{^(?:http|https|ftp)://}) {
                                               $allow{&absoluteurl($url,$target)}=1;
                                               if ($srctype eq 'ConfigurationSrc') {
                                                   if ($url =~ m{^(.+/)configuration_express\.xml$}) {
   #
   # Camtasia 8.1: express_show/spritesheet.png needed, and included in zip archive.
   # Not referenced directly in <main>.html or <main>_player.html files,
   # so add this file to %allow (where <main> is name user gave to file/archive).
   #
                                                       my $spritesheet = $1.'express_show/spritesheet.png';
                                                       $allow{&absoluteurl($spritesheet,$target)}=1;
   
   #
   # Camtasia 8.4: skins/express_show/spritesheet.min.css needed, and included in zip archive.
   # Not referenced directly in <main>.html or <main>_player.html files,
   # so add this file to %allow (where <main> is name user gave to file/archive).
   #
                                                       my $spritecss = $1.'express_show/spritesheet.min.css';
                                                       $allow{&absoluteurl($spritecss,$target)}=1;
                                                   }
                                               } elsif ($srctype eq 'PosterImageSrc') {
                                                   if ($url =~ m{^(.+)_First_Frame\.png$}) {
                                                       my $prefix = $1;
   #
   # Camtasia 8.1: <main>_Thumbnails.png needed, and included in zip archive.
   # Not referenced directly in <main>.html or <main>_player.html files,
   # so add this file to %allow (where <main> is name user gave to file/archive).
   #
                                                       my $thumbnail = $prefix.'_Thumbnails.png';
                                                       $allow{&absoluteurl($thumbnail,$target)}=1;
                                                   }
                                               }
                                           }
                                       }
                                   }
                               }
                           }
                           if ($script =~ m{\.addMediaSrc\((["'])((?!\1).+)\1\);}) {
                               my $src = $2;
                               if ($src) {
                                   my $url = &urlfixup($src);
                                   unless ($url=~m{^(?:http|https|ftp)://}) {
                                       $allow{&absoluteurl($url,$target)}=1;
                                   }
                               }
                           }
                           if ($script =~ /\(document,\s*(['"])script\1,\s*\[([^\]]+)\]\);/s) {
                               my $scriptslist = $2;
                               my @srcs = split(/\s*,\s*/,$scriptslist);
                               foreach my $src (@srcs) {
                                   if ($src =~ /(["'])(?:(?!\1).)+\.js\1/) {
                                       my $quote = $1;
                                       my ($url) = ($src =~ m/\Q$quote\E([^$quote]+)\Q$quote\E/);
                                       $url = &urlfixup($url);
                                       unless ($url=~m{^(?:http|https|ftp)://}) {
                                           $allow{&absoluteurl($url,$target)}=1;
                                       }
                                   }
                               }
                           }
                           if ($script =~ m{loadScript\(\s*(['"])((?:(?!\1).)+\.js)\1,\s*function}is) {
                               my $src = $2;
                               if ($src) {
                                   my $url = &urlfixup($src);
                                   unless ($url=~m{^(?:http|https|ftp)://}) {
                                       $allow{&absoluteurl($url,$target)}=1;
                                   }
                               }
                           }
                           $outstring .= $script;
                       }
                   }
     } elsif ($token->[0] eq 'E') {      } elsif ($token->[0] eq 'E') {
  if ($token->[2]) {   if ($token->[2]) {
     unless ($token->[1] eq 'allow') {      unless ($token->[1] eq 'allow') {
Line 958  I<Additional documentation needed.> Line 1103  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 1105  sub publish { Line 1250  sub publish {
   
 # ------------------- Clear out parameters and stores (there should not be any)  # ------------------- Clear out parameters and stores (there should not be any)
   
         foreach (keys %metadatafields) {          foreach my $field (keys(%metadatafields)) {
     if (($_=~/^parameter/) || ($_=~/^stores/)) {      if (($field=~/^parameter/) || ($field=~/^stores/)) {
  delete $metadatafields{$_};   delete $metadatafields{$field};
             }              }
         }          }
   
Line 1116  sub publish { Line 1261  sub publish {
   
         $scrout.=&metaread($logfile,$source.'.meta');          $scrout.=&metaread($logfile,$source.'.meta');
   
         foreach (keys %metadatafields) {          foreach my $field (keys(%metadatafields)) {
     if (($_=~/^parameter/) || ($_=~/^stores/)) {      if (($field=~/^parameter/) || ($field=~/^stores/)) {
                 $oldparmstores{$_}=1;                  $oldparmstores{$field}=1;
  delete $metadatafields{$_};   delete $metadatafields{$field};
             }              }
         }          }
 # ------------------------------------------------------------- Save some stuff  # ------------------------------------------------------------- Save some stuff
         my %savemeta=();          my %savemeta=();
         foreach ('title') {          if ($metadatafields{'title'}) { $savemeta{'title'}=$metadatafields{'title'}; }
             if ($metadatafields{$_}) { $savemeta{$_}=$metadatafields{$_}; }  
  }  
 # ------------------------------------------ See if anything new in file itself  # ------------------------------------------ See if anything new in file itself
     
  $allmeta=&parseformeta($source,$style);   $allmeta=&parseformeta($source,$style);
 # ----------------------------------------------------------- Restore the stuff  # ----------------------------------------------------------- Restore the stuff
         foreach (keys %savemeta) {          foreach my $item (keys(%savemeta)) {
     $metadatafields{$_}=$savemeta{$_};      $metadatafields{$item}=$savemeta{$item};
  }   }
    }     }
   
Line 1140  sub publish { Line 1283  sub publish {
 # ---------------- Find and document discrepancies in the parameters and stores  # ---------------- Find and document discrepancies in the parameters and stores
   
     my $chparms='';      my $chparms='';
     foreach (sort keys %metadatafields) {      foreach my $field (sort(keys(%metadatafields))) {
  if (($_=~/^parameter/) || ($_=~/^stores/)) {   if (($field=~/^parameter/) || ($field=~/^stores/)) {
     unless ($_=~/\.\w+$/) {       unless ($field=~/\.\w+$/) {
  unless ($oldparmstores{$_}) {   unless ($oldparmstores{$field}) {
     my $disp_key = $_;      my $disp_key = $field;
     $disp_key =~ tr/\0/_/;      $disp_key =~ tr/\0/_/;
     print $logfile ('New: '.$disp_key."\n");      print $logfile ('New: '.$disp_key."\n");
     $chparms .= $disp_key.' ';      $chparms .= $disp_key.' ';
Line 1158  sub publish { Line 1301  sub publish {
     }      }
   
     $chparms='';      $chparms='';
     foreach (sort keys %oldparmstores) {      foreach my $olditem (sort(keys(%oldparmstores))) {
  if (($_=~/^parameter/) || ($_=~/^stores/)) {   if (($olditem=~/^parameter/) || ($olditem=~/^stores/)) {
     unless (($metadatafields{$_.'.name'}) ||      unless (($metadatafields{$olditem.'.name'}) ||
     ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {      ($metadatafields{$olditem.'.package'}) || ($olditem=~/\.\w+$/)) {
  my $disp_key = $_;   my $disp_key = $olditem;
  $disp_key =~ tr/\0/_/;   $disp_key =~ tr/\0/_/;
  print $logfile ('Obsolete: '.$disp_key."\n");   print $logfile ('Obsolete: '.$disp_key."\n");
  $chparms.=$disp_key.' ';   $chparms.=$disp_key.' ';
Line 1200  sub publish { Line 1343  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 1239  sub publish { Line 1382  sub publish {
  &hiddenfield('phase','two').   &hiddenfield('phase','two').
  &hiddenfield('filename',$env{'form.filename'}).   &hiddenfield('filename',$env{'form.filename'}).
  &hiddenfield('allmeta',&escape($allmeta)).   &hiddenfield('allmeta',&escape($allmeta)).
  &hiddenfield('dependencies',join(',',keys %allow));   &hiddenfield('dependencies',join(',',keys(%allow)));
     unless ($env{'form.makeobsolete'}) {      unless ($env{'form.makeobsolete'}) {
        $intr_scrout.=         $intr_scrout.=
  &textfield('Title','title',$metadatafields{'title'}).   &textfield('Title','title',$metadatafields{'title'}).
Line 1451  END Line 1594  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 1473  Parameters: Line 1628  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
   
   =back
   
 =cut  =cut
   
 #'stupid emacs  #'stupid emacs
Line 1491  Returns: Line 1656  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 1520  sub phasetwo { Line 1713  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 1537  sub phasetwo { Line 1741  sub phasetwo {
     %metadatakeys=();      %metadatakeys=();
   
     &metaeval(&unescape($env{'form.allmeta'}));      &metaeval(&unescape($env{'form.allmeta'}));
       
       if ($batch) {
           my %commonaccess;
           map { $commonaccess{$_} = 1; } &Apache::loncommon::get_env_multiple('form.commonaccess');
           if ($commonaccess{'dist'}) {
               unless ($style eq 'prv') { 
                   if ($env{'form.commondistselect'} eq 'custom') {
                       unless ($source =~ /\.rights$/) {
                           if ($env{'form.commoncustomrights'} =~ m{^/res/.+\.rights$}) { 
                               $env{'form.customdistributionfile'} = $env{'form.commoncustomrights'}; 
                               $env{'form.copyright'} = $env{'form.commondistselect'};
                           }
                       }
                   } elsif ($env{'form.commondistselect'} =~ /^default|domain|public$/) {
                       $env{'form.copyright'} = $env{'form.commondistselect'};
                   }
               }
           }
           unless ($style eq 'prv') {
               if ($commonaccess{'source'}) {
                   if (($env{'form.commonsourceselect'} eq 'open') || ($env{'form.commonsourceselect'} eq 'closed')) {
                       $env{'form.sourceavail'} = $env{'form.commonsourceselect'};
                   }
               }
           }
       }
   
     $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'};
Line 1583  sub phasetwo { Line 1813  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);
         foreach (sort keys %metadatafields) {                  } else {
             unless ($_=~/\./) {                      return 0;
                 my $unikey=$_;                  }
               } else {
                   $r->print($output);
           return 0;
               }
           }
           foreach my $field (sort(keys(%metadatafields))) {
               unless ($field=~/\./) {
                   my $unikey=$field;
                 $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 my $item (split(/\,/,$metadatakeys{$unikey})) {
                     my $value=$metadatafields{$unikey.'.'.$_};                      my $value=$metadatafields{$unikey.'.'.$item};
                     $value=~s/\"/\'\'/g;                      $value=~s/\"/\'\'/g;
                     print $mfh ' '.$_.'="'.$value.'"';                      print $mfh ' '.$item.'="'.$value.'"';
                 }                  }
                 print $mfh '>'.                  print $mfh '>'.
                     &HTML::Entities::encode($metadatafields{$unikey},'<>&"')                      &HTML::Entities::encode($metadatafields{$unikey},'<>&"')
                         .'</'.$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 1626  sub phasetwo { Line 1877  sub phasetwo {
   
     my ($error,$success) = &store_metadata(%metadatafields);      my ($error,$success) = &store_metadata(%metadatafields);
     if ($success) {      if ($success) {
  $r->print('<p>'.&mt('Synchronized SQL metadata database').'</p>');   $output .= '<p>'.&mt('Synchronized SQL metadata database').'</p>';
  print $logfile "\nSynchronized SQL metadata database";   print $logfile "\nSynchronized SQL metadata database";
     } else {      } else {
  $r->print($error);   $output .= $error;
  print $logfile "\n".$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 1648  sub phasetwo { Line 1907  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 1665  sub phasetwo { Line 1933  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 1685  sub phasetwo { Line 1970  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 1713  sub phasetwo { Line 2013  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 1739  sub phasetwo { Line 2055  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 1765  sub phasetwo { Line 2096  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 1774  sub phasetwo { Line 2109  sub phasetwo {
         my $thissrcdir=$thissrc;          my $thissrcdir=$thissrc;
         $thissrcdir=~s/\/[^\/]+$/\//;          $thissrcdir=~s/\/[^\/]+$/\//;
                   
         $r->print(&Apache::loncommon::head_subbox(          $output .= 
             &Apache::lonhtmlcommon::start_funclist().              &Apache::lonhtmlcommon::actionbox([
             &Apache::lonhtmlcommon::add_item_funclist(  
                 '<a href="'.$thisdistarget.'">'.                  '<a href="'.$thisdistarget.'">'.
                 &mt('View Published Version').                  &mt('View Published Version').
                 '</a>').                  '</a>',
             &Apache::lonhtmlcommon::add_item_funclist(  
                 '<a href="'.$thissrc.'">'.                  '<a href="'.$thissrc.'">'.
                 &mt('Back to Source').                  &mt('Back to Source').
                 '</a>').                  '</a>',
             &Apache::lonhtmlcommon::add_item_funclist(  
                 '<a href="'.$thissrcdir.'">'.                  '<a href="'.$thissrcdir.'">'.
                 &mt('Back to Source Directory').                  &mt('Back to Source Directory').
                 '</a>').                  '</a>']);
             &Apache::lonhtmlcommon::end_funclist())          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 1818  sub notify { Line 2165  sub notify {
 # --------------------------------------------------- Notify subscribed courses  # --------------------------------------------------- Notify subscribed courses
  my %courses=&coursedependencies($target);   my %courses=&coursedependencies($target);
  my $now=time;   my $now=time;
  foreach (keys %courses) {   foreach my $course (keys(%courses)) {
     print $logfile "\nNotifying course ".$_.':';      print $logfile "\nNotifying course ".$course.':';
     my ($cdom,$cname)=split(/\_/,$_);      my ($cdom,$cname)=split(/\_/,$course);
     my $reply=&Apache::lonnet::cput      my $reply=&Apache::lonnet::cput
  ('versionupdate',{$target => $now},$cdom,$cname);   ('versionupdate',{$target => $now},$cdom,$cname);
     print $logfile $reply;      print $logfile $reply;
Line 1835  sub notify { Line 2182  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 1855  sub batchpublish { Line 2201  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)=@_;
     $fn=~s/\/+/\//g;      $fn=~s/\/+/\//g;
     $thisdisfn=~s/\/+/\//g;      $thisdisfn=~s/\/+/\//g;
     my $thisdisresdir=$thisdisfn;      my $thisdisresdir=$thisdisfn;
     $thisdisresdir=~s/^\/priv\//\/res\//;      $thisdisresdir=~s/^\/priv\//\/res\//;
     my $resdir = $r->dir_config('lonDocRoot').$thisdisresdir;      my $resdir = $r->dir_config('lonDocRoot').$thisdisresdir;
     $r->print(&Apache::lonhtmlcommon::start_pick_box()      $r->print('<form name="pubdirpref" method="post" action="">'
                .&Apache::lonhtmlcommon::start_pick_box()
              .&Apache::lonhtmlcommon::row_title(&mt('Directory'))               .&Apache::lonhtmlcommon::row_title(&mt('Directory'))
             .'<span class="LC_filename">'.$thisdisfn.'</span>'              .'<span class="LC_filename">'.$thisdisfn.'</span>'
             .&Apache::lonhtmlcommon::row_closure()              .&Apache::lonhtmlcommon::row_closure()
Line 1899  sub publishdirectory { Line 2261  sub publishdirectory {
         $r->print(&Apache::lonhtmlcommon::row_closure()          $r->print(&Apache::lonhtmlcommon::row_closure()
                  .&Apache::lonhtmlcommon::row_title(&mt('Options'))                   .&Apache::lonhtmlcommon::row_title(&mt('Options'))
         );          );
         $r->print('<form name="pubdirpref" method="post" action="">'.          $r->print(&hiddenfield('phase','two').
   &hiddenfield('phase','two').  
   &hiddenfield('filename',$env{'form.filename'}).    &hiddenfield('filename',$env{'form.filename'}).
   &checkbox('pubrec','include subdirectories').    &checkbox('pubrec','include subdirectories').
   &checkbox('forcerepub','force republication of previously published files').    &checkbox('forcerepub','force republication of previously published files').
                   &checkbox('obsolete','make file(s) obsolete').                    &checkbox('obsolete','make file(s) obsolete').
   &checkbox('forceoverride','force directory level metadata over existing').    &checkbox('forceoverride','force directory level metadata over existing').
   '<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');                    &common_access('dist',&mt('apply common copyright/distribution'),
                                    ['default','domain','custom']).
                     &common_access('source',&mt('apply common source availability'),
                                    ['closed','open'])
           );
         $r->print(&Apache::lonhtmlcommon::row_closure(1)          $r->print(&Apache::lonhtmlcommon::row_closure(1)
                  .&Apache::lonhtmlcommon::end_pick_box()                   .&Apache::lonhtmlcommon::end_pick_box()
                    .'<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>'
         );          );
         $lock=0;          $lock=0;
     } else {      } else {
Line 1929  sub publishdirectory { Line 2295  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,$docroot.$fn.'/'.$filename,$thisdisfn.'/'.$filename);      &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename,$nokeyref);
  }   }
     } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&      } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
      ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {       ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
Line 1955  sub publishdirectory { Line 2321  sub publishdirectory {
  }   }
   
  if ($publishthis) {   if ($publishthis) {
     &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);      &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename,$nokeyref);
  } else {   } else {
     $r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');      $r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');
  }   }
Line 2117  sub handler { Line 2483  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;
Line 2158  sub handler { Line 2502  sub handler {
     my $js='<script type="text/javascript">'.      my $js='<script type="text/javascript">'.
  &Apache::loncommon::browser_and_searcher_javascript().   &Apache::loncommon::browser_and_searcher_javascript().
  '</script>';   '</script>';
     $r->print(&Apache::loncommon::start_page('Resource Publication',$js)      my $startargs = {};
       if ($fn=~/\/$/) {
           unless ($env{'form.phase'} eq 'two') {
               $startargs->{'add_entries'} = { onload => 'javascript:setDefaultAccess();' };
               $js .= <<"END";
   <script type="text/javascript">
   // <![CDATA[
   function showHideAccess(caller,div) {
       if (document.getElementById(div)) {
           if (caller.checked) {
               document.getElementById(div).style.display='inline-block';
           } else {
               document.getElementById(div).style.display='none';
           }
       }
   }
   
   function showHideCustom(caller,divid) {
       if (document.getElementById(divid)) {
           if (caller.options[caller.selectedIndex].value == 'custom') {
               document.getElementById(divid).style.display="inline-block";
           } else {
               document.getElementById(divid).style.display="none";
           }
       }
   }
   function setDefaultAccess() {
       var chkids = Array('LC_commondist','LC_commonsource');
       for (var i=0; i<chkids.length; i++) {
           if (document.getElementById(chkids[i])) {
               document.getElementById(chkids[i]).checked = false;
           }
           if (document.getElementById(chkids[i]+'select')) {
              document.getElementById(chkids[i]+'select').selectedIndex = 0; 
           }
           if (document.getElementById(chkids[i]+'div')) {
               document.getElementById(chkids[i]+'div').style.display = 'none';
           }
       }
   }
   // ]]>
   </script>
   
   END
           }
       }
       $r->print(&Apache::loncommon::start_page('Resource Publication',$js,$startargs)
              .&Apache::lonhtmlcommon::breadcrumbs()               .&Apache::lonhtmlcommon::breadcrumbs()
              .&Apache::loncommon::head_subbox(               .&Apache::loncommon::head_subbox(
                   &Apache::loncommon::CSTR_pageheader($docroot.$fn))                    &Apache::loncommon::CSTR_pageheader($docroot.$fn))
Line 2168  sub handler { Line 2558  sub handler {
     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);
  $r->print('<hr /><a href="'.$thisdisfn.'">'.&mt('Return to Directory').'</a>');          $r->print(
               '<br /><br />'.
               &Apache::lonhtmlcommon::actionbox([
                   '<a href="'.$thisdisfn.'">'.&mt('Return to Directory').'</a>']));
     } else {      } else {
 # ---------------------- Evaluate individual file, and then output information.  # ---------------------- Evaluate individual file, and then output information.
  $fn=~/\.(\w+)$/;   $fn=~/\.(\w+)$/;
Line 2222  ENDCAPTION Line 2616  ENDCAPTION
             $r->print(&Apache::lonhtmlcommon::row_closure()              $r->print(&Apache::lonhtmlcommon::row_closure()
                      .&Apache::lonhtmlcommon::row_title(&mt('Diffs')));                       .&Apache::lonhtmlcommon::row_title(&mt('Diffs')));
     $r->print(<<ENDDIFF);      $r->print(<<ENDDIFF);
 <a href='javascript:void(window.open("/adm/diff?filename=$thisdisfn&versiontwo=priv","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>  <a href='javascript:void(window.open("/adm/diff?filename=$thisdisfn&amp;versiontwo=priv","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>
 ENDDIFF  ENDDIFF
             $r->print(&mt('Diffs with Current Version').'</a>');              $r->print(&mt('Diffs with Current Version').'</a>');
  }   }
Line 2241  ENDDIFF Line 2635  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 2249  ENDDIFF Line 2643  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 2257  ENDDIFF Line 2653  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__
   
Line 2264  __END__ Line 2678  __END__
   
 =back  =back
   
 =back  
   
 =cut  =cut
   
Removed from v.1.283  
changed lines
  Added in v.1.296

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