Diff for /loncom/publisher/lonpublisher.pm between versions 1.177 and 1.288

version 1.177, 2004/07/07 21:23:31 version 1.288, 2013/12/01 21:50:30
Line 66  invocation by F<loncapa_apache.conf>: Line 66  invocation by F<loncapa_apache.conf>:
   
 =head1 OVERVIEW  =head1 OVERVIEW
   
 Authors can only write-access the C</~authorname/> space. They can  Authors can only write-access the C</priv/domain/authorname/> space. 
 copy resources into the resource area through the publication step,  They can copy resources into the resource area through the 
 and move them back through a recover step. Authors do not have direct  publication step, and move them back through a recover step. 
 write-access to their resource space.  Authors do not have direct write-access to their resource space.
   
 During the publication step, several events will be  During the publication step, several events will be
 triggered. Metadata is gathered, where a wizard manages default  triggered. Metadata is gathered, where a wizard manages default
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 118  use Apache::File; Line 116  use Apache::File;
 use File::Copy;  use File::Copy;
 use Apache::Constants qw(:common :http :methods);  use Apache::Constants qw(:common :http :methods);
 use HTML::LCParser;  use HTML::LCParser;
   use HTML::Entities;
   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();
   use Apache::lonhtmlcommon;
 use Apache::lonmysql;  use Apache::lonmysql;
 use Apache::lonlocal;  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);
   use LONCAPA qw(:DEFAULT :match);
    
   
 my %addid;  my %addid;
 my %nokey;  my %nokey;
Line 138  my $docroot; Line 140  my $docroot;
 my $cuname;  my $cuname;
 my $cudom;  my $cudom;
   
   my $registered_cleanup;
   my $modified_urls;
   
   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 178  sub metaeval { Line 187  sub metaeval {
  if ($token->[0] eq 'S') {   if ($token->[0] eq 'S') {
     my $entry=$token->[1];      my $entry=$token->[1];
     my $unikey=$entry;      my $unikey=$entry;
       next if ($entry =~ m/^(?:parameter|stores)_/);
     if (defined($token->[2]->{'package'})) {       if (defined($token->[2]->{'package'})) { 
  $unikey.='_package_'.$token->[2]->{'package'};   $unikey.="\0package\0".$token->[2]->{'package'};
     }       } 
     if (defined($token->[2]->{'part'})) {       if (defined($token->[2]->{'part'})) { 
  $unikey.='_'.$token->[2]->{'part'};    $unikey.="\0".$token->[2]->{'part'}; 
     }      }
     if (defined($token->[2]->{'id'})) {       if (defined($token->[2]->{'id'})) { 
  $unikey.='_'.$token->[2]->{'id'};   $unikey.="\0".$token->[2]->{'id'};
     }       } 
     if (defined($token->[2]->{'name'})) {       if (defined($token->[2]->{'name'})) { 
  $unikey.='_'.$token->[2]->{'name'};    $unikey.="\0".$token->[2]->{'name'}; 
     }      }
     foreach (@{$token->[3]}) {      foreach (@{$token->[3]}) {
  $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};   $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
Line 255  sub metaread { Line 265  sub metaread {
     my ($logfile,$fn,$prefix)=@_;      my ($logfile,$fn,$prefix)=@_;
     unless (-e $fn) {      unless (-e $fn) {
  print($logfile 'No file '.$fn."\n");   print($logfile 'No file '.$fn."\n");
         return '<br /><b>'.&mt('No file').':</b> <tt>'.          return '<p class="LC_warning">'
     &Apache::loncfile::display($fn).'</tt>';                .&mt('No file: [_1]',&Apache::loncfile::display($fn))
                 .'</p>';
     }      }
     print($logfile 'Processing '.$fn."\n");      print($logfile 'Processing '.$fn."\n");
     my $metastring;      my $metastring;
Line 265  sub metaread { Line 276  sub metaread {
  $metastring=join('',<$metafh>);   $metastring=join('',<$metafh>);
     }      }
     &metaeval($metastring,$prefix);      &metaeval($metastring,$prefix);
     return '<br /><b>'.&mt('Processed file').':</b> <tt>'.      return '<p class="LC_info">'
  &Apache::loncfile::display($fn).'</tt>';            .&mt('Processed file: [_1]',&Apache::loncfile::display($fn))
             .'</p>';
 }  }
   
 #########################################  #########################################
Line 275  sub metaread { Line 287  sub metaread {
 sub coursedependencies {  sub coursedependencies {
     my $url=&Apache::lonnet::declutter(shift);      my $url=&Apache::lonnet::declutter(shift);
     $url=~s/\.meta$//;      $url=~s/\.meta$//;
     my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);      my ($adomain,$aauthor)=($url=~ m{^($match_domain)/($match_username)/});
     my $regexp=$url;      my $regexp=quotemeta($url);
     $regexp=~s/(\W)/\\$1/g;  
     $regexp='___'.$regexp.'___course';      $regexp='___'.$regexp.'___course';
     my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,      my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
        $aauthor,$regexp);         $aauthor,$regexp);
Line 318  string which presents the form field (fo Line 329  string which presents the form field (fo
 #########################################  #########################################
 #########################################  #########################################
 sub textfield {  sub textfield {
     my ($title,$name,$value)=@_;      my ($title,$name,$value,$noline)=@_;
       $value=~s/^\s+//gs;
       $value=~s/\s+$//gs;
       $value=~s/\s+/ /gs;
       $title=&mt($title);
       $env{'form.'.$name}=$value;
       return "\n".&Apache::lonhtmlcommon::row_title($title)
              .'<input type="text" name="'.$name.'" size="80" value="'.$value.'" />'
              .&Apache::lonhtmlcommon::row_closure($noline);
   }
   
   sub text_with_browse_field {
       my ($title,$name,$value,$restriction,$noline)=@_;
     $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<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".      return "\n".&Apache::lonhtmlcommon::row_title($title)
            "</b></font></p><br />".            .'<input type="text" name="'.$name.'" size="80" value="'.$value.'" />'
            '<input type="text" name="'.$name.'" size=80 value="'.$value.'" />';            .'<br />'
     .'<a href="javascript:openbrowser(\'pubform\',\''.$name.'\',\''.$restriction.'\');">'
             .&mt('Select')
             .'</a>&nbsp;'
     .'<a href="javascript:opensearcher(\'pubform\',\''.$name.'\');">'
             .&mt('Search')
             .'</a>'
             .&Apache::lonhtmlcommon::row_closure($noline);
 }  }
   
 sub hiddenfield {  sub hiddenfield {
     my ($name,$value)=@_;      my ($name,$value)=@_;
     $ENV{'form.'.$name}=$value;      $env{'form.'.$name}=$value;
     return "\n".'<input type="hidden" name="'.$name.'" value="'.$value.'" />';      return "\n".'<input type="hidden" name="'.$name.'" value="'.$value.'" />';
 }  }
   
   sub checkbox {
       my ($name,$text)=@_;
       return "\n<br /><label><input type='checkbox' name='$name' /> ".
    &mt($text)."</label>";
   }
   
 sub selectbox {  sub selectbox {
     my ($title,$name,$value,$functionref,@idlist)=@_;      my ($title,$name,$value,$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)) {
  $ENV{'form.'.$name}=$value;   $env{'form.'.$name}=$value;
     } else {      } else {
  $ENV{'form.'.$name}=$idlist[0];   $env{'form.'.$name}=$idlist[0];
     }      }
     my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".      my $selout="\n".&Apache::lonhtmlcommon::row_title($title)
  '</b></font></p><br /><select name="'.$name.'">';                .'<select name="'.$name.'">';
     foreach (@idlist) {      foreach (@idlist) {
         $selout.='<option value=\''.$_.'\'';          $selout.='<option value="'.$_.'"';
         if ($_ eq $value) {          if ($_ eq $value) {
     $selout.=' selected>'.&{$functionref}($_).'</option>';      $selout.=' selected="selected"';
  }          }
         else {$selout.='>'.&{$functionref}($_).'</option>';}          $selout.='>'.&{$functionref}($_).'</option>';
     }      }
     return $selout.'</select>';      $selout.='</select>'.&Apache::lonhtmlcommon::row_closure();
       return $selout;
 }  }
   
 sub select_level_form {  sub select_level_form {
     my ($value,$name)=@_;      my ($value,$name)=@_;
     $ENV{'form.'.$name}=$value;      $env{'form.'.$name}=$value;
     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);
 }  }
 #########################################  #########################################
Line 383  sub urlfixup { Line 420  sub urlfixup {
     if ($url =~ /^mailto:/i) { return $url; }      if ($url =~ /^mailto:/i) { return $url; }
     #internal document links need no fixing      #internal document links need no fixing
     if ($url =~ /^\#/) { return $url; }       if ($url =~ /^\#/) { return $url; } 
     my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);      my ($host)=($url=~m{(?:(?:http|https|ftp)://)*([^/]+)});
     foreach (values %Apache::lonnet::hostname) {      my @lonids = &Apache::lonnet::machine_ids($host);
  if ($_ eq $host) {      if (@lonids) {
     $url=~s/^http\:\/\///;   $url=~s{^(?:http|https|ftp)://}{};
             $url=~s/^$host//;   $url=~s/^\Q$host\E//;
         }  
     }      }
     if ($url=~/^http\:\/\//) { return $url; }      if ($url=~m{^(?:http|https|ftp)://}) { return $url; }
     $url=~s/\~$cuname/res\/$cudom\/$cuname/;      $url=~s{\Q~$cuname\E}{res/$cudom/$cuname};
     return $url;      return $url;
 }  }
   
Line 442  sub set_allow { Line 478  sub set_allow {
     }      }
     if (($newurl !~ /^javascript:/i) &&      if (($newurl !~ /^javascript:/i) &&
  ($newurl !~ /^mailto:/i) &&   ($newurl !~ /^mailto:/i) &&
  ($newurl !~ /^http:/i) &&   ($newurl !~ /^(?:http|https|ftp):/i) &&
  ($newurl !~ /^\#/)) {   ($newurl !~ /^\#/)) {
  $$allow{&absoluteurl($newurl,$target)}=1;   $$allow{&absoluteurl($newurl,$target)}=1;
     }      }
     return $return_url      return $return_url;
 }  }
   
 #########################################  #########################################
Line 469  sub get_subscribed_hosts { Line 505  sub get_subscribed_hosts {
     $target=~/(.*)\/([^\/]+)$/;      $target=~/(.*)\/([^\/]+)$/;
     my $srcf=$2;      my $srcf=$2;
     opendir(DIR,$1);      opendir(DIR,$1);
       # cycle through listed files, subscriptions used to exist
       # as "filename.lonid"
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
  if ($filename=~/\Q$srcf\E\.(\w+)$/) {   if ($filename=~/\Q$srcf\E\.($match_lonid)$/) {
     my $subhost=$1;      my $subhost=$1;
     if (($subhost ne 'meta' && $subhost ne 'subscription') &&      if (($subhost ne 'meta' 
    && $subhost ne 'subscription' 
    && $subhost ne 'meta.subscription'
    && $subhost ne 'tmp') &&
                 ($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) {                  ($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) {
  push(@subscribed,$subhost);   push(@subscribed,$subhost);
     }      }
Line 481  sub get_subscribed_hosts { Line 522  sub get_subscribed_hosts {
     closedir(DIR);      closedir(DIR);
     my $sh;      my $sh;
     if ( $sh=Apache::File->new("$target.subscription") ) {      if ( $sh=Apache::File->new("$target.subscription") ) {
  &Apache::lonnet::logthis("opened $target.subscription");  
  while (my $subline=<$sh>) {   while (my $subline=<$sh>) {
     &Apache::lonnet::logthis("Trying $subline");      if ($subline =~ /^($match_lonid):/) { 
     if ($subline =~ /(^\w+):/) {   
                 if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) {                   if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) { 
                    push(@subscribed,$1);                     push(@subscribed,$1);
         }          }
             } else {  
  &Apache::lonnet::logthis("No Match for $subline");  
     }      }
  }   }
     } else {  
  &Apache::lonnet::logthis("Unable to open $target.subscription");  
     }      }
     return @subscribed;      return @subscribed;
 }  }
Line 523  sub get_max_ids_indices { Line 558  sub get_max_ids_indices {
     my %duplicatedids;      my %duplicatedids;
   
     my $parser=HTML::LCParser->new($content);      my $parser=HTML::LCParser->new($content);
       $parser->xml_mode(1);
     my $token;      my $token;
     while ($token=$parser->get_token) {      while ($token=$parser->get_token) {
  if ($token->[0] eq 'S') {   if ($token->[0] eq 'S') {
     my $counter;      my $counter;
     if ($counter=$addid{$token->[1]}) {      if ($counter=$addid{$token->[1]}) {
  if ($counter eq 'id') {   if ($counter eq 'id') {
     if (defined($token->[2]->{'id'})) {      if (defined($token->[2]->{'id'}) &&
    $token->[2]->{'id'} !~ /^\s*$/) {
  $maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;   $maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
  if (exists($allids{$token->[2]->{'id'}})) {   if (exists($allids{$token->[2]->{'id'}})) {
     $duplicateids=1;      $duplicateids=1;
Line 541  sub get_max_ids_indices { Line 578  sub get_max_ids_indices {
  $needsfixup=1;   $needsfixup=1;
     }      }
  } else {   } else {
     if (defined($token->[2]->{'index'})) {      if (defined($token->[2]->{'index'}) &&
    $token->[2]->{'index'} !~ /^\s*$/) {
  $maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;   $maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
     } else {      } else {
  $needsfixup=1;   $needsfixup=1;
Line 627  sub fix_ids_and_indices { Line 665  sub fix_ids_and_indices {
    join(', ',@duplicatedids));     join(', ',@duplicatedids));
     if ($duplicateids) {      if ($duplicateids) {
  print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n";   print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n";
  my $outstring='<font color="red">'.&mt('Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are').': '.join(', ',@duplicatedids).'</font>';   my $outstring='<span class="LC_error">'.&mt('Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are').': '.join(', ',@duplicatedids).'</span>';
  return ($outstring,1);   return ($outstring,1);
     }      }
     if ($needsfixup) {      if ($needsfixup) {
Line 636  sub fix_ids_and_indices { Line 674  sub fix_ids_and_indices {
                 "Max Index: $maxindex (min 10)\n";                  "Max Index: $maxindex (min 10)\n";
     }      }
     my $outstring='';      my $outstring='';
       my $responsecounter=1;
     my @parser;      my @parser;
     $parser[0]=HTML::LCParser->new(\$content);      $parser[0]=HTML::LCParser->new(\$content);
     $parser[-1]->xml_mode(1);      $parser[-1]->xml_mode(1);
Line 650  sub fix_ids_and_indices { Line 689  sub fix_ids_and_indices {
     $allow{$token->[2]->{'src'}}=1;      $allow{$token->[2]->{'src'}}=1;
     next;      next;
  }   }
    if ($lctag eq 'base') { next; }
                   if (($lctag eq 'part') || ($lctag eq 'problem')) {
                       $responsecounter=0;
                   }
                   if ($lctag=~/response$/) { $responsecounter++; }
                   if ($lctag eq 'import') { $responsecounter++; }
  my %parms=%{$token->[2]};   my %parms=%{$token->[2]};
  $counter=$addid{$tag};   $counter=$addid{$tag};
  if (!$counter) { $counter=$addid{$lctag}; }   if (!$counter) { $counter=$addid{$lctag}; }
  if ($counter) {   if ($counter) {
     if ($counter eq 'id') {      if ($counter eq 'id') {
  unless (defined($parms{'id'})) {   unless (defined($parms{'id'}) &&
    $parms{'id'}!~/^\s*$/) {
     $maxid++;      $maxid++;
     $parms{'id'}=$maxid;      $parms{'id'}=$maxid;
     print $logfile 'ID: '.$tag.':'.$maxid."\n";      print $logfile 'ID(new) : '.$tag.':'.$maxid."\n";
    } else {
       print $logfile 'ID(kept): '.$tag.':'.$parms{'id'}."\n";
  }   }
     } elsif ($counter eq 'index') {      } elsif ($counter eq 'index') {
  unless (defined($parms{'index'})) {   unless (defined($parms{'index'}) &&
    $parms{'index'}!~/^\s*$/) {
     $maxindex++;      $maxindex++;
     $parms{'index'}=$maxindex;      $parms{'index'}=$maxindex;
     print $logfile 'Index: '.$tag.':'.$maxindex."\n";      print $logfile 'Index: '.$tag.':'.$maxindex."\n";
  }   }
     }      }
  }   }
  foreach my $type ('src','href','background','bgimg') {                  unless ($parms{'type'} eq 'zombie') {
     foreach my $key (keys(%parms)) {      foreach my $type ('src','href','background','bgimg') {
  if ($key =~ /^$type$/i) {   foreach my $key (keys(%parms)) {
     $parms{$key}=&set_allow(\%allow,$logfile,      if ($key =~ /^$type$/i) {
     $target,$tag,   $parms{$key}=&set_allow(\%allow,$logfile,
     $parms{$key});   $target,$tag,
    $parms{$key});
       }
  }   }
     }      }
  }   }
Line 684  sub fix_ids_and_indices { Line 735  sub fix_ids_and_indices {
     ($lctag eq 'image')) {      ($lctag eq 'image')) {
     my $next_token=$parser[-1]->get_token();      my $next_token=$parser[-1]->get_token();
     if ($next_token->[0] eq 'T') {      if ($next_token->[0] eq 'T') {
                           $next_token->[1] =~ s/[\n\r\f]+//g;
  $next_token->[1]=&set_allow(\%allow,$logfile,   $next_token->[1]=&set_allow(\%allow,$logfile,
     $target,$tag,      $target,$tag,
     $next_token->[1]);      $next_token->[1]);
Line 738  sub fix_ids_and_indices { Line 790  sub fix_ids_and_indices {
  }   }
  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'    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;
                                                   }
                                               } 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;
                                                   }
                                               }
                                           }
                                       }
                                   }
                               }
                           }
                           $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') {
  $outstring.='</'.$token->[1].'>';   $outstring.='</'.$token->[1].'>';
     }      }
  }                  }
                   if ((($token->[1] eq 'part') || ($token->[1] eq 'problem'))
                       && (!$responsecounter)) {
                       my $outstring='<span class="LC_error">'.&mt('Found [_1] without responses. This resource cannot be published.',$token->[1]).'</span>';
                       return ($outstring,1);
                   }
     } else {      } else {
  $outstring.=$token->[1];   $outstring.=$token->[1];
     }      }
Line 790  sub store_metadata { Line 892  sub store_metadata {
     # Determine if the table exists      # Determine if the table exists
     my $status = &Apache::lonmysql::check_table('metadata');      my $status = &Apache::lonmysql::check_table('metadata');
     if (! defined($status)) {      if (! defined($status)) {
         $error='<font color="red">WARNING: Cannot connect to '.          $error='<span class="LC_error">'
             'database!</font>';                .&mt('WARNING: Cannot connect to database!')
                 .'</span>';
         &Apache::lonnet::logthis($error);          &Apache::lonnet::logthis($error);
         return ($error,undef);          return ($error,undef);
     }      }
     if ($status == 0) {      if ($status == 0) {
         # It would be nice to actually create the table....          # It would be nice to actually create the table....
         $error ='<font color="red">WARNING: The metadata table does not '.          $error ='<span class="LC_error">'
             'exist in the LON-CAPA database.</font>';                 .&mt('WARNING: The metadata table does not exist in the LON-CAPA database!')
                  .'</span>';
         &Apache::lonnet::logthis($error);          &Apache::lonnet::logthis($error);
         return ($error,undef);          return ($error,undef);
     }      }
     my $dbh = &Apache::lonmysql::get_dbh();      my $dbh = &Apache::lonmysql::get_dbh();
     if (($metadata{'obsolete'}) || ($metadata{'copyright'} eq 'priv') ||      if (($metadata{'obsolete'}) || ($metadata{'copyright'} eq 'priv')) {
  ($metadata{'copyright'} eq 'custom')) {  
         # remove this entry          # remove this entry
  $status=&LONCAPA::lonmetadata::delete_metadata($dbh,undef,   my $delitem = 'url = '.$dbh->quote($metadata{'url'});
                                                        $metadata{'url'});   $status = &LONCAPA::lonmetadata::delete_metadata($dbh,undef,$delitem);
                                                          
     } else {      } else {
         $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,          $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,undef,
                                                          \%metadata);                                                           \%metadata);
     }      }
     if (defined($status) && $status ne '') {      if (defined($status) && $status ne '') {
         $error='<font color="red">Error occured storing new values in '.          $error='<span class="LC_error">'
             'metadata table in LON-CAPA database</font>';                .&mt('Error occurred saving new values in metadata table in LON-CAPA database!')
                 .'</span>';
         &Apache::lonnet::logthis($error);          &Apache::lonnet::logthis($error);
         &Apache::lonnet::logthis($status);          &Apache::lonnet::logthis($status);
         return ($error,undef);          return ($error,undef);
     }      }
     return (undef,$status);      return (undef,'success');
 }  }
   
   
   # ========================================== Parse file for errors and warnings
   
   sub checkonthis {
       my ($r,$source)=@_;
       my $uri=&Apache::lonnet::hreflocation($source);
       $uri=~s/\/$//;
       my $result=&Apache::lonnet::ssi_body($uri,
    ('grade_target'=>'web',
     'return_only_error_and_warning_counts' => 1));
       my ($errorcount,$warningcount)=split(':',$result);
       if (($errorcount) || ($warningcount)) {
           $r->print('<h3>'.&mt('Warnings and Errors').'</h3>');
           $r->print('<tt>'.$uri.'</tt>:');
           $r->print('<ul>');
           if ($warningcount) {
               $r->print('<li><div class="LC_warning">'
                        .&mt('[quant,_1,warning]',$warningcount)
                        .'</div></li>');
           }
           if ($errorcount) {
               $r->print('<li><div class="LC_error">'
                        .&mt('[quant,_1,error]',$errorcount)
                        .' <img src="/adm/lonMisc/bomb.gif" />'
                        .'</div></li>');
           }
           $r->print('</ul>');
       } else {
    #$r->print('<font color="green">'.&mt('ok').'</font>');
       }
       $r->rflush();
       return ($warningcount,$errorcount);
   }
   
 # ============================================== Parse file itself for metadata  # ============================================== Parse file itself for metadata
 #  #
 # parses a file with target meta, sets global %metadatafields %metadatakeys   # parses a file with target meta, sets global %metadatafields %metadatakeys 
Line 854  backup copies, performs any automatic pr Line 992  backup copies, performs any automatic pr
 especially for rat and ssi files),  especially for rat and ssi files),
   
 Returns a 2 element array, the first is the string to be shown to the  Returns a 2 element array, the first is the string to be shown to the
 user, the second is an error code, either 1 (an error occured) or 0  user, the second is an error code, either 1 (an error occurred) or 0
 (no error occurred)  (no error occurred)
   
 I<Additional documentation needed.>  I<Additional documentation needed.>
Line 873  sub publish { Line 1011  sub publish {
     my %allow=();      my %allow=();
   
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
  return ('<font color="red">'.&mt('No write permission to user directory, FAIL').'</font>',1);   return ('<span class="LC_error">'.&mt('No write permission to user directory, FAIL').'</span>',1);
     }      }
     print $logfile       print $logfile 
 "\n\n================= Publish ".localtime()." Phase One  ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n";  "\n\n================= Publish ".localtime()." Phase One  ================\n".$env{'user.name'}.':'.$env{'user.domain'}."\n";
   
     if (($style eq 'ssi') || ($style eq 'rat') || ($style eq 'prv')) {      if (($style eq 'ssi') || ($style eq 'rat') || ($style eq 'prv')) {
 # ------------------------------------------------------- This needs processing  # ------------------------------------------------------- This needs processing
Line 887  sub publish { Line 1025  sub publish {
     print $logfile "Copied original file to ".$copyfile."\n";      print $logfile "Copied original file to ".$copyfile."\n";
         } else {          } else {
     print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";      print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";
     return ("<font color=\"red\">Failed to write backup copy, $!,FAIL</font>",1);      return ("<span class=\"LC_error\">".&mt("Failed to write backup copy, [_1], FAIL",$1)."</span>",1);
         }          }
 # ------------------------------------------------------------- IDs and indices  # ------------------------------------------------------------- IDs and indices
   
Line 897  sub publish { Line 1035  sub publish {
  if ($error) { return ($outstring,$error); }   if ($error) { return ($outstring,$error); }
 # ------------------------------------------------------------ Construct Allows  # ------------------------------------------------------------ Construct Allows
           
  $scrout.='<h3>'.&mt('Dependencies').'</h3>';          my $outdep=''; # Collect dependencies output data
         my $allowstr='';          my $allowstr='';
         foreach (sort(keys(%allow))) {          foreach my $thisdep (sort(keys(%allow))) {
    my $thisdep=$_;  
    if ($thisdep !~ /[^\s]/) { next; }     if ($thisdep !~ /[^\s]/) { next; }
              if ($thisdep =~/\$/) {
                 $outdep.='<div class="LC_warning">'
                          .&mt('The resource depends on another resource with variable filename, i.e., [_1].','<tt>'.$thisdep.'</tt>').'<br />'
                          .&mt('You likely need to explicitly allow access to all possible dependencies using the [_1]-tag.','<tt>&lt;allow&gt;</tt>')
                          ."</div>\n";
              }
            unless ($style eq 'rat') {              unless ($style eq 'rat') { 
               $allowstr.="\n".'<allow src="'.$thisdep.'" />';                $allowstr.="\n".'<allow src="'.$thisdep.'" />';
    }     }
            $scrout.='<br />';            $outdep.='<div>';
            if ($thisdep!~/\*/ && $thisdep!~m|^/adm/|) {             if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) {
        $scrout.='<a href="'.$thisdep.'">';         $outdep.='<a href="'.$thisdep.'">';
            }             }
            $scrout.='<tt>'.$thisdep.'</tt>';             $outdep.='<tt>'.$thisdep.'</tt>';
            if ($thisdep!~/\*/ && $thisdep!~m|^/adm/|) {             if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) {
        $scrout.='</a>';         $outdep.='</a>';
                if (                 if (
        &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.         &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
                                             $thisdep.'.meta') eq '-1') {                                              $thisdep.'.meta') eq '-1') {
    $scrout.= ' - <font color="red">'.&mt('Currently not available').     $outdep.= ' - <span class="LC_error">'.&mt('Currently not available').
        '</font>';         '</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);
                    $thisdep=~/^\/res\/(\w+)\/(\w+)\//;                     $thisdep=~m{^/res/($match_domain)/($match_username)/};
                    if ((defined($1)) && (defined($2))) {                     if ((defined($1)) && (defined($2))) {
                       &Apache::lonnet::put('nohist_resevaldata',\%temphash,                        &Apache::lonnet::put('nohist_resevaldata',\%temphash,
    $1,$2);     $1,$2);
    }     }
        }         }
            }             }
              $outdep.='</div><br />';
           }
   
           if ($outdep) {
               $scrout.='<h3>'.&mt('Dependencies').'</h3>'
                       .$outdep
         }          }
         $outstring=~s/\n*(\<\/[^\>]+\>[^<]*)$/$allowstr\n$1\n/s;          $outstring=~s/\n*(\<\/[^\>]+\>[^<]*)$/$allowstr\n$1\n/s;
   
Line 937  sub publish { Line 1091  sub publish {
           my $org;            my $org;
           unless ($org=Apache::File->new('>'.$source)) {            unless ($org=Apache::File->new('>'.$source)) {
              print $logfile "No write permit to $source\n";               print $logfile "No write permit to $source\n";
              return ('<font color="red">'.&mt('No write permission to').               return ('<span class="LC_error">'.&mt('No write permission to').
      ' '.$source.       ' '.$source.
      ', '.&mt('FAIL').'</font>',1);       ', '.&mt('FAIL').'</span>',1);
   }    }
           print($org $outstring);            print($org $outstring);
         }          }
Line 957  sub publish { Line 1111  sub publish {
      my %oldparmstores=();       my %oldparmstores=();
             
     unless ($batch) {      unless ($batch) {
      $scrout.='<h3>'.&mt('Metadata Information').' ' .       $scrout.='<h3>'.&mt('Metadata').' ' .
        Apache::loncommon::help_open_topic("Metadata_Description")         &Apache::loncommon::help_open_topic("Metadata_Description")
        . '</h3>';         . '</h3>';
     }      }
   
 # ------------------------------------------------ First, check out environment  # ------------------------------------------------ First, check out environment
      unless (-e $source.'.meta') {       if ((!(-e $source.'.meta')) || ($env{'form.forceoverride'})) {
         $metadatafields{'author'}=$ENV{'environment.firstname'}.' '.          $metadatafields{'author'}=$env{'environment.firstname'}.' '.
                           $ENV{'environment.middlename'}.' '.                            $env{'environment.middlename'}.' '.
                   $ENV{'environment.lastname'}.' '.                    $env{'environment.lastname'}.' '.
                   $ENV{'environment.generation'};                    $env{'environment.generation'};
         $metadatafields{'author'}=~s/\s+/ /g;          $metadatafields{'author'}=~s/\s+/ /g;
         $metadatafields{'author'}=~s/\s+$//;          $metadatafields{'author'}=~s/\s+$//;
         $metadatafields{'owner'}=$cuname.'@'.$cudom;          $metadatafields{'owner'}=$cuname.':'.$cudom;
   
 # ------------------------------------------------ Check out directory hierachy  # ------------------------------------------------ Check out directory hierachy
   
         my $thisdisfn=$source;          my $thisdisfn=$source;
         $thisdisfn=~s/^\/home\/\Q$cuname\E\///;  
   
         my @urlparts=split(/\//,$thisdisfn);          $thisdisfn=~s/^\Q$docroot\E\/priv\/\Q$cudom\E\/\Q$cuname\E\///;
           my @urlparts=('.',split(/\//,$thisdisfn));
         $#urlparts--;          $#urlparts--;
   
         my $currentpath='/home/'.$cuname.'/';          my $currentpath=$docroot.'/priv/'.$cudom.'/'.$cuname.'/';
   
  my $prefix='../'x($#urlparts);   my $prefix='../'x($#urlparts);
         foreach (@urlparts) {          foreach my $subdir (@urlparts) {
     $currentpath.=$_.'/';      $currentpath.=$subdir.'/';
             $scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);              $scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);
     $prefix=~s|^\.\./||;      $prefix=~s|^\.\./||;
         }          }
   
 # ----------------------------------------------------------- Parse file itself  # ----------------------------------------------------------- Parse file itself
 # read %metadatafields from file itself  # read %metadatafields from file itself
     
Line 1012  sub publish { Line 1167  sub publish {
  delete $metadatafields{$_};   delete $metadatafields{$_};
             }              }
         }          }
   # ------------------------------------------------------------- Save some stuff
           my %savemeta=();
           foreach ('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
           foreach (keys %savemeta) {
       $metadatafields{$_}=$savemeta{$_};
    }
    }     }
   
                 
Line 1026  sub publish { Line 1189  sub publish {
  if (($_=~/^parameter/) || ($_=~/^stores/)) {   if (($_=~/^parameter/) || ($_=~/^stores/)) {
     unless ($_=~/\.\w+$/) {       unless ($_=~/\.\w+$/) { 
  unless ($oldparmstores{$_}) {   unless ($oldparmstores{$_}) {
     print $logfile 'New: '.$_."\n";      my $disp_key = $_;
     $chparms.=$_.' ';      $disp_key =~ tr/\0/_/;
       print $logfile ('New: '.$disp_key."\n");
       $chparms .= $disp_key.' ';
  }   }
     }      }
  }   }
     }      }
     if ($chparms) {      if ($chparms) {
  $scrout.='<p><b>'.&mt('New parameters or stored values').   $scrout.='<p><b>'.&mt('New parameters or saved values').
     ':</b> '.$chparms.'</p>';      ':</b> '.$chparms.'</p>';
     }      }
   
Line 1042  sub publish { Line 1207  sub publish {
  if (($_=~/^parameter/) || ($_=~/^stores/)) {   if (($_=~/^parameter/) || ($_=~/^stores/)) {
     unless (($metadatafields{$_.'.name'}) ||      unless (($metadatafields{$_.'.name'}) ||
     ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {      ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {
  print $logfile 'Obsolete: '.$_."\n";   my $disp_key = $_;
  $chparms.=$_.' ';   $disp_key =~ tr/\0/_/;
    print $logfile ('Obsolete: '.$disp_key."\n");
    $chparms.=$disp_key.' ';
     }      }
  }   }
     }      }
     if ($chparms) {      if ($chparms) {
  $scrout.='<p><b>'.&mt('Obsolete parameters or stored values').':</b> '.          $scrout.='<p><b>'.&mt('Obsolete parameters or saved values').':</b> '
     $chparms.'</p><h1><font color="red">'.&mt('Warning!').          .$chparms.'</p>'
     '</font></h1><p><font color="red" size="+1">'.                  .'<p class="LC_warning"><b>'.&mt('Warning!').'</b><br />'
     &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'</font></p><hr />';                  .&mt('If this resource is in active use, student performance data from the previous version may become inaccessible.')
                   .'</p><hr />';
       }
       if ($metadatafields{'copyright'} eq 'priv') {
           $scrout.='<p class="LC_warning"><b>'.&mt('Warning!').'</b><br />'
                   .&mt('Copyright/distribution option "Private" is no longer supported. Select another option from below. Consider "Custom Rights" for maximum control over the usage of your resource.')
                   .'</p><hr />';
     }      }
   
 # ------------------------------------------------------- Now have all metadata  # ------------------------------------------------------- Now have all metadata
Line 1063  sub publish { Line 1236  sub publish {
  $textonly=~s/\<script[^\<]+\<\/script\>//g;   $textonly=~s/\<script[^\<]+\<\/script\>//g;
  $textonly=~s/\<m\>[^\<]+\<\/m\>//g;   $textonly=~s/\<m\>[^\<]+\<\/m\>//g;
  $textonly=~s/\<[^\>]*\>//g;   $textonly=~s/\<[^\>]*\>//g;
  $textonly=~tr/A-Z/a-z/;  
  $textonly=~s/[\$\&][a-z]\w*//g;  
  $textonly=~s/[^a-z\s]//g;  
   
  foreach ($textonly=~m/(\w+)/g) {  
     unless ($nokey{$_}) {  
  $keywords{$_}=1;  
     }   
  }  
     }  
   
           #this is a work simplification for german authors for present
           $textonly=HTML::Entities::decode($textonly);           #decode HTML-character
           $textonly=Encode::Encoder::encode('utf8', $textonly);  #encode to perl internal unicode
           $textonly=~tr/A-ZÜÄÖ/a-züäö/;      #add lowercase rule for german "Umlaute"
           $textonly=~s/[\$\&][a-z]\w*//g;
           $textonly=~s/[^a-z^ü^ä^ö^ß\s]//g;  #dont delete german "Umlaute"
   
           foreach ($textonly=~m/[^\s]+/g) {  #match all but whitespaces
               unless ($nokey{$_}) {
                   $keywords{$_}=1;
               }
           }
   
   
       }
                           
     foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {      foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {
  $addkey=~s/\s+/ /g;   $addkey=~s/\s+/ /g;
Line 1088  sub publish { Line 1266  sub publish {
 # interactive mode html goes into $intr_scrout  # interactive mode html goes into $intr_scrout
 # batch mode throws away this HTML  # batch mode throws away this HTML
 # additionally all of the field functions have a by product of setting  # additionally all of the field functions have a by product of setting
 #   $ENV{'from.'..} so that it can be used by the phase two handler in  #   $env{'from.'..} so that it can be used by the phase two handler in
 #    batch mode  #    batch mode
   
     my $intr_scrout.=      my $intr_scrout.='<br />'
  '<form name="pubform" action="/adm/publish" method="post">'.                      .'<form name="pubform" action="/adm/publish" method="post">';
  '<p><input type="submit" value="'.&mt('Finalize Publication').'" /></p>'.      unless ($env{'form.makeobsolete'}) {
          $intr_scrout.='<p class="LC_warning">'
                       .&mt('Searching for your resource will be based on the following metadata. Please provide as much data as possible.')
                       .'</p>'
                       .'<p><input type="submit" value="'
                       .&mt('Finalize Publication')
                       .'" /> <a href="'.&Apache::loncfile::url($source).'">'.&mt('Cancel').'</a></p>';
       }
       $intr_scrout.=&Apache::lonhtmlcommon::start_pick_box();
       $intr_scrout.=
  &hiddenfield('phase','two').   &hiddenfield('phase','two').
  &hiddenfield('filename',$ENV{'form.filename'}).   &hiddenfield('filename',$env{'form.filename'}).
  &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).   &hiddenfield('allmeta',&escape($allmeta)).
  &hiddenfield('dependencies',join(',',keys %allow)).   &hiddenfield('dependencies',join(',',keys %allow));
       unless ($env{'form.makeobsolete'}) {
          $intr_scrout.=
  &textfield('Title','title',$metadatafields{'title'}).   &textfield('Title','title',$metadatafields{'title'}).
  &textfield('Author(s)','author',$metadatafields{'author'}).   &textfield('Author(s)','author',$metadatafields{'author'}).
  &textfield('Subject','subject',$metadatafields{'subject'});   &textfield('Subject','subject',$metadatafields{'subject'});
    # --------------------------------------------------- Scan content for keywords
   
 # --------------------------------------------------- Scan content for keywords      my $keywords_help = &Apache::loncommon::help_open_topic("Publishing_Keywords");
   
     my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");  
     my $KEYWORDS=&mt('Keywords');  
     my $CheckAll=&mt('check all');  
     my $UncheckAll=&mt('uncheck all');  
     my $keywordout=<<"END";      my $keywordout=<<"END";
 <script>  <script>
 function checkAll(field) {  function checkAll(field) {
Line 1120  function uncheckAll(field) { Line 1305  function uncheckAll(field) {
         field[i].checked = false ;          field[i].checked = false ;
 }  }
 </script>  </script>
 <p><font color="#800000" face="helvetica"><b>$KEYWORDS:</b></font>  
  $keywords_help</b>  
 <input type="button" value="$CheckAll" onclick="javascript:checkAll(document.pubform.keywords)" />   
 <input type="button" value="$UncheckAll" onclick="javascript:uncheckAll(document.pubform.keywords)" />   
 </p>  
 <br />  
 END  END
     $keywordout.='<table border="2"><tr>';      $keywordout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Keywords'))
                   .$keywords_help
                   .'<input type="button" value="'.&mt('check all').'" onclick="javascript:checkAll(document.pubform.keywords)" />'
                   .'<input type="button" value="'.&mt('uncheck all').'" onclick="javascript:uncheckAll(document.pubform.keywords)" />'
                   .'</p><br />'
                   .&Apache::loncommon::start_data_table();
       my $cols_per_row = 10;
     my $colcount=0;      my $colcount=0;
       my $wordcount=0;
       my $numkeywords = scalar(keys(%keywords));
   
     foreach (sort keys %keywords) {      foreach my $word (sort(keys(%keywords))) {
  $keywordout.='<td><input type="checkbox" name="keywords" value="'.$_.'"';          if ($colcount == 0) {
  if ($metadatafields{'keywords'}) {              $keywordout .= &Apache::loncommon::start_data_table_row();
     if ($metadatafields{'keywords'}=~/\Q$_\E/) {          }
  $keywordout.=' checked="on"';          $colcount++;
  $ENV{'form.keywords'}.=$_.',';          $wordcount++;
     }          if (($wordcount == $numkeywords) && ($colcount < $cols_per_row)) {
  } elsif (&Apache::loncommon::keyword($_)) {              my $colspan = 1+$cols_per_row-$colcount;
     $keywordout.=' checked="on"';              $keywordout .= '<td colspan="'.$colspan.'">';
     $ENV{'form.keywords'}.=$_.',';          } else {
  }              $keywordout .= '<td>';
  $keywordout.=' />'.$_.'</td>';          }
  if ($colcount>10) {          $keywordout.='<label><input type="checkbox" name="keywords" value="'.$word.'"';
     $keywordout.="</tr><tr>\n";          if ($metadatafields{'keywords'}) {
     $colcount=0;              if ($metadatafields{'keywords'}=~/\Q$word\E/) {
  }                  $keywordout.=' checked="checked"';
  $colcount++;                  $env{'form.keywords'}.=$word.',';
               }
           } elsif (&Apache::loncommon::keyword($word)) {
               $keywordout.=' checked="checked"';
               $env{'form.keywords'}.=$word.',';
           }
           $keywordout.=' />'.$word.'</label></td>';
           if ($colcount == $cols_per_row) {
               $keywordout.=&Apache::loncommon::end_data_table_row();
               $colcount=0;
           }
       }
       if ($colcount > 0) {
           $keywordout .= &Apache::loncommon::end_data_table_row();
     }      }
     $ENV{'form.keywords'}=~s/\,$//;  
   
     $keywordout.='</tr></table>';      $env{'form.keywords'}=~s/\,$//;
   
       $keywordout.=&Apache::loncommon::end_data_table_row()
                    .&Apache::loncommon::end_data_table()
                    .&Apache::lonhtmlcommon::row_closure();
   
     $intr_scrout.=$keywordout;      $intr_scrout.=$keywordout;
   
Line 1158  END Line 1361  END
   
     $intr_scrout.=&textfield('Notes','notes',$metadatafields{'notes'});      $intr_scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
   
     $intr_scrout.=      $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Abstract'))
  "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".&mt('Abstract').":".                   .'<textarea cols="80" rows="5" name="abstract">'
  "</b></font></p><br />".                   .$metadatafields{'abstract'}
  '<textarea cols="80" rows="5" name="abstract">'.                   .'</textarea>'
  $metadatafields{'abstract'}.'</textarea></p>';                   .&Apache::lonhtmlcommon::row_closure();
   
     $source=~/\.(\w+)$/;      $source=~/\.(\w+)$/;
   
       $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Grade Levels'))
                    .&mt('Lowest Grade Level:').'&nbsp;'
                    .&select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel')
   #                .&Apache::lonhtmlcommon::row_closure();
   #   $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Highest Grade Level'))
                    .' '.&mt('Highest Grade Level:').'&nbsp;'
                    .&select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel')
                    .&Apache::lonhtmlcommon::row_closure();
   
     $intr_scrout.=      $intr_scrout.=&textfield('Standards','standards',$metadatafields{'standards'});
  "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".  
  &mt('Lowest Grade Level').':'.  
  "</b></font></p><br />".  
  &select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel').  
  "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".  
  &mt('Highest Grade Level').':'.  
  "</b></font></p><br />".  
  &select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel').  
  &textfield('Standards','standards',$metadatafields{'standards'});  
   
   
   
   
     $intr_scrout.=&hiddenfield('mime',$1);      $intr_scrout.=&hiddenfield('mime',$1);
   
Line 1202  END Line 1401  END
   
     $intr_scrout.=&hiddenfield('lastrevisiondate',time);      $intr_scrout.=&hiddenfield('lastrevisiondate',time);
   
       my $pubowner_last;
       if ($style eq 'prv') {
           $pubowner_last = 1;
       }
     $intr_scrout.=&textfield('Publisher/Owner','owner',      $intr_scrout.=&textfield('Publisher/Owner','owner',
      $metadatafields{'owner'});       $metadatafields{'owner'},$pubowner_last);
   
 # ---------------------------------------------- Retrofix for unused copyright  # ---------------------------------------------- Retrofix for unused copyright
     if ($metadatafields{'copyright'} eq 'free') {      if ($metadatafields{'copyright'} eq 'free') {
  $metadatafields{'copyright'}='default';   $metadatafields{'copyright'}='default';
  $metadatafields{'sourceavail'}='open';   $metadatafields{'sourceavail'}='open';
     }      }
       if ($metadatafields{'copyright'} eq 'priv') {
           $metadatafields{'copyright'}='domain';
       }
 # ------------------------------------------------ Dial in reasonable defaults  # ------------------------------------------------ Dial in reasonable defaults
     my $defaultoption=$metadatafields{'copyright'};      my $defaultoption=$metadatafields{'copyright'};
     unless ($defaultoption) { $defaultoption='default'; }      unless ($defaultoption) { $defaultoption='default'; }
Line 1227  END Line 1432  END
     $intr_scrout.=&selectbox('Copyright/Distribution','copyright',      $intr_scrout.=&selectbox('Copyright/Distribution','copyright',
      $defaultoption,       $defaultoption,
      \&Apache::loncommon::copyrightdescription,       \&Apache::loncommon::copyrightdescription,
     (grep !/^public$/,(&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,
      \&Apache::loncommon::copyrightdescription,       \&Apache::loncommon::copyrightdescription,
      (&Apache::loncommon::copyrightids));       (grep !/^priv$/,(&Apache::loncommon::copyrightids)));
  }   }
  my $copyright_help =   my $copyright_help =
     Apache::loncommon::help_open_topic('Publishing_Copyright');      &Apache::loncommon::help_open_topic('Publishing_Copyright');
  $intr_scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;          my $replace=&mt('Copyright/Distribution:');
  $intr_scrout.=&textfield('Custom Distribution File','customdistributionfile',   $intr_scrout =~ s/$replace/$replace.' '.$copyright_help/ge;
  $metadatafields{'customdistributionfile'}).  
      $copyright_help;   $intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights');
  $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.=&textfield('Source Custom Distribution File','sourcerights',  # $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights');
   $metadatafields{'sourcerights'});  
  my $uctitle=&mt('Obsolete');   my $uctitle=&mt('Obsolete');
  $intr_scrout.=          my $obsolete_checked=($metadatafields{'obsolete'})?' checked="checked"':'';
     "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".          $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title($uctitle)
     '</b></font> <input type="checkbox" name="obsolete" ';                       .'<input type="checkbox" name="obsolete"'.$obsolete_checked.' />'
  if ($metadatafields{'obsolete'}) {                       .&Apache::lonhtmlcommon::row_closure(1);
     $intr_scrout.=' checked="1" ';          $intr_scrout.=&text_with_browse_field('Suggested Replacement for Obsolete File',
  }      'obsoletereplacement',
  $intr_scrout.='/ ></p>'.      $metadatafields{'obsoletereplacement'},'',1);
     &textfield('Suggested Replacement for Obsolete File',  
        'obsoletereplacement',  
        $metadatafields{'obsoletereplacement'});  
     } else {      } else {
  $intr_scrout.=&hiddenfield('copyright','private');   $intr_scrout.=&hiddenfield('copyright','private');
     }      }
      } else {
          $intr_scrout.=
    &hiddenfield('title',$metadatafields{'title'}).
    &hiddenfield('author',$metadatafields{'author'}).
    &hiddenfield('subject',$metadatafields{'subject'}).
    &hiddenfield('keywords',$metadatafields{'keywords'}).
    &hiddenfield('abstract',$metadatafields{'abstract'}).
    &hiddenfield('notes',$metadatafields{'notes'}).
    &hiddenfield('mime',$metadatafields{'mime'}).
    &hiddenfield('creationdate',$metadatafields{'creationdate'}).
    &hiddenfield('lastrevisiondate',time).
    &hiddenfield('owner',$metadatafields{'owner'}).
    &hiddenfield('lowestgradelevel',$metadatafields{'lowestgradelevel'}).
    &hiddenfield('standards',$metadatafields{'standards'}).
    &hiddenfield('highestgradelevel',$metadatafields{'highestgradelevel'}).
    &hiddenfield('language',$metadatafields{'language'}).
    &hiddenfield('copyright',$metadatafields{'copyright'}).
    &hiddenfield('sourceavail',$metadatafields{'sourceavail'}).
    &hiddenfield('customdistributionfile',$metadatafields{'customdistributionfile'}).
    &hiddenfield('obsolete',1).
    &text_with_browse_field('Suggested Replacement for Obsolete File',
       'obsoletereplacement',
       $metadatafields{'obsoletereplacement'},'',1);
      }
     if (!$batch) {      if (!$batch) {
  $scrout.=$intr_scrout.'<p><input type="submit" value="'.   $scrout.=$intr_scrout
     &mt('Finalize Publication').'" /></p></form>';              .&Apache::lonhtmlcommon::end_pick_box()
               .'<p><input type="submit" value="'
       .&mt($env{'form.makeobsolete'}?'Make Obsolete':'Finalize Publication')
               .'" /></p>'
               .'</form>';
     }      }
     return($scrout,0);      return($scrout,0);
 }  }
Line 1295  Returns: Line 1524  Returns:
   
 =over 4  =over 4
   
 =item Scalar string  =item integer
   
   0: fail
   1: success
   
 String contains status (errors and warnings) and information associated with  =back
 the server's attempts at publication.       
   
 =cut  =cut
   
Line 1310  sub phasetwo { Line 1541  sub phasetwo {
     my ($r,$source,$target,$style,$distarget,$batch)=@_;      my ($r,$source,$target,$style,$distarget,$batch)=@_;
     $source=~s/\/+/\//g;      $source=~s/\/+/\//g;
     $target=~s/\/+/\//g;      $target=~s/\/+/\//g;
   #
     if ($target=~/\_\_\_/) {  # Unless trying to get rid of something, check name validity
  $r->print(  #
  '<font color="red">'.&mt('Unsupported character combination').      unless ($env{'form.obsolete'}) {
   ' "<tt>___</tt>" '.&mt('in filename, FAIL').'</font>');   if ($target=~/(\_\_\_|\&\&\&|\:\:\:)/) {
         return 0;      $r->print('<span class="LC_error">'.
         &mt('Unsupported character combination [_1] in filename, FAIL.',"<tt>'.$1.'</tt>").
         '</span>');
       return 0;
    }
    unless ($target=~/\.(\w+)$/) {
       $r->print('<span class="LC_error">'.&mt('No valid extension found in filename, FAIL').'</span>');
       return 0;
    }
    if ($target=~/\.(\d+)\.(\w+)$/) {
       $r->print('<span class="LC_error">'.&mt('Filename of resource contains internal version number. Cannot publish such resources, FAIL').'</span>');
       return 0;
    }
     }      }
   
   #
   # End name check
   #
     $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(   $r->print(
         '<font color="red">'.          '<span class="LC_error">'.
  &mt('No write permission to user directory, FAIL').'</font>');   &mt('No write permission to user directory, FAIL').'</span>');
         return 0;          return 0;
     }      }
       
       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>');
       }
   
     print $logfile       print $logfile 
         "\n================= Publish ".localtime()." Phase Two  ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n";          "\n================= Publish ".localtime()." Phase Two  ================\n".$env{'user.name'}.':'.$env{'user.domain'}."\n";
           
     %metadatafields=();      %metadatafields=();
     %metadatakeys=();      %metadatakeys=();
   
     &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));      &metaeval(&unescape($env{'form.allmeta'}));
           
     $metadatafields{'title'}=$ENV{'form.title'};      $metadatafields{'title'}=$env{'form.title'};
     $metadatafields{'author'}=$ENV{'form.author'};      $metadatafields{'author'}=$env{'form.author'};
     $metadatafields{'subject'}=$ENV{'form.subject'};      $metadatafields{'subject'}=$env{'form.subject'};
     $metadatafields{'notes'}=$ENV{'form.notes'};      $metadatafields{'notes'}=$env{'form.notes'};
     $metadatafields{'abstract'}=$ENV{'form.abstract'};      $metadatafields{'abstract'}=$env{'form.abstract'};
     $metadatafields{'mime'}=$ENV{'form.mime'};      $metadatafields{'mime'}=$env{'form.mime'};
     $metadatafields{'language'}=$ENV{'form.language'};      $metadatafields{'language'}=$env{'form.language'};
     $metadatafields{'creationdate'}=$ENV{'form.creationdate'};      $metadatafields{'creationdate'}=$env{'form.creationdate'};
     $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};      $metadatafields{'lastrevisiondate'}=$env{'form.lastrevisiondate'};
     $metadatafields{'owner'}=$ENV{'form.owner'};      $metadatafields{'owner'}=$env{'form.owner'};
     $metadatafields{'copyright'}=$ENV{'form.copyright'};      $metadatafields{'copyright'}=$env{'form.copyright'};
     $metadatafields{'standards'}=$ENV{'form.standards'};      $metadatafields{'standards'}=$env{'form.standards'};
     $metadatafields{'lowestgradelevel'}=$ENV{'form.lowestgradelevel'};      $metadatafields{'lowestgradelevel'}=$env{'form.lowestgradelevel'};
     $metadatafields{'highestgradelevel'}=$ENV{'form.highestgradelevel'};      $metadatafields{'highestgradelevel'}=$env{'form.highestgradelevel'};
     $metadatafields{'customdistributionfile'}=      $metadatafields{'customdistributionfile'}=
                                  $ENV{'form.customdistributionfile'};                                   $env{'form.customdistributionfile'};
     $metadatafields{'sourceavail'}=$ENV{'form.sourceavail'};      $metadatafields{'sourceavail'}=$env{'form.sourceavail'};
     $metadatafields{'obsolete'}=$ENV{'form.obsolete'};      $metadatafields{'obsolete'}=$env{'form.obsolete'};
     $metadatafields{'obsoletereplacement'}=      $metadatafields{'obsoletereplacement'}=
                         $ENV{'form.obsoletereplacement'};                          $env{'form.obsoletereplacement'};
     $metadatafields{'dependencies'}=$ENV{'form.dependencies'};      $metadatafields{'dependencies'}=$env{'form.dependencies'};
     $metadatafields{'modifyinguser'}=$ENV{'user.name'}.'@'.      $metadatafields{'modifyinguser'}=$env{'user.name'}.':'.
                                  $ENV{'user.domain'};                                   $env{'user.domain'};
     $metadatafields{'authorspace'}=$cuname.'@'.$cudom;      $metadatafields{'authorspace'}=$cuname.':'.$cudom;
       $metadatafields{'domain'}=$cudom;
           
     my $allkeywords=$ENV{'form.addkey'};      my $allkeywords=$env{'form.addkey'};
     if (exists($ENV{'form.keywords'})) {      if (exists($env{'form.keywords'})) {
         if (ref($ENV{'form.keywords'})) {          if (ref($env{'form.keywords'})) {
             $allkeywords .= ','.join(',',@{$ENV{'form.keywords'}});              $allkeywords .= ','.join(',',@{$env{'form.keywords'}});
         } else {          } else {
             $allkeywords .= ','.$ENV{'form.keywords'};              $allkeywords .= ','.$env{'form.keywords'};
         }          }
     }      }
     $allkeywords=~s/[\"\']//g;      $allkeywords=~s/[\"\']//g;
Line 1377  sub phasetwo { Line 1630  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$/) {
             return               $r->print(
                 '<font color="red">'.&mt('No valid custom distribution rights file specified, FAIL').                  '<span class="LC_error">'.&mt('No valid custom distribution rights file specified, FAIL').
  '</font>';   '</span>');
       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')) {
             return               $r->print( 
                 '<font color="red">'.&mt('Could not write metadata, FAIL').                  '<span class="LC_error">'.&mt('Could not write metadata, FAIL').
  '</font>';   '</span>');
       return 0;
         }          }
         foreach (sort keys %metadatafields) {          foreach (sort keys %metadatafields) {
             unless ($_=~/\./) {              unless ($_=~/\./) {
Line 1437  sub phasetwo { Line 1692  sub phasetwo {
         my $srcf=$2;          my $srcf=$2;
         my $srct=$3;          my $srct=$3;
         my $srcd=$1;          my $srcd=$1;
         unless ($srcd=~/^\/home\/httpd\/html\/res/) {          my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'};
           unless ($srcd=~/^\Q$docroot\E\/res/) {
             print $logfile "\nPANIC: Target dir is ".$srcd;              print $logfile "\nPANIC: Target dir is ".$srcd;
             return "<font color=\"red\">Invalid target directory, FAIL</font>";              $r->print(
    "<span class=\"LC_error\">".&mt('Invalid target directory, FAIL')."</span>");
       return 0;
         }          }
         opendir(DIR,$srcd);          opendir(DIR,$srcd);
         while ($filename=readdir(DIR)) {          while ($filename=readdir(DIR)) {
Line 1447  sub phasetwo { Line 1705  sub phasetwo {
                 unlink($srcd.'/'.$filename);                  unlink($srcd.'/'.$filename);
                 unlink($srcd.'/'.$filename.'.meta');                  unlink($srcd.'/'.$filename.'.meta');
             } else {              } else {
                 if ($filename=~/\Q$srcf\E\.(\d+)\.\Q$srct\E$/) {                  if ($filename=~/^\Q$srcf\E\.(\d+)\.\Q$srct\E$/) {
                     $maxversion=($1>$maxversion)?$1:$maxversion;                      $maxversion=($1>$maxversion)?$1:$maxversion;
                 }                  }
             }              }
         }          }
         closedir(DIR);          closedir(DIR);
         $maxversion++;          $maxversion++;
         $r->print('<p>Creating old version '.$maxversion.'</p>');          $r->print('<p>'.&mt('Creating old version [_1]',$maxversion).'</p>');
         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('<p>'.&mt('Copied old target file').'</p>');              $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old target file')));
         } else {          } else {
     print $logfile "Unable to write ".$copyfile.':'.$!."\n";      print $logfile "Unable to write ".$copyfile.':'.$!."\n";
             return "<font color=\"red\">".&mt('Failed to copy old target').              $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1));
  ", $!, ".&mt('FAIL')."</font>";      return 0;
         }          }
                   
 # --------------------------------------------------------------- Copy Metadata  # --------------------------------------------------------------- Copy Metadata
Line 1474  sub phasetwo { Line 1732  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('<p>'.&mt('Copied old metadata').'</p>')              $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata')));
         } else {          } else {
     print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";      print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
             if (-e $target.'.meta') {              if (-e $target.'.meta') {
                 return                   $r->print(&Apache::lonhtmlcommon::confirm_success(
                     "<font color=\"red\">".                             &mt('Failed to write old metadata copy').", $!",1));
 &mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')."</font>";   return 0;
     }      }
         }          }
                   
Line 1501  sub phasetwo { Line 1759  sub phasetwo {
         $path.="/$parts[$count]";          $path.="/$parts[$count]";
         if ((-e $path)!=1) {          if ((-e $path)!=1) {
             print $logfile "\nCreating directory ".$path;              print $logfile "\nCreating directory ".$path;
             $r->print('<p>'.&mt('Created directory').' '.$parts[$count].'</p>');  
             mkdir($path,0777);              mkdir($path,0777);
               $r->print('<p>'
                        .&mt('Created directory [_1]'
                            ,'<span class="LC_filename">'.$parts[$count].'</span>')
                        .'</p>'
               );
         }          }
     }      }
           
     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('<p>'.&mt('Copied source file').'</p>');          $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied source file')));
     } else {      } else {
         print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";          print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
         return "<font color=\"red\">".          $r->print(&Apache::lonhtmlcommon::confirm_success(
     &mt('Failed to copy source').", $!, ".&mt('FAIL')."</font>";      &mt('Failed to copy source').", $!",1));
    return 0;
     }      }
           
   # ---------------------------------------------- Delete local tmp-preview files
       unlink($copyfile.'.tmp');
 # --------------------------------------------------------------- Copy Metadata  # --------------------------------------------------------------- Copy Metadata
   
     $copyfile=$copyfile.'.meta';      $copyfile=$copyfile.'.meta';
           
     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('<p>'.&mt('Copied metadata').'</p>');          $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied metadata')));
     } else {      } else {
         print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";          print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
         return           $r->print(&Apache::lonhtmlcommon::confirm_success(
             "<font color=\"red\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</font>";                    &mt('Failed to write metadata copy').", $!",1));
    return 0;
     }      }
     $r->rflush;      $r->rflush;
 # --------------------------------------------------- Send update notifications  
   
     my @subscribed=&get_subscribed_hosts($target);  # ------------------------------------------------------------- Trigger updates
     foreach my $subhost (@subscribed) {      push(@{$modified_urls},[$target,$source]);
  $r->print('<p>'.&mt('Notifying host').' '.$subhost.':');$r->rflush;      unless ($registered_cleanup) {
  print $logfile "\nNotifying host ".$subhost.':';          my $handlers = $r->get_handlers('PerlCleanupHandler');
  my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);          $r->set_handlers('PerlCleanupHandler' => [\&notify,@{$handlers}]);
  $r->print($reply.'</p><br />');$r->rflush;   $registered_cleanup=1;
  print $logfile $reply;  
     }      }
       
 # ---------------------------------------- Send update notifications, meta only  
   
     my @subscribedmeta=&get_subscribed_hosts("$target.meta");  # ---------------------------------------------------------- Clear local caches
     foreach my $subhost (@subscribedmeta) {      my $thisdistarget=$target;
  $r->print('<p>'.      $thisdistarget=~s/^\Q$docroot\E//;
 &mt('Notifying host for metadata only').' '.$subhost.':');$r->rflush;      &Apache::lonnet::devalidate_cache_new('resversion',$target);
  print $logfile "\nNotifying host for metadata only ".$subhost.':';      &Apache::lonnet::devalidate_cache_new('meta',
  my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',   &Apache::lonnet::declutter($thisdistarget));
     $subhost);  
  $r->print($reply.'</p><br />');$r->rflush;  # ------------------------------------------------------------- Everything done
  print $logfile $reply;      $logfile->close();
     }      $r->print('<p class="LC_success">'.&mt('Done').'</p>');
       
 # --------------------------------------------------- Notify subscribed courses  
     my %courses=&coursedependencies($target);  
     my $now=time;  
     foreach (keys %courses) {  
  $r->print('<p>'.&mt('Notifying course').' '.$_.':');$r->rflush;  
  print $logfile "\nNotifying host ".$_.':';  
         my ($cdom,$cname)=split(/\_/,$_);  
  my $reply=&Apache::lonnet::cput  
                   ('versionupdate',{$target => $now},$cdom,$cname);  
  $r->print($reply.'</p><br />');$r->rflush;  
  print $logfile $reply;  
     }  
 # ------------------------------------------------ Provide link to new resource  # ------------------------------------------------ Provide link to new resource
     unless ($batch) {      unless ($batch) {
         my $thisdistarget=$target;  
         $thisdistarget=~s/^\Q$docroot\E//;  
           
         my $thissrc=$source;  
         $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/;  
                   
           my $thissrc=&Apache::loncfile::url($source);
         my $thissrcdir=$thissrc;          my $thissrcdir=$thissrc;
         $thissrcdir=~s/\/[^\/]+$/\//;          $thissrcdir=~s/\/[^\/]+$/\//;
                   
           
         $r->print(          $r->print(
            '<hr /><a href="'.$thisdistarget.'"><font size="+2">'.              &Apache::lonhtmlcommon::actionbox([
            &mt('View Published Version').'</font></a>'.                  '<a href="'.$thisdistarget.'">'.
            '<p><a href="'.$thissrc.'"><font size=+2>'.                  &mt('View Published Version').
   &mt('Back to Source').'</font></a></p>'.                  '</a>',
            '<p><a href="'.$thissrcdir.                  '<a href="'.$thissrc.'">'.
                    '"><font size="+2">'.                  &mt('Back to Source').
   &mt('Back to Source Directory').'</font></a></p>');                  '</a>',
                   '<a href="'.$thissrcdir.'">'.
                   &mt('Back to Source Directory').
                   '</a>'])
           );
     }      }
     return '<p><font color="green">'.&mt('Done').'</font></p>';      return 1;
   }
   
   # =============================================================== Notifications
   sub notify {  
   # --------------------------------------------------- Send update notifications
       foreach my $targetsource (@{$modified_urls}){
    my ($target,$source)=@{$targetsource};
    my $logfile=Apache::File->new('>>'.$source.'.log');
    print $logfile "\nCleanup phase: Notifications\n";
    my @subscribed=&get_subscribed_hosts($target);
    foreach my $subhost (@subscribed) {
       print $logfile "\nNotifying host ".$subhost.':';
       my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
       print $logfile $reply;
    }
   # ---------------------------------------- Send update notifications, meta only
    my @subscribedmeta=&get_subscribed_hosts("$target.meta");
    foreach my $subhost (@subscribedmeta) {
       print $logfile "\nNotifying host for metadata only ".$subhost.':';
       my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
    $subhost);
       print $logfile $reply;
    } 
   # --------------------------------------------------- Notify subscribed courses
    my %courses=&coursedependencies($target);
    my $now=time;
    foreach (keys %courses) {
       print $logfile "\nNotifying course ".$_.':';
       my ($cdom,$cname)=split(/\_/,$_);
       my $reply=&Apache::lonnet::cput
    ('versionupdate',{$target => $now},$cdom,$cname);
       print $logfile $reply;
    }
    print $logfile "\n============ Done ============\n";
    $logfile->close();
       }
       if ($lock) { &Apache::lonnet::remove_lock($lock); }
       return OK;
 }  }
   
 #########################################  #########################################
   
 sub batchpublish {  sub batchpublish {
     my ($r,$srcfile,$targetfile)=@_;      my ($r,$srcfile,$targetfile)=@_;
     #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;
     my $thisdisfn=$srcfile;  
     $thisdisfn=~s/\/home\/korte\/public_html\///;  
     $srcfile=~s/\/+/\//g;      $srcfile=~s/\/+/\//g;
   
     my $docroot=$r->dir_config('lonDocRoot');      my $docroot=$r->dir_config('lonDocRoot');
Line 1613  sub batchpublish { Line 1898  sub batchpublish {
   
     my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);      my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
             
     $r->print('<h2>'.&mt('Publishing').' <tt>'.$thisdisfn.'</tt></h2>');      $r->print('<h2>'
                .&mt('Publishing [_1]',&Apache::loncfile::display($srcfile))
                .'</h2>'
       );
   
 # phase one takes  # phase one takes
 #  my ($source,$target,$style,$batch)=@_;  #  my ($source,$target,$style,$batch)=@_;
Line 1621  sub batchpublish { Line 1909  sub batchpublish {
     $r->print('<p>'.$outstring.'</p>');      $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>');   $r->print('<p>');
  &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);   &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
  $r->print('</p>');   $r->print('</p>');
     }      }
     %ENV=%oldENV;      %env=%oldenv;
     return '';      return '';
 }  }
   
Line 1637  sub publishdirectory { Line 1925  sub publishdirectory {
     my ($r,$fn,$thisdisfn)=@_;      my ($r,$fn,$thisdisfn)=@_;
     $fn=~s/\/+/\//g;      $fn=~s/\/+/\//g;
     $thisdisfn=~s/\/+/\//g;      $thisdisfn=~s/\/+/\//g;
     my $resdir=      my $thisdisresdir=$thisdisfn;
  $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'.      $thisdisresdir=~s/^\/priv\//\/res\//;
  $thisdisfn;      my $resdir = $r->dir_config('lonDocRoot').$thisdisresdir;
     $r->print('<h1>'.&mt('Directory').' <tt>'.$thisdisfn.'</tt></h1>'.      $r->print(&Apache::lonhtmlcommon::start_pick_box()
       &mt('Target').': <tt>'.$resdir.'</tt><br />');               .&Apache::lonhtmlcommon::row_title(&mt('Directory'))
               .'<span class="LC_filename">'.$thisdisfn.'</span>'
               .&Apache::lonhtmlcommon::row_closure()
               .&Apache::lonhtmlcommon::row_title(&mt('Target'))
               .'<span class="LC_filename">'.$thisdisresdir.'</span>'
       );
   
     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') {
     opendir(DIR,$fn);  # ask user what they want
     my @files=sort(readdir(DIR));          $r->print(&Apache::lonhtmlcommon::row_closure()
     foreach my $filename (@files) {                   .&Apache::lonhtmlcommon::row_title(&mt('Options'))
  my ($cdev,$cino,$cmode,$cnlink,          );
             $cuid,$cgid,$crdev,$csize,          $r->print('<form name="pubdirpref" method="post" action="">'.
             $catime,$cmtime,$cctime,    &hiddenfield('phase','two').
             $cblksize,$cblocks)=stat($fn.'/'.$filename);    &hiddenfield('filename',$env{'form.filename'}).
     &checkbox('pubrec','include subdirectories').
  my $extension='';    &checkbox('forcerepub','force republication of previously published files').
  if ($filename=~/\.(\w+)$/) { $extension=$1; }                    &checkbox('obsolete','make file(s) obsolete').
  if ($cmode&$dirptr) {    &checkbox('forceoverride','force directory level metadata over existing').
     if (($filename!~/^\./) && ($ENV{'form.pubrec'})) {    '<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');
  &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);          $r->print(&Apache::lonhtmlcommon::row_closure(1)
     }                   .&Apache::lonhtmlcommon::end_pick_box()
  } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&          );
  ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {          $lock=0;
       } else {
           $r->print(&Apache::lonhtmlcommon::row_closure(1)
                    .&Apache::lonhtmlcommon::end_pick_box()
           );
           unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); }
   # actually publish things
    opendir(DIR,$fn);
    my @files=sort(readdir(DIR));
    foreach my $filename (@files) {
       my ($cdev,$cino,$cmode,$cnlink,
    $cuid,$cgid,$crdev,$csize,
    $catime,$cmtime,$cctime,
    $cblksize,$cblocks)=stat($fn.'/'.$filename);
       
       my $extension='';
       if ($filename=~/\.(\w+)$/) { $extension=$1; }
       if ($cmode&$dirptr) {
    if (($filename!~/^\./) && ($env{'form.pubrec'})) {
       &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);
    }
       } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
        ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
 # find out publication status and/or exiting metadata  # find out publication status and/or exiting metadata
     my $publishthis=0;   my $publishthis=0;
     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,
     $ratime,$rmtime,$rctime,   $ratime,$rmtime,$rctime,
     $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;   $publishthis=1;
                 }      }
     } else {      my $meta_cmtime = (stat($fn.'/'.$filename.'.meta'))[9];
       my $meta_rmtime = (stat($resdir.'/'.$filename.'.meta'))[9];
       if ( $meta_rmtime<$meta_cmtime ) {
    $publishthis=1;
       }
    } else {
 # never published  # never published
  $publishthis=1;      $publishthis=1;
     }   }
     if ($publishthis) {  
                 &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);   if ($publishthis) {
     } else {      &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);
  $r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');   } else {
       $r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');
    }
    $r->rflush();
     }      }
     $r->rflush();  
  }   }
    closedir(DIR);
     }      }
     closedir(DIR);  
 }  }
   
 #########################################  #########################################
Line 1692  sub publishdirectory { Line 2014  sub publishdirectory {
   
 sub defaultmetapublish {  sub defaultmetapublish {
     my ($r,$fn,$cuname,$cudom)=@_;      my ($r,$fn,$cuname,$cudom)=@_;
     $fn=~s/^\/\~$cuname\//\/home\/$cuname\/public_html\//;  
     unless (-e $fn) {      unless (-e $fn) {
        return HTTP_NOT_FOUND;         return HTTP_NOT_FOUND;
     }      }
     my $target=$fn;      my $target=$fn;
     $target=~s/^\/home\/$cuname\/public_html\//$Apache::lonnet::perlvar{'lonDocRoot'}\/res\/$cudom\/$cuname\//;      $target=~s/^\Q$Apache::lonnet::perlvar{'lonDocRoot'}\E\/priv\//\Q$Apache::lonnet::perlvar{'lonDocRoot'}\E\/res\//;
   
   
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
     $r->send_http_header;      $r->send_http_header;
   
     $r->print('<html><head><title>LON-CAPA Publishing</title></head>');      $r->print(&Apache::loncommon::start_page('Metadata Publication'));
     $r->print(&Apache::loncommon::bodytag('Catalog Information Publication'));  
   
 # ---------------------------------------------------------------- Write Source  # ---------------------------------------------------------------- Write Source
     my $copyfile=$target;      my $copyfile=$target;
Line 1716  sub defaultmetapublish { Line 2036  sub defaultmetapublish {
     for ($count=5;$count<$#parts;$count++) {      for ($count=5;$count<$#parts;$count++) {
         $path.="/$parts[$count]";          $path.="/$parts[$count]";
         if ((-e $path)!=1) {          if ((-e $path)!=1) {
             $r->print('<p>'.&mt('Created directory').' '.$parts[$count].'</p>');  
             mkdir($path,0777);              mkdir($path,0777);
               $r->print('<p>'
                        .&mt('Created directory [_1]'
                            ,'<span class="LC_filename">'.$parts[$count].'</span>')
                        .'</p>'
               );
         }          }
     }      }
           
     if (copy($fn,$copyfile)) {      if (copy($fn,$copyfile)) {
         $r->print('<p>'.&mt('Copied source file').'</p>');          $r->print('<p>'.&mt('Copied source file').'</p>');
     } else {      } else {
         return "<font color=\"red\">".          return "<span class=\"LC_error\">".
     &mt('Failed to copy source').", $!, ".&mt('FAIL')."</font>";      &mt('Failed to copy source').", $!, ".&mt('FAIL')."</span>";
     }      }
   
 # --------------------------------------------------- Send update notifications  # --------------------------------------------------- Send update notifications
Line 1737  sub defaultmetapublish { Line 2061  sub defaultmetapublish {
  $r->print($reply.'</p><br />');$r->rflush;   $r->print($reply.'</p><br />');$r->rflush;
     }      }
 # ------------------------------------------------------------------- Link back  # ------------------------------------------------------------------- Link back
     my $link=$fn;      $r->print("<a href='".&Apache::loncfile::display($fn)."'>".&mt('Back to Metadata').'</a>');
     $link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//;      $r->print(&Apache::loncommon::end_page());
     $r->print("<a href='$link'>".&mt('Back to Catalog Information').'</a>');  
     $r->print('</body></html>');  
     return OK;      return OK;
 }  }
 #########################################  #########################################
Line 1797  sub handler { Line 2119  sub handler {
     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},      &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                                             ['filename']);                                              ['filename']);
   
   # -------------------------------------- Flag and buffer for registered cleanup
       $registered_cleanup=0;
       @{$modified_urls}=();
 # -------------------------------------------------------------- Check filename  # -------------------------------------------------------------- Check filename
   
     my $fn=&Apache::lonnet::unescape($ENV{'form.filename'});      my $fn=&unescape($env{'form.filename'});
       ($cuname,$cudom)=&Apache::lonnet::constructaccess($fn);
   # ----------------------------------------------------- Do we have permissions?
        unless (($cuname) && ($cudom)) {
          $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
                         ' trying to publish file '.$env{'form.filename'}.
                         ' - not authorized', 
                         $r->filename); 
          return HTTP_NOT_ACCEPTABLE;
        }
   # ----------------------------------------------------------------- Get docroot
       $docroot=$r->dir_config('lonDocRoot');
   
     ($cuname,$cudom)=  
  &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));  
   
 # special publication: default.meta file  # special publication: default.meta file
     if ($fn=~/\/default.meta$/) {      if ($fn=~/\/default.meta$/) {
  return &defaultmetapublish($r,$fn,$cuname,$cudom);    return &defaultmetapublish($r,$fn,$cuname,$cudom); 
     }      }
     $fn=~s/\.meta$//;      $fn=~s/\.meta$//;
     
   # sanity test on the filename 
    
     unless ($fn) {       unless ($fn) { 
  $r->log_reason($cuname.' at '.$cudom.   $r->log_reason($cuname.' at '.$cudom.
        ' trying to publish empty filename', $r->filename);          ' trying to publish empty filename', $r->filename); 
  return HTTP_NOT_FOUND;   return HTTP_NOT_FOUND;
     }       } 
   
     unless (($cuname) && ($cudom)) {      unless (-e $docroot.$fn) { 
  $r->log_reason($cuname.' at '.$cudom.  
        ' trying to publish file '.$ENV{'form.filename'}.  
        ' ('.$fn.') - not authorized',   
        $r->filename);   
  return HTTP_NOT_ACCEPTABLE;  
     }  
   
     my $home=&Apache::lonnet::homeserver($cuname,$cudom);  
     my $allowed=0;  
     my @ids=&Apache::lonnet::current_machine_ids();  
     foreach my $id (@ids) { if ($id eq $home) { $allowed = 1; }  }  
     unless ($allowed) {  
  $r->log_reason($cuname.' at '.$cudom.  
        ' trying to publish file '.$ENV{'form.filename'}.  
        ' ('.$fn.') - not homeserver ('.$home.')',   
        $r->filename);   
  return HTTP_NOT_ACCEPTABLE;  
     }  
   
     $fn=~s/^http\:\/\/[^\/]+//;  
     $fn=~s/^\/\~(\w+)/\/home\/$1\/public_html/;  
   
     my $targetdir='';  
     $docroot=$r->dir_config('lonDocRoot');   
     if ($1 ne $cuname) {  
  $r->log_reason($cuname.' at '.$cudom.  
        ' trying to publish unowned file '.  
        $ENV{'form.filename'}.' ('.$fn.')',   
        $r->filename);   
  return HTTP_NOT_ACCEPTABLE;  
     } else {  
  $targetdir=$docroot.'/res/'.$cudom;  
     }  
                                    
     
     unless (-e $fn) {   
  $r->log_reason($cuname.' at '.$cudom.   $r->log_reason($cuname.' at '.$cudom.
        ' trying to publish non-existing file '.         ' trying to publish non-existing file '.
        $ENV{'form.filename'}.' ('.$fn.')',          $env{'form.filename'}.' ('.$fn.')', 
        $r->filename);          $r->filename); 
  return HTTP_NOT_FOUND;   return HTTP_NOT_FOUND;
     }       } 
   
     unless ($ENV{'form.phase'} eq 'two') {  
   
 # -------------------------------- File is there and owned, init lookup tables.  # -------------------------------- File is there and owned, init lookup tables.
   
  %addid=();      %addid=();
       
  {      {
     my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');   my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
     while (<$fh>=~/(\w+)\s+(\w+)/) {   while (<$fh>=~/(\w+)\s+(\w+)/) {
  $addid{$1}=$2;      $addid{$1}=$2;
     }  
  }   }
       }
   
  %nokey=();      %nokey=();
   
  {      {
     my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');   my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
     while (<$fh>) {   while (<$fh>) {
  my $word=$_;      my $word=$_;
  chomp($word);      chomp($word);
  $nokey{$word}=1;      $nokey{$word}=1;
     }  
  }   }
   
     }      }
   
 # ---------------------------------------------------------- Start page output.  # ---------------------------------------------------------- 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;
       
     $r->print('<html><head><title>LON-CAPA Publishing</title></head>');      # Breadcrumbs
     $r->print(&Apache::loncommon::bodytag('Resource Publication'));      &Apache::lonhtmlcommon::clear_breadcrumbs();
       &Apache::lonhtmlcommon::add_breadcrumb({
           'text'  => 'Authoring Space',
     my $thisfn=$fn;          'href'  => &Apache::loncommon::authorspace($fn),
       });
     my $thistarget=$thisfn;      &Apache::lonhtmlcommon::add_breadcrumb({
                 'text'  => 'Resource Publication',
     $thistarget=~s/^\/home/$targetdir/;          'href'  => '',
     $thistarget=~s/\/public\_html//;      });
   
     my $thisdistarget=$thistarget;      my $js='<script type="text/javascript">'.
     $thisdistarget=~s/^\Q$docroot\E//;   &Apache::loncommon::browser_and_searcher_javascript().
    '</script>';
     my $thisdisfn=$thisfn;      $r->print(&Apache::loncommon::start_page('Resource Publication',$js)
     $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///;               .&Apache::lonhtmlcommon::breadcrumbs()
                .&Apache::loncommon::head_subbox(
                     &Apache::loncommon::CSTR_pageheader($docroot.$fn))
       );
   
       my $thisdisfn=&HTML::Entities::encode($fn,'<>&"');
       my $thistarget=$fn;
       $thistarget=~s/^\/priv\//\/res\//;
       my $thisdistarget=&HTML::Entities::encode($thistarget,'<>&"');
   
     if ($fn=~/\/$/) {      if ($fn=~/\/$/) {
 # -------------------------------------------------------- This is a directory  # -------------------------------------------------------- This is a directory
  &publishdirectory($r,$fn,$thisdisfn);   &publishdirectory($r,$docroot.$fn,$thisdisfn);
  $r->print('<hr><font size="+2">'.&mt('Done').'</font><br><a href="/priv/'   $r->print('<hr /><a href="'.$thisdisfn.'">'.&mt('Return to Directory').'</a>');
   .$cuname.'/'.$thisdisfn  
   .'">'.&mt('Return to Directory').'</a>');  
   
   
     } else {      } else {
 # ---------------------- Evaluate individual file, and then output information.  # ---------------------- Evaluate individual file, and then output information.
  $thisfn=~/\.(\w+)$/;   $fn=~/\.(\w+)$/;
  my $thistype=$1;   my $thistype=$1;
  my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);   my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
  $r->print('<h2>'.&mt('Publishing').' '.          if ($thistype eq 'page') {  $thisembstyle = 'rat'; }
   &Apache::loncommon::filedescription($thistype).' <tt>');  
   
           $r->print('<h2>'
                    .&mt('Publishing [_1]'
                        ,'<span class="LC_filename">'.$thisdisfn.'</span>')
                    .'</h2>'
           );
   
           $r->print('<h3>'.&mt('Resource Details').'</h3>');
   
           $r->print(&Apache::lonhtmlcommon::start_pick_box());
   
           $r->print(&Apache::lonhtmlcommon::row_title(&mt('Type'))
                    .&Apache::loncommon::filedescription($thistype)
                    .&Apache::lonhtmlcommon::row_closure()
                    );
   
           $r->print(&Apache::lonhtmlcommon::row_title(&mt('Link to Resource'))
                    .'<tt>'
                    );
  $r->print(<<ENDCAPTION);   $r->print(<<ENDCAPTION);
 <a href='javascript:void(window.open("/~$cuname/$thisdisfn","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>  <a href='javascript:void(window.open("$thisdisfn","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>
 $thisdisfn</a>  $thisdisfn</a>
 ENDCAPTION  ENDCAPTION
         $r->print('</tt></h2><b>'.&mt('Target').':</b> <tt>'.          $r->print('</tt>'
   $thisdistarget.'</tt><br />');                   .&Apache::lonhtmlcommon::row_closure()
                       );
  if (($cuname ne $ENV{'user.name'})||($cudom ne $ENV{'user.domain'})) {  
     $r->print('<h3><font color="red">'.&mt('Co-Author').': '.          $r->print(&Apache::lonhtmlcommon::row_title(&mt('Target'))
       $cuname.&mt(' at ').$cudom.'</font></h3>');                   .'<tt>'.$thisdistarget.'</tt>'
                    );
    if (($cuname ne $env{'user.name'})||($cudom ne $env{'user.domain'})) {
               $r->print(&Apache::lonhtmlcommon::row_closure()
                        .&Apache::lonhtmlcommon::row_title(&mt('Co-Author'))
                        .'<span class="LC_warning">'
        .&Apache::loncommon::plainname($cuname,$cudom) .' ('.$cuname.':'.$cudom.')'
                        .'</span>'
                        );
  }   }
   
  if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {   if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
               $r->print(&Apache::lonhtmlcommon::row_closure()
                        .&Apache::lonhtmlcommon::row_title(&mt('Diffs')));
     $r->print(<<ENDDIFF);      $r->print(<<ENDDIFF);
 <br />  <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"))'>
 <a href='javascript:void(window.open("/adm/diff?filename=/~$cuname/$thisdisfn&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><br />');              $r->print(&mt('Diffs with Current Version').'</a>');
  }   }
           
           $r->print(&Apache::lonhtmlcommon::row_closure(1)
                    .&Apache::lonhtmlcommon::end_pick_box()
                    );
       
 # ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.  # ---------------------- Publishing from $fn to $thistarget with $thisembstyle.
   
  unless ($ENV{'form.phase'} eq 'two') {   unless ($env{'form.phase'} eq 'two') {
     my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle);  # ---------------------------------------------------------- Parse for problems
     $r->print('<hr />'.$outstring);      my ($warningcount,$errorcount);
       if ($thisembstyle eq 'ssi') {
    ($warningcount,$errorcount)=&checkonthis($r,$fn);
       }
       unless ($errorcount) {
    my ($outstring,$error)=
       &publish($docroot.$fn,$docroot.$thistarget,$thisembstyle);
    $r->print($outstring);
       } else {
    $r->print('<h3 class="LC_error">'.
     &mt('The document contains errors and cannot be published.').
     '</h3>');
       }
  } else {   } else {
     $r->print('<hr />'.      &phasetwo($r,$docroot.$fn,$docroot.$thistarget,$thisembstyle,$thisdistarget); 
     &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget));   
  }   }
     }      }
     $r->print('</body></html>');      $r->print(&Apache::loncommon::end_page());
   
     return OK;      return OK;
 }  }
Line 1966  __END__ Line 2307  __END__
   
 =back  =back
   
 =back  
   
 =cut  =cut
   

Removed from v.1.177  
changed lines
  Added in v.1.288


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