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

version 1.274, 2011/10/30 20:49:33 version 1.303, 2023/07/14 22:19:22
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 121  use HTML::LCParser; Line 119  use HTML::LCParser;
 use HTML::Entities;  use HTML::Entities;
 use Encode::Encoder;  use Encode::Encoder;
 use Apache::lonxml;  use Apache::lonxml;
 use Apache::loncacc;  
 use DBI;  use DBI;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon();  use Apache::loncommon();
Line 131  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 150  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 201  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 294  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 319  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 330  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 342  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 368  sub hiddenfield { Line 376  sub hiddenfield {
   
 sub checkbox {  sub checkbox {
     my ($name,$text)=@_;      my ($name,$text)=@_;
     return "\n<br /><label><input type='checkbox' name='$name' /> ".      return "\n<label><input type='checkbox' name='$name' /> ".
  &mt($text)."</label>";   &mt($text)."</label>";
 }  }
   
 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 383  sub selectbox { Line 391  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>';          if ($readonly) {
               $selout .= ' disabled="disabled"';
           }
           $selout.='>'.&{$functionref}($id).'</option>';
     }      }
     $selout.='</select>'.&Apache::lonhtmlcommon::row_closure();      $selout.='</select>'.&Apache::lonhtmlcommon::row_closure();
     return $selout;      return $selout;
Line 400  sub select_level_form { Line 411  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";
   <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 469  Currently undocumented Line 532  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 481  sub set_allow { Line 544  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 722  sub fix_ids_and_indices { Line 790  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 781  sub fix_ids_and_indices { Line 851  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 959  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 1017  sub publish { Line 1172  sub publish {
    $outdep.= ' - <span class="LC_error">'.&mt('Currently not available').     $outdep.= ' - <span class="LC_error">'.&mt('Currently not available').
        '</span>';         '</span>';
                } else {                 } else {
   #
   # Store the fact that the dependency has been used by the target file
   # Unfortunately, usage is erroneously named sequsage in lonmeta.pm
   # The translation happens in lonmetadata.pm
   #
                    my %temphash=(&Apache::lonnet::declutter($target).'___'.                     my %temphash=(&Apache::lonnet::declutter($target).'___'.
                              &Apache::lonnet::declutter($thisdep).'___usage'                               &Apache::lonnet::declutter($thisdep).'___usage'
                                  => time);                                   => time);
Line 1051  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 1101  sub publish { Line 1275  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 1112  sub publish { Line 1286  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 1136  sub publish { Line 1308  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 1154  sub publish { Line 1326  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 1196  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 1235  sub publish { Line 1407  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 1339  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 1356  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 1370  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 1381  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 1395  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 1447  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 1469  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
   
   =back
   
 =cut  =cut
   
 #'stupid emacs  #'stupid emacs
Line 1487  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 1516  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 1533  sub phasetwo { Line 1773  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 1559  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 1579  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);
         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 1620  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 1644  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 1661  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 1681  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 1709  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 1735  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 1761  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 1770  sub phasetwo { Line 2157  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 1814  sub notify { Line 2213  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 1831  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 1851  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;
     $thisdisresdir=~s/^\/priv\//\/res\//;      $thisdisresdir=~s/^\/priv\//\/res\//;
     my $resdir='/home/httpd/html'.$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()
             .&Apache::lonhtmlcommon::row_title(&mt('Target'))              .&Apache::lonhtmlcommon::row_title(&mt('Target'))
             .'<span class="LC_filename">'.$thisdisresdir.'</span>'              .'<span class="LC_filename">'.$thisdisresdir.'</span>'
     );      );
       my %reasons = &Apache::lonlocal::texthash(
                         mod => 'Authoring Space file postdates published file', 
                         modmeta => 'Authoring Space metadata file postdates published file',
                         unpub => 'Resource is unpublished',
       );
   
     my $dirptr=16384; # Mask indicating a directory in stat.cmode.      my $dirptr=16384; # Mask indicating a directory in stat.cmode.
     unless ($env{'form.phase'} eq 'two') {      unless ($env{'form.phase'} eq 'two') {
 # ask user what they want  # ask user what they want
         $r->print(&Apache::lonhtmlcommon::row_closure()          $r->print(&Apache::lonhtmlcommon::row_closure()
                  .&Apache::lonhtmlcommon::row_title(&mt('Options'))                   .&Apache::lonhtmlcommon::row_title(&mt('Options')
         );                   .&Apache::loncommon::help_open_topic('Publishing_Directory_Options')));
         $r->print('<form name="pubdirpref" method="post">'.          $r->print(&hiddenfield('phase','two').
   &hiddenfield('phase','two').  
   &hiddenfield('filename',$env{'form.filename'}).    &hiddenfield('filename',$env{'form.filename'}).
   &checkbox('pubrec','include subdirectories').                    '<fieldset><legend>'.&mt('Recurse').'</legend>'.
   &checkbox('forcerepub','force republication of previously published files').                    &checkbox('pubrec','include subdirectories').
                   &checkbox('obsolete','make file(s) obsolete').                    '</fieldset>'.
   &checkbox('forceoverride','force directory level metadata over existing').                    '<fieldset><legend>'.&mt('Force').'</legend>'.
   '<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');                    &checkbox('forcerepub','force republication of previously published files').'<br />'.
                     &checkbox('forceoverride','force directory level metadata over existing').
                     '</fieldset>'.
                     '<fieldset><legend>'.&mt('Exclude').'</legend>'.
                     &checkbox('excludeunpub','exclude currently unpublished files').'<br />'.
                     &checkbox('excludemod','exclude modified files').'<br />'.
                     &checkbox('excludemodmeta','exclude files with modified metadata').
                     '</fieldset>'.
                     '<fieldset><legend>'.&mt('Actions').'</legend>'.
                     &checkbox('obsolete','make file(s) obsolete').'<br />');
           unless ($crsauthor) {
               $r->print(&common_access('dist',&mt('apply common copyright/distribution'),
                                        ['default','domain','public','custom']).'<br />');
           }
           $r->print(&common_access('source',&mt('apply common source availability'),
                                    ['closed','open']).
                     '</fieldset>'
           );
         $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 {
         $r->print(&Apache::lonhtmlcommon::row_closure(1)          $r->print(&Apache::lonhtmlcommon::row_closure(1)
                  .&Apache::lonhtmlcommon::end_pick_box()                   .&Apache::lonhtmlcommon::end_pick_box()
         );          );
           my %commonaccess;
           map { $commonaccess{$_} = 1; } &Apache::loncommon::get_env_multiple('form.commonaccess');
         unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); }          unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); }
 # actually publish things  # actually publish things
  opendir(DIR,$fn);   opendir(DIR,$fn);
Line 1925  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,$docroot.$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!~/\~$/)) {
 # find out publication status and/or exiting metadata  # find out publication status and/or existing metadata
  my $publishthis=0;   my $publishthis=0;
                   my $skipthis;
  if (-e $resdir.'/'.$filename) {   if (-e $resdir.'/'.$filename) {
     my ($rdev,$rino,$rmode,$rnlink,      my ($rdev,$rino,$rmode,$rnlink,
  $ruid,$rgid,$rrdev,$rsize,   $ruid,$rgid,$rrdev,$rsize,
Line 1938  sub publishdirectory { Line 2377  sub publishdirectory {
  $rblksize,$rblocks)=stat($resdir.'/'.$filename);   $rblksize,$rblocks)=stat($resdir.'/'.$filename);
     if (($rmtime<$cmtime) || ($env{'form.forcerepub'})) {      if (($rmtime<$cmtime) || ($env{'form.forcerepub'})) {
 # previously published, modified now  # previously published, modified now
  $publishthis=1;                          if ($env{'form.excludemod'}) {
     }                              $skipthis='mod';
     my $meta_cmtime = (stat($fn.'/'.$filename.'.meta'))[9];                          } else {
     my $meta_rmtime = (stat($resdir.'/'.$filename.'.meta'))[9];                              $publishthis=1;
     if ( $meta_rmtime<$meta_cmtime ) {                          }
  $publishthis=1;  
     }      }
                       unless ($skipthis) {
                           my $meta_cmtime = (stat($fn.'/'.$filename.'.meta'))[9];
                           my $meta_rmtime = (stat($resdir.'/'.$filename.'.meta'))[9];
                           if ( $meta_rmtime<$meta_cmtime ) {
                               if ($env{'form.excludemodmeta'}) {
                                   $skipthis='modmeta';
                                   $publishthis=0; 
                               } else {
                                   $publishthis=1;
                               }
                           } else {
                               unless (&Apache::loncommon::fileembstyle($extension) eq 'prv') {
                                   if ($commonaccess{'dist'}) {
                                       my ($currdist,$currdistfile,$currsourceavail);
                                       my $currdist =  &Apache::lonnet::metadata($thisdisresdir.'/'.$filename,'copyright');
                                       if ($currdist eq 'custom') {
                                           $currdistfile =  &Apache::lonnet::metadata($thisdisresdir.'/'.$filename,'customdistributionfile');
                                       }
                                       if ($env{'form.commondistselect'} eq 'custom') {
                                           if ($env{'form.commoncustomrights'} =~ m{^/res/.+\.rights$}) {
                                               if ($currdist eq 'custom') {
                                                   unless ($env{'form.commoncustomrights'} eq $currdistfile) {
                                                       $publishthis=1;
                                                   }
                                               } else {
                                                   $publishthis=1;
                                               }
                                           }
                                       } elsif ($env{'form.commondistselect'} =~ /^default|domain|public$/) {
                                           unless ($currdist eq $env{'form.commondistselect'}) {
                                               $publishthis=1;
                                           }
                                       }
                                   }
                               }
                           }
                       }
  } else {   } else {
 # never published  # never published
     $publishthis=1;                      if ($env{'form.excludeunpub'}) {
                           $skipthis='unpub';
                       } else {
                           $publishthis=1;
                       }
  }   }
   
  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 />');                      my $reason;
                       if ($skipthis) {
                           $reason = $reasons{$skipthis};
                       } else {
                           $reason = &mt('No changes needed to published resource or metadata');
                       }
                       $r->print('<br />'.&mt('Skipping').' '.$filename);
                       if ($reason) {
                           $r->print(' ('.$reason.')');
                       }
                       $r->print('<br />');
  }   }
  $r->rflush();   $r->rflush();
     }      }
Line 2014  sub defaultmetapublish { Line 2503  sub defaultmetapublish {
  $r->print($reply.'</p><br />');$r->rflush;   $r->print($reply.'</p><br />');$r->rflush;
     }      }
 # ------------------------------------------------------------------- Link back  # ------------------------------------------------------------------- Link back
     $r->print("<a href='".&Apache::lonnet::display($fn)."'>".&mt('Back to Metadata').'</a>');      $r->print("<a href='".&Apache::loncfile::display($fn)."'>".&mt('Back to Metadata').'</a>');
     $r->print(&Apache::loncommon::end_page());      $r->print(&Apache::loncommon::end_page());
     return OK;      return OK;
 }  }
Line 2078  sub handler { Line 2567  sub handler {
 # -------------------------------------------------------------- Check filename  # -------------------------------------------------------------- Check filename
   
     my $fn=&unescape($env{'form.filename'});      my $fn=&unescape($env{'form.filename'});
     ($cuname,$cudom)=&Apache::loncacc::constructaccess($fn);      ($cuname,$cudom)=&Apache::lonnet::constructaccess($fn);
 # ----------------------------------------------------- Do we have permissions?  # ----------------------------------------------------- Do we have permissions?
      unless (($cuname) && ($cudom)) {       unless (($cuname) && ($cudom)) {
        $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.         $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
Line 2113  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'  => 'Construction Space',          'text'  => $crumbtext,
         'href'  => &Apache::loncommon::authorspace(),          'href'  => $crumbhref,
     });      });
     &Apache::lonhtmlcommon::add_breadcrumb({      &Apache::lonhtmlcommon::add_breadcrumb({
         'text'  => 'Resource Publication',          'text'  => 'Resource Publication',
Line 2154  sub handler { Line 2632  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()) # FIXME crumbs broken?                    &Apache::loncommon::CSTR_pageheader($docroot.$fn))
     );      );
   
     my $thisdisfn=&HTML::Entities::encode($fn,'<>&"');      my $thisdisfn=&HTML::Entities::encode($fn,'<>&"');
     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('<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 2218  ENDCAPTION Line 2746  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 2237  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 2245  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 2253  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__
   
Line 2260  __END__ Line 2808  __END__
   
 =back  =back
   
 =back  
   
 =cut  =cut
   

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


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