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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.162 and 1.238

version 1.162, 2004/01/20 22:52:17 version 1.238, 2008/06/27 18:52:35
Line 121  use HTML::LCParser; Line 121  use HTML::LCParser;
 use Apache::lonxml;  use Apache::lonxml;
 use Apache::loncacc;  use Apache::loncacc;
 use DBI;  use DBI;
 use Apache::lonnet();  use Apache::lonnet;
 use Apache::loncommon();  use Apache::loncommon();
 use Apache::lonmysql;  use Apache::lonmysql;
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::loncfile;  use Apache::loncfile;
 use Apache::lonmeta;  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
   
 =item B<metaeval>  =item B<metaeval>
Line 178  sub metaeval { Line 185  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 199  sub metaeval { Line 207  sub metaeval {
  }   }
     }      }
     my $newentry=$parser->get_text('/'.$entry);      my $newentry=$parser->get_text('/'.$entry);
     if ($entry eq 'customdistributionfile') {      if (($entry eq 'customdistributionfile') ||
    ($entry eq 'sourcerights')) {
  $newentry=~s/^\s*//;   $newentry=~s/^\s*//;
  if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; }   if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; }
     }      }
Line 274  sub metaread { Line 283  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 322  sub textfield { Line 330  sub textfield {
     $value=~s/\s+$//gs;      $value=~s/\s+$//gs;
     $value=~s/\s+/ /gs;      $value=~s/\s+/ /gs;
     $title=&mt($title);      $title=&mt($title);
     return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".      $env{'form.'.$name}=$value;
            "</b></font></p><br />".      return "\n".&Apache::lonhtmlcommon::row_title($title)
            '<input type="text" name="'.$name.'" size=80 value="'.$value.'" />';             .'<input type="text" name="'.$name.'" size="80" value="'.$value.'" />'
              .&Apache::lonhtmlcommon::row_closure();
   }
   
   sub text_with_browse_field {
       my ($title,$name,$value,$restriction)=@_;
       $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.'" />'
             .'<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();
 }  }
   
 sub hiddenfield {  sub hiddenfield {
     my ($name,$value)=@_;      my ($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];
     my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".      if (defined($value)) {
  '</b></font></p><br /><select name="'.$name.'">';   $env{'form.'.$name}=$value;
       } else {
    $env{'form.'.$name}=$idlist[0];
       }
       my $selout="\n".&Apache::lonhtmlcommon::row_title($title)
                 .'<select name="'.$name.'">';
     foreach (@idlist) {      foreach (@idlist) {
         $selout.='<option value=\''.$_.'\'';          $selout.='<option value=\''.$_.'\'';
         if ($_ eq $value) {          if ($_ eq $value) {
Line 345  sub selectbox { Line 385  sub selectbox {
  }   }
         else {$selout.='>'.&{$functionref}($_).'</option>';}          else {$selout.='>'.&{$functionref}($_).'</option>';}
     }      }
     return $selout.'</select>';      $selout.='</select>'.&Apache::lonhtmlcommon::row_closure();
       return $selout;
 }  }
   
   sub select_level_form {
       my ($value,$name)=@_;
       $env{'form.'.$name}=$value;
       if (!defined($value)) { $env{'form.'.$name}=0; }
       return  &Apache::loncommon::select_level_form($value,$name);
   }
 #########################################  #########################################
 #########################################  #########################################
   
Line 369  sub urlfixup { Line 416  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 428  sub set_allow { Line 474  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 455  sub get_subscribed_hosts { Line 501  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 467  sub get_subscribed_hosts { Line 518  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 509  sub get_max_ids_indices { Line 554  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 527  sub get_max_ids_indices { Line 574  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 569  sub get_all_text_unbalanced { Line 617  sub get_all_text_unbalanced {
  } elsif ($token->[0] eq 'E')  {   } elsif ($token->[0] eq 'E')  {
     $result.=$token->[2];      $result.=$token->[2];
  }   }
  if ($result =~ /(.*)\Q$tag\E(.*)/s) {   if ($result =~ /\Q$tag\E/s) {
       ($result,my $redo)=$result =~ /(.*)\Q$tag\E(.*)/is;
     #&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2);      #&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2);
     #&Apache::lonnet::logthis('Result is :'.$1);      #&Apache::lonnet::logthis('Result is :'.$1);
     $result=$1;      $redo=$tag.$redo;
     my $redo=$tag.$2;  
     push (@$pars,HTML::LCParser->new(\$redo));      push (@$pars,HTML::LCParser->new(\$redo));
     $$pars[-1]->xml_mode('1');      $$pars[-1]->xml_mode('1');
     last;      last;
Line 613  sub fix_ids_and_indices { Line 661  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 622  sub fix_ids_and_indices { Line 670  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 636  sub fix_ids_and_indices { Line 685  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++; }
  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 670  sub fix_ids_and_indices { Line 730  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 724  sub fix_ids_and_indices { Line 785  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 'script' || $lctag eq 'answer' 
                     || $lctag eq 'display' || $lctag eq 'tex') {                      || $lctag eq 'display' || $lctag eq 'tex') {
     $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);      $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);
  }   }
Line 733  sub fix_ids_and_indices { Line 794  sub fix_ids_and_indices {
     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',$token->[1]).'</span>';
                       return ($outstring,1);
                   }
     } else {      } else {
  $outstring.=$token->[1];   $outstring.=$token->[1];
     }      }
Line 776  sub store_metadata { Line 842  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">WARNING: Cannot connect to '.
             'database!</font>';              '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">WARNING: The metadata table does not '.
             'exist in the LON-CAPA database.</font>';              'exist in the LON-CAPA database.</span>';
         &Apache::lonnet::logthis($error);          &Apache::lonnet::logthis($error);
         return ($error,undef);          return ($error,undef);
     }      }
     if (($metadata{'obsolete'}) || ($metadata{'copyright'} eq 'priv') ||      my $dbh = &Apache::lonmysql::get_dbh();
  ($metadata{'copyright'} eq 'custom')) {      if (($metadata{'obsolete'}) || ($metadata{'copyright'} eq 'priv')) {
 # remove this entry          # remove this entry
  $status=&Apache::lonmysql::remove_from_table   my $delitem = 'url = '.$dbh->quote($metadata{'url'});
     ('metadata','url',$metadata{'url'});   $status = &LONCAPA::lonmetadata::delete_metadata($dbh,undef,$delitem);
                                                          
     } else {      } else {
 # store new data          $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,undef,
 # adjust some values to metadatadatabase (e.g., "usage" is a reserved word)                                                           \%metadata);
  $metadata{'creationdate'}=  
     &Apache::lonmysql::sqltime($metadata{'creationdate'});   
  $metadata{'lastrevisiondate'}=  
     &Apache::lonmysql::sqltime($metadata{'lastrevisiondate'});  
  $metadata{'sequsage'}=$metadata{'usage'};  
  $metadata{'sequsage_list'}=$metadata{'usage_list'};  
  my %newmetadata=();  
 # see if we have old entries  
  my @oldmeta=&Apache::lonmysql::get_rows('metadata',  
  "url LIKE BINARY '".  
  $metadata{'url'}."'");  
  if ($#oldmeta==0) {  
 # yes, there is one old entry, transfer to newmetadata  
     %newmetadata=&Apache::lonmeta::metadata_col_to_hash(@{$oldmeta[0]});  
 # remove old entry  
     $status=&Apache::lonmysql::remove_from_table  
  ('metadata','url',$metadata{'url'});  
  } elsif ($#oldmeta>0) {  
 # more than one entry fit - how did that happen?  
     $error='<font color="red">Error occured retrieving old values in '.  
       'metadata table in LON-CAPA database: '.$#oldmeta.  
       ' matches</font>';  
     &Apache::lonnet::logthis($error);  
     return ($error,undef);  
  }  
 # store new data on top of it  
  foreach (keys %metadata) {  
     $newmetadata{$_}=$metadata{$_};  
  }  
  $status = &Apache::lonmysql::store_row('metadata',\%newmetadata);  
     }      }
     if (! defined($status)) {      if (defined($status) && $status ne '') {
         $error='<font color="red">Error occured storing new values in '.          $error='<span class="LC_error">Error occured saving new values in '.
             'metadata table in LON-CAPA database</font>';              'metadata table in LON-CAPA database</span>';
         &Apache::lonnet::logthis($error);          &Apache::lonnet::logthis($error);
           &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('<br /><tt>'.$uri.'</tt>: ');
    if ($errorcount) {
       $r->print('<img src="/adm/lonMisc/bomb.gif" /><span class="LC_error"><b>'.
         $errorcount.' '.
         &mt('error(s)').'</b></span> ');
    }
    if ($warningcount) {
       $r->print('<font color="blue">'.
         $warningcount.' '.
         &mt('warning(s)').'</font>');
    }
       } 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 887  sub publish { Line 954  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 901  sub publish { Line 968  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\">Failed to write backup copy, $!,FAIL</span>",1);
         }          }
 # ------------------------------------------------------------- IDs and indices  # ------------------------------------------------------------- IDs and indices
   
Line 913  sub publish { Line 980  sub publish {
           
  $scrout.='<h3>'.&mt('Dependencies').'</h3>';   $scrout.='<h3>'.&mt('Dependencies').'</h3>';
         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 =~/\$/) {
                 $scrout.='<br /><span 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>')
                          .'</span><br />';
              }
            unless ($style eq 'rat') {              unless ($style eq 'rat') { 
               $allowstr.="\n".'<allow src="'.$thisdep.'" />';                $allowstr.="\n".'<allow src="'.$thisdep.'" />';
    }     }
            $scrout.='<br />';             $scrout.='<br />';
            unless ($thisdep=~/\*/) {             if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) {
        $scrout.='<a href="'.$thisdep.'">';         $scrout.='<a href="'.$thisdep.'">';
            }             }
            $scrout.='<tt>'.$thisdep.'</tt>';             $scrout.='<tt>'.$thisdep.'</tt>';
            unless ($thisdep=~/\*/) {             if ($thisdep!~/[\*\$]/ && $thisdep!~m|^/adm/|) {
        $scrout.='</a>';         $scrout.='</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').     $scrout.= ' - <span class="LC_error">'.&mt('Currently not available').
        '</font>';         '</span>';
                } else {                 } else {
                    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);
Line 943  sub publish { Line 1015  sub publish {
        }         }
            }             }
         }          }
         $outstring=~s/\n*(\<\/[^\>]+\>)\s*$/$allowstr\n$1\n/s;          $outstring=~s/\n*(\<\/[^\>]+\>[^<]*)$/$allowstr\n$1\n/s;
   
 ### FIXME: is this really what we want?  
 # I dont' think so, to will corrupt any UTF-8 resources at least,   
 # and any encoding other than ISO-8859-1 will probably break  
  #Encode any High ASCII characters  
  #$outstring=&HTML::Entities::encode($outstring,"\200-\377");  
 # ------------------------------------------------------------- Write modified.  # ------------------------------------------------------------- Write modified.
   
         {          {
           my $org;            my $org;
           unless ($org=Apache::File->new('>'.$source)) {            unless ($org=Apache::File->new('>'.$source)) {
              print $logfile "No write permit to $source\n";               print $logfile "No write permit to $source\n";
              return ('<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 982  sub publish { Line 1049  sub publish {
     }      }
   
 # ------------------------------------------------ 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
   
Line 1007  sub publish { Line 1074  sub publish {
             $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 1031  sub publish { Line 1099  sub publish {
  delete $metadatafields{$_};   delete $metadatafields{$_};
             }              }
         }          }
   # ------------------------------------------------------------- Save some stuff
           my %savemeta=();
           foreach ('title') {
               $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 1045  sub publish { Line 1121  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 1061  sub publish { Line 1139  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><h1><span class="LC_warning">'.&mt('Warning!').
     '</font></h1><p><font color="red" size="+1">'.      '</span></h1><p><span class="LC_warning">'.
     &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.').'</span></p><hr />';
       }
       if ($metadatafields{'copyright'} eq 'priv') {
           $scrout.='</p><h1><span class="LC_warning">'.&mt('Warning!').
               '</span></h1><p><span class="LC_warning">'.
               &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.').'</span></p><hr />';
     }      }
   
 # ------------------------------------------------------- Now have all metadata  # ------------------------------------------------------- Now have all metadata
Line 1094  sub publish { Line 1179  sub publish {
     }      }
   
                           
     foreach (split(/\W+/,$metadatafields{'keywords'})) {      foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {
  $keywords{$_}=1;   $addkey=~s/\s+/ /g;
    $addkey=~s/^\s//;
    $addkey=~s/\s$//;
    if ($addkey=~/\w/) {
       $keywords{$addkey}=1;
    }
     }      }
 # --------------------------------------------------- Now we also have keywords  # --------------------------------------------------- Now we also have keywords
 # =============================================================================  # =============================================================================
 # INTERACTIVE MODE  # interactive mode html goes into $intr_scrout
 #  # batch mode throws away this HTML
     unless ($batch) {  # additionally all of the field functions have a by product of setting
         $scrout.=  #   $env{'from.'..} so that it can be used by the phase two handler in
     '<form name="pubform" action="/adm/publish" method="post">'.  #    batch mode
             '<p><input type="submit" value="'.&mt('Finalize Publication').'" /></p>'.  
             &hiddenfield('phase','two').      my $intr_scrout.=&Apache::lonhtmlcommon::start_pick_box()
             &hiddenfield('filename',$ENV{'form.filename'}).                      .'<form name="pubform" action="/adm/publish" method="post">';
     &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).      unless ($env{'form.makeobsolete'}) {
             &hiddenfield('dependencies',join(',',keys %allow)).         $intr_scrout.=&Apache::lonhtmlcommon::row_title()
             &textfield('Title','title',$metadatafields{'title'}).                      .'<input type="submit" value="'
             &textfield('Author(s)','author',$metadatafields{'author'}).                      .&mt('Finalize Publication')
     &textfield('Subject','subject',$metadatafields{'subject'});                      .'" />'
                       .&Apache::lonhtmlcommon::row_closure()
 # --------------------------------------------------- Scan content for keywords      }
       $intr_scrout.=
         my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");   &hiddenfield('phase','two').
         my $KEYWORDS=&mt('Keywords');   &hiddenfield('filename',$env{'form.filename'}).
  my $CheckAll=&mt('check all');   &hiddenfield('allmeta',&escape($allmeta)).
  my $UncheckAll=&mt('uncheck all');   &hiddenfield('dependencies',join(',',keys %allow));
  my $keywordout=<<"END";      unless ($env{'form.makeobsolete'}) {
          $intr_scrout.=
    &textfield('Title','title',$metadatafields{'title'}).
    &textfield('Author(s)','author',$metadatafields{'author'}).
    &textfield('Subject','subject',$metadatafields{'subject'});
    # --------------------------------------------------- Scan content for keywords
   
       my $keywords_help = &Apache::loncommon::help_open_topic("Publishing_Keywords");
       my $keywordout=<<"END";
 <script>  <script>
 function checkAll(field) {  function checkAll(field) {
     for (i = 0; i < field.length; i++)      for (i = 0; i < field.length; i++)
Line 1131  function uncheckAll(field) { Line 1229  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'))
  my $colcount=0;                  .$keywords_help
                   .'<input type="button" value="'.&mt('check all').'" onclick="javascript:checkAll(document.pubform.keywords)" />'
  foreach (sort keys %keywords) {                  .'<input type="button" value="'.&mt('uncheck all').'" onclick="javascript:uncheckAll(document.pubform.keywords)" />'
     $keywordout.='<td><input type="checkbox" name="keywords" value="'.$_.'"';                  .'</p><br />'
     if ($metadatafields{'keywords'}) {                  .'<table border="2"><tr>';
  if ($metadatafields{'keywords'}=~/\Q$_\E/) {      my $colcount=0;
     $keywordout.=' checked="on"';  
  }      foreach (sort keys %keywords) {
     } elsif (&Apache::loncommon::keyword($_)) {   $keywordout.='<td><label><input type="checkbox" name="keywords" value="'.$_.'"';
    if ($metadatafields{'keywords'}) {
       if ($metadatafields{'keywords'}=~/\Q$_\E/) {
  $keywordout.=' checked="on"';   $keywordout.=' checked="on"';
    $env{'form.keywords'}.=$_.',';
     }      }
     $keywordout.=' />'.$_.'</td>';   } elsif (&Apache::loncommon::keyword($_)) {
     if ($colcount>10) {      $keywordout.=' checked="on"';
  $keywordout.="</tr><tr>\n";      $env{'form.keywords'}.=$_.',';
  $colcount=0;  
     }  
     $colcount++;  
  }   }
    $keywordout.=' />'.$_.'</label></td>';
    if ($colcount>10) {
       $keywordout.="</tr><tr>\n";
       $colcount=0;
    }
    $colcount++;
       }
       $env{'form.keywords'}=~s/\,$//;
   
  $keywordout.='</tr></table>';      $keywordout.='</tr></table>'
                    .&Apache::lonhtmlcommon::row_closure();
  $scrout.=$keywordout;  
   
  $scrout.=&textfield('Additional Keywords','addkey','');  
   
  $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});  
   
  $scrout.=      $intr_scrout.=$keywordout;
     "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".&mt('Abstract').":".  
     "</b></font></p><br />".  
     '<textarea cols="80" rows="5" name="abstract">'.  
     $metadatafields{'abstract'}.'</textarea></p>';  
   
  $source=~/\.(\w+)$/;      $intr_scrout.=&textfield('Additional Keywords','addkey','');
   
       $intr_scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
   
  $scrout.=      $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Abstract'))
     "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".                   .'<textarea cols="80" rows="5" name="abstract">'
     &mt('Lowest Grade Level').':'.                   .$metadatafields{'abstract'}
            "</b></font></p><br />".                   .'</textarea>'
    &Apache::loncommon::select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel').                   .&Apache::lonhtmlcommon::row_closure();
     "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".  
     &mt('Highest Grade Level').':'.  
            "</b></font></p><br />".  
    &Apache::loncommon::select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel').  
            &textfield('Standards','standards',$metadatafields{'standards'});  
   
       $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.=&textfield('Standards','standards',$metadatafields{'standards'});
   
  $scrout.=&hiddenfield('mime',$1);      $intr_scrout.=&hiddenfield('mime',$1);
   
  my $defaultlanguage=$metadatafields{'language'};      my $defaultlanguage=$metadatafields{'language'};
  $defaultlanguage =~ s/\s*notset\s*//g;      $defaultlanguage =~ s/\s*notset\s*//g;
  $defaultlanguage =~ s/^,\s*//g;      $defaultlanguage =~ s/^,\s*//g;
  $defaultlanguage =~ s/,\s*$//g;      $defaultlanguage =~ s/,\s*$//g;
   
  $scrout.=&selectbox('Language','language',      $intr_scrout.=&selectbox('Language','language',
     $defaultlanguage,       $defaultlanguage,
     \&Apache::loncommon::languagedescription,       \&Apache::loncommon::languagedescription,
     (&Apache::loncommon::languageids),       (&Apache::loncommon::languageids),
    );       );
   
  unless ($metadatafields{'creationdate'}) {      unless ($metadatafields{'creationdate'}) {
     $metadatafields{'creationdate'}=time;   $metadatafields{'creationdate'}=time;
  }      }
  $scrout.=&hiddenfield('creationdate',      $intr_scrout.=&hiddenfield('creationdate',
       &Apache::lonmysql::unsqltime($metadatafields{'creationdate'}));         &Apache::lonmysql::unsqltime($metadatafields{'creationdate'}));
   
  $scrout.=&hiddenfield('lastrevisiondate',time);      $intr_scrout.=&hiddenfield('lastrevisiondate',time);
   
   
  $scrout.=&textfield('Publisher/Owner','owner',      $intr_scrout.=&textfield('Publisher/Owner','owner',
     $metadatafields{'owner'});       $metadatafields{'owner'});
   
   # ---------------------------------------------- Retrofix for unused copyright
       if ($metadatafields{'copyright'} eq 'free') {
    $metadatafields{'copyright'}='default';
    $metadatafields{'sourceavail'}='open';
       }
       if ($metadatafields{'copyright'} eq 'priv') {
           $metadatafields{'copyright'}='domain';
       }
   # ------------------------------------------------ Dial in reasonable defaults
       my $defaultoption=$metadatafields{'copyright'};
       unless ($defaultoption) { $defaultoption='default'; }
       my $defaultsourceoption=$metadatafields{'sourceavail'};
       unless ($defaultsourceoption) { $defaultsourceoption='closed'; }
       unless ($style eq 'prv') {
 # -------------------------------------------------- Correct copyright for rat.  # -------------------------------------------------- Correct copyright for rat.
         my $defaultoption=$metadatafields{'copyright'};   if ($style eq 'rat') {
         unless ($defaultoption) { $defaultoption='default'; }  # -------------------------------------- Retrofix for non-applicable copyright
  unless ($style eq 'prv') {      if ($metadatafields{'copyright'} eq 'public') { 
     if ($style eq 'rat') {   delete $metadatafields{'copyright'};
  if ($metadatafields{'copyright'} eq 'public') {    $defaultoption='default';
     delete $metadatafields{'copyright'};      }
                     $defaultoption='default';      $intr_scrout.=&selectbox('Copyright/Distribution','copyright',
  }       $defaultoption,
  $scrout.=&selectbox('Copyright/Distribution','copyright',       \&Apache::loncommon::copyrightdescription,
     $defaultoption,      (grep !/^(public|priv)$/,(&Apache::loncommon::copyrightids)));
     \&Apache::loncommon::copyrightdescription,   } else {
     (grep !/^public$/,(&Apache::loncommon::copyrightids)));      $intr_scrout.=&selectbox('Copyright/Distribution','copyright',
     } else {       $defaultoption,
  $scrout.=&selectbox('Copyright/Distribution','copyright',       \&Apache::loncommon::copyrightdescription,
     $defaultoption,       (grep !/^priv$/,(&Apache::loncommon::copyrightids)));
     \&Apache::loncommon::copyrightdescription,   }
     (&Apache::loncommon::copyrightids));   my $copyright_help =
     }      &Apache::loncommon::help_open_topic('Publishing_Copyright');
               my $replace=&mt('Copyright/Distribution:');
     my $copyright_help =   $intr_scrout =~ s/$replace/$replace.' '.$copyright_help/ge;
  Apache::loncommon::help_open_topic('Publishing_Copyright');  
     $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;   $intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights');
     $scrout.=&textfield('Custom Distribution File','customdistributionfile',   $intr_scrout.=&selectbox('Source Distribution','sourceavail',
  $metadatafields{'customdistributionfile'}).   $defaultsourceoption,
     $copyright_help;   \&Apache::loncommon::source_copyrightdescription,
     my $uctitle=&mt('Obsolete');   (&Apache::loncommon::source_copyrightids));
             $scrout.=  # $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights');
  "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".   my $uctitle=&mt('Obsolete');
  '</b></font> <input type="checkbox" name="obsolete" ';          my $obsolete_checked=($metadatafields{'obsolete'})?' checked="1" ':'';
     if ($metadatafields{'obsolete'}) {          $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title($uctitle)
  $scrout.=' checked="1" ';                       .'<input type="checkbox" name="obsolete" '.$obsolete_checked.'/ >'
     }                       .&Apache::lonhtmlcommon::row_closure(1);
     $scrout.='/ ></p>'.          $intr_scrout.=&text_with_browse_field('Suggested Replacement for Obsolete File',
  &textfield('Suggested Replacement for Obsolete File',  
     'obsoletereplacement',      'obsoletereplacement',
     $metadatafields{'obsoletereplacement'});      $metadatafields{'obsoletereplacement'});
  } else {  
     $scrout.=&hiddenfield('copyright','private');  
  }  
  return ($scrout.'<p><input type="submit" value="'.  
  &mt('Finalize Publication').'" /></p></form>',0);  
 # =============================================================================  
 # BATCH MODE  
 #  
     } else {      } else {
 # Transfer metadata directly to environment for stage 2   $intr_scrout.=&hiddenfield('copyright','private');
  foreach (keys %metadatafields) {      }
     $ENV{'form.'.$_}=$metadatafields{$_};     } else {
  }         $intr_scrout.=
  $ENV{'form.addkey'}='';   &hiddenfield('title',$metadatafields{'title'}).
  $ENV{'form.keywords'}='';   &hiddenfield('author',$metadatafields{'author'}).
  foreach (keys %keywords) {   &hiddenfield('subject',$metadatafields{'subject'}).
     if ($metadatafields{'keywords'}) {   &hiddenfield('keywords',$metadatafields{'keywords'}).
  if ($metadatafields{'keywords'}=~/\Q$_\E/) {    &hiddenfield('abstract',$metadatafields{'abstract'}).
     $ENV{'form.keywords'}.=$_.',';    &hiddenfield('notes',$metadatafields{'notes'}).
  }   &hiddenfield('mime',$metadatafields{'mime'}).
     } elsif (&Apache::loncommon::keyword($_)) {   &hiddenfield('creationdate',$metadatafields{'creationdate'}).
  $ENV{'form.keywords'}.=$_.',';   &hiddenfield('lastrevisiondate',time).
     }   &hiddenfield('owner',$metadatafields{'owner'}).
  }   &hiddenfield('lowestgradelevel',$metadatafields{'lowestgradelevel'}).
  $ENV{'form.keywords'}=~s/\,$//;   &hiddenfield('standards',$metadatafields{'standards'}).
  unless ($ENV{'form.creationdate'}) { $ENV{'form.creationdate'}=time; }   &hiddenfield('highestgradelevel',$metadatafields{'highestgradelevel'}).
  $ENV{'form.lastrevisiondate'}=time;   &hiddenfield('language',$metadatafields{'language'}).
  if ((($style eq 'rat') && ($ENV{'form.copyright'} eq 'public')) ||   &hiddenfield('copyright',$metadatafields{'copyright'}).
     (!$ENV{'form.copyright'})) {    &hiddenfield('sourceavail',$metadatafields{'sourceavail'}).
     $ENV{'form.copyright'}='default';   &hiddenfield('customdistributionfile',$metadatafields{'customdistributionfile'}).
  }   &hiddenfield('obsolete',1).
  $ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta);   &text_with_browse_field('Suggested Replacement for Obsolete File',
  return ($scrout,0);      'obsoletereplacement',
       $metadatafields{'obsoletereplacement'});
      }
       if (!$batch) {
    $scrout.=$intr_scrout
               .&Apache::lonhtmlcommon::row_title()
               .'<input type="submit" value="'
       .&mt($env{'form.makeobsolete'}?'Make Obsolete':'Finalize Publication')
               .'" />'.&Apache::lonhtmlcommon::row_closure()
               .'</form>'
               .&Apache::lonhtmlcommon::end_pick_box();
     }      }
       return($scrout,0);
 }  }
   
 #########################################  #########################################
Line 1315  Returns: Line 1428  Returns:
   
 =over 4  =over 4
   
 =item Scalar string  =item integer
   
 String contains status (errors and warnings) and information associated with  0: fail
 the server's attempts at publication.       1: success
   
 =cut  =cut
   
Line 1330  sub phasetwo { Line 1443  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('Cannot publish versioned resource, 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(&unescape($env{'form.allmeta'}));
           
     &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));      $metadatafields{'title'}=$env{'form.title'};
           $metadatafields{'author'}=$env{'form.author'};
     $metadatafields{'title'}=$ENV{'form.title'};      $metadatafields{'subject'}=$env{'form.subject'};
     $metadatafields{'author'}=$ENV{'form.author'};      $metadatafields{'notes'}=$env{'form.notes'};
     $metadatafields{'subject'}=$ENV{'form.subject'};      $metadatafields{'abstract'}=$env{'form.abstract'};
     $metadatafields{'notes'}=$ENV{'form.notes'};      $metadatafields{'mime'}=$env{'form.mime'};
     $metadatafields{'abstract'}=$ENV{'form.abstract'};      $metadatafields{'language'}=$env{'form.language'};
     $metadatafields{'mime'}=$ENV{'form.mime'};      $metadatafields{'creationdate'}=$env{'form.creationdate'};
     $metadatafields{'language'}=$ENV{'form.language'};      $metadatafields{'lastrevisiondate'}=$env{'form.lastrevisiondate'};
     $metadatafields{'creationdate'}=$ENV{'form.creationdate'};      $metadatafields{'owner'}=$env{'form.owner'};
     $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};      $metadatafields{'copyright'}=$env{'form.copyright'};
     $metadatafields{'owner'}=$ENV{'form.owner'};      $metadatafields{'standards'}=$env{'form.standards'};
     $metadatafields{'copyright'}=$ENV{'form.copyright'};      $metadatafields{'lowestgradelevel'}=$env{'form.lowestgradelevel'};
     $metadatafields{'standards'}=$ENV{'form.standards'};      $metadatafields{'highestgradelevel'}=$env{'form.highestgradelevel'};
     $metadatafields{'lowestgradelevel'}=$ENV{'form.lowestgradelevel'};  
     $metadatafields{'highestgradelevel'}=$ENV{'form.highestgradelevel'};  
     $metadatafields{'customdistributionfile'}=      $metadatafields{'customdistributionfile'}=
                                  $ENV{'form.customdistributionfile'};                                   $env{'form.customdistributionfile'};
     $metadatafields{'obsolete'}=$ENV{'form.obsolete'};      $metadatafields{'sourceavail'}=$env{'form.sourceavail'};
       $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/\W+/\,/;      $allkeywords=~s/[\"\']//g;
     $allkeywords=~s/^\,//;      $allkeywords=~s/\s*[\;\,]\s*/\,/g;
       $allkeywords=~s/\s+/ /g;
       $allkeywords=~s/^[ \,]//;
       $allkeywords=~s/[ \,]$//;
     $metadatafields{'keywords'}=$allkeywords;      $metadatafields{'keywords'}=$allkeywords;
           
 # check if custom distribution file is specified  # check if custom distribution file is specified
     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 1419  sub phasetwo { Line 1560  sub phasetwo {
                     print $mfh ' '.$_.'="'.$value.'"';                      print $mfh ' '.$_.'="'.$value.'"';
                 }                  }
                 print $mfh '>'.                  print $mfh '>'.
                     &HTML::Entities::encode($metadatafields{$unikey})                      &HTML::Entities::encode($metadatafields{$unikey},'<>&"')
                         .'</'.$tag.'>';                          .'</'.$tag.'>';
             }              }
         }          }
Line 1455  sub phasetwo { Line 1596  sub phasetwo {
         my $srcd=$1;          my $srcd=$1;
         unless ($srcd=~/^\/home\/httpd\/html\/res/) {          unless ($srcd=~/^\/home\/httpd\/html\/res/) {
             print $logfile "\nPANIC: Target dir is ".$srcd;              print $logfile "\nPANIC: Target dir is ".$srcd;
             return "<font color=\"red\">Invalid target directory, FAIL</font>";              $r->print(
    "<span class=\"LC_error\">Invalid target directory, FAIL</span>");
       return 0;
         }          }
         opendir(DIR,$srcd);          opendir(DIR,$srcd);
         while ($filename=readdir(DIR)) {          while ($filename=readdir(DIR)) {
Line 1480  sub phasetwo { Line 1623  sub phasetwo {
             $r->print('<p>'.&mt('Copied old target file').'</p>');              $r->print('<p>'.&mt('Copied old target file').'</p>');
         } 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("<span class=\"LC_error\">".&mt('Failed to copy old target').
  ", $!, ".&mt('FAIL')."</font>";   ", $!, ".&mt('FAIL')."</span>");
       return 0;
         }          }
                   
 # --------------------------------------------------------------- Copy Metadata  # --------------------------------------------------------------- Copy Metadata
Line 1494  sub phasetwo { Line 1638  sub phasetwo {
         } 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( 
                     "<font color=\"red\">".                      "<span class=\"LC_error\">".
 &mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')."</font>";  &mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')."</span>");
    return 0;
     }      }
         }          }
                   
Line 1527  sub phasetwo { Line 1672  sub phasetwo {
         $r->print('<p>'.&mt('Copied source file').'</p>');          $r->print('<p>'.&mt('Copied source file').'</p>');
     } else {      } else {
         print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";          print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
         return "<font color=\"red\">".          $r->print("<span class=\"LC_error\">".
     &mt('Failed to copy source').", $!, ".&mt('FAIL')."</font>";      &mt('Failed to copy source').", $!, ".&mt('FAIL')."</span>");
    return 0;
     }      }
           
 # --------------------------------------------------------------- Copy Metadata  # --------------------------------------------------------------- Copy Metadata
Line 1540  sub phasetwo { Line 1686  sub phasetwo {
         $r->print('<p>'.&mt('Copied metadata').'</p>');          $r->print('<p>'.&mt('Copied metadata').'</p>');
     } else {      } else {
         print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";          print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
         return           $r->print(
             "<font color=\"red\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</font>";              "<span class=\"LC_error\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</span>");
    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.':';   $r->register_cleanup(\&notify);
  my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);   $registered_cleanup=1;
  $r->print($reply.'</p><br />');$r->rflush;  
  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;  
  print $logfile $reply;  
     }  
       
 # --------------------------------------------------- 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;          my $thissrc=$source;
         $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/;          $thissrc=~s{^/home/($match_username)/public_html}{/priv/$1};
                   
         my $thissrcdir=$thissrc;          my $thissrcdir=$thissrc;
         $thissrcdir=~s/\/[^\/]+$/\//;          $thissrcdir=~s/\/[^\/]+$/\//;
Line 1595  sub phasetwo { Line 1719  sub phasetwo {
         $r->print(          $r->print(
            '<hr /><a href="'.$thisdistarget.'"><font size="+2">'.             '<hr /><a href="'.$thisdistarget.'"><font size="+2">'.
            &mt('View Published Version').'</font></a>'.             &mt('View Published Version').'</font></a>'.
            '<p><a href="'.$thissrc.'"><font size=+2>'.             '<p><a href="'.$thissrc.'"><font size="+2">'.
   &mt('Back to Source').'</font></a></p>'.    &mt('Back to Source').'</font></a></p>'.
            '<p><a href="'.$thissrcdir.             '<p><a href="'.$thissrcdir.
                    '"><font size="+2">'.                     '"><font size="+2">'.
   &mt('Back to Source Directory').'</font></a></p>');    &mt('Back to Source Directory').'</font></a></p>');
     }      }
     return '<p><font color="green">'.&mt('Done').'</font></p>';      $logfile->close();
       $r->print('<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;      my $thisdisfn=$srcfile;
Line 1637  sub batchpublish { Line 1801  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 1660  sub publishdirectory { Line 1824  sub publishdirectory {
       &mt('Target').': <tt>'.$resdir.'</tt><br />');        &mt('Target').': <tt>'.$resdir.'</tt><br />');
   
     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('<form name="pubdirpref" method="post">'.
     foreach my $filename (@files) {    &hiddenfield('phase','two').
  my ($cdev,$cino,$cmode,$cnlink,    &hiddenfield('filename',$env{'form.filename'}).
             $cuid,$cgid,$crdev,$csize,    &checkbox('pubrec','include subdirectories').
             $catime,$cmtime,$cctime,    &checkbox('forcerepub','force republication of previously published files').
             $cblksize,$cblocks)=stat($fn.'/'.$filename);                    &checkbox('obsolete','make file(s) obsolete').
     &checkbox('forceoverride','force directory level catalog information over existing').
  my $extension='';    '<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');
  if ($filename=~/\.(\w+)$/) { $extension=$1; }          $lock=0;
  if ($cmode&$dirptr) {      } else {
     if (($filename!~/^\./) && ($ENV{'form.pubrec'})) {          unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); }
  &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);  # actually publish things
     }   opendir(DIR,$fn);
  } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&   my @files=sort(readdir(DIR));
  ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {   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 1719  sub defaultmetapublish { Line 1903  sub defaultmetapublish {
     &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('Catalog Information Publication'));
     $r->print(&Apache::loncommon::bodytag('Catalog Information Publication'));  
   
 # ---------------------------------------------------------------- Write Source  # ---------------------------------------------------------------- Write Source
     my $copyfile=$target;      my $copyfile=$target;
Line 1740  sub defaultmetapublish { Line 1923  sub defaultmetapublish {
     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 1756  sub defaultmetapublish { Line 1939  sub defaultmetapublish {
     my $link=$fn;      my $link=$fn;
     $link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//;      $link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//;
     $r->print("<a href='$link'>".&mt('Back to Catalog Information').'</a>');      $r->print("<a href='$link'>".&mt('Back to Catalog Information').'</a>');
     $r->print('</body></html>');      $r->print(&Apache::loncommon::end_page());
     return OK;      return OK;
 }  }
 #########################################  #########################################
Line 1813  sub handler { Line 1996  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)=      ($cuname,$cudom)=
  &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));   &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
Line 1834  sub handler { Line 2020  sub handler {
   
     unless (($cuname) && ($cudom)) {      unless (($cuname) && ($cudom)) {
  $r->log_reason($cuname.' at '.$cudom.   $r->log_reason($cuname.' at '.$cudom.
        ' trying to publish file '.$ENV{'form.filename'}.         ' trying to publish file '.$env{'form.filename'}.
        ' ('.$fn.') - not authorized',          ' ('.$fn.') - not authorized', 
        $r->filename);          $r->filename); 
  return HTTP_NOT_ACCEPTABLE;   return HTTP_NOT_ACCEPTABLE;
     }      }
   
     unless (&Apache::lonnet::homeserver($cuname,$cudom)       my $home=&Apache::lonnet::homeserver($cuname,$cudom);
     eq $r->dir_config('lonHostID')) {      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.   $r->log_reason($cuname.' at '.$cudom.
        ' trying to publish file '.$ENV{'form.filename'}.         ' trying to publish file '.$env{'form.filename'}.
        ' ('.$fn.') - not homeserver ('.         ' ('.$fn.') - not homeserver ('.$home.')', 
        &Apache::lonnet::homeserver($cuname,$cudom).')',   
        $r->filename);          $r->filename); 
  return HTTP_NOT_ACCEPTABLE;   return HTTP_NOT_ACCEPTABLE;
     }      }
   
     $fn=~s/^http\:\/\/[^\/]+//;      $fn=~s{^http://[^/]+}{};
     $fn=~s/^\/\~(\w+)/\/home\/$1\/public_html/;      $fn=~s{^/~($match_username)}{/home/$1/public_html};
   
     my $targetdir='';      my $targetdir='';
     $docroot=$r->dir_config('lonDocRoot');       $docroot=$r->dir_config('lonDocRoot'); 
     if ($1 ne $cuname) {      if ($1 ne $cuname) {
  $r->log_reason($cuname.' at '.$cudom.   $r->log_reason($cuname.' at '.$cudom.
        ' trying to publish unowned file '.         ' trying to publish unowned file '.
        $ENV{'form.filename'}.' ('.$fn.')',          $env{'form.filename'}.' ('.$fn.')', 
        $r->filename);          $r->filename); 
  return HTTP_NOT_ACCEPTABLE;   return HTTP_NOT_ACCEPTABLE;
     } else {      } else {
Line 1869  sub handler { Line 2057  sub handler {
     unless (-e $fn) {       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>');      my $js='<script type="text/javascript">'.
     $r->print(&Apache::loncommon::bodytag('Resource Publication'));   &Apache::loncommon::browser_and_searcher_javascript().
    '</script>';
       $r->print(&Apache::loncommon::start_page('Resource Publication',$js));
   
   
     my $thisfn=$fn;      my $thisfn=$fn;
Line 1925  sub handler { Line 2111  sub handler {
     if ($fn=~/\/$/) {      if ($fn=~/\/$/) {
 # -------------------------------------------------------- This is a directory  # -------------------------------------------------------- This is a directory
  &publishdirectory($r,$fn,$thisdisfn);   &publishdirectory($r,$fn,$thisdisfn);
  $r->print('<hr><font size="+2">'.&mt('Done').'</font><br><a href="/priv/'   $r->print('<hr /><a href="/priv/'
   .$cuname.'/'.$thisdisfn    .$cuname.'/'.$thisdisfn
   .'">'.&mt('Return to Directory').'</a>');    .'">'.&mt('Return to Directory').'</a>');
   
Line 1935  sub handler { Line 2121  sub handler {
  $thisfn=~/\.(\w+)$/;   $thisfn=~/\.(\w+)$/;
  my $thistype=$1;   my $thistype=$1;
  my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);   my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
           if ($thistype eq 'page') {  $thisembstyle = 'rat'; }
  $r->print('<h2>'.&mt('Publishing').' '.   $r->print('<h2>'.&mt('Publishing').' '.
   &Apache::loncommon::filedescription($thistype).' <tt>');    &Apache::loncommon::filedescription($thistype).' <tt>');
   
Line 1945  ENDCAPTION Line 2132  ENDCAPTION
         $r->print('</tt></h2><b>'.&mt('Target').':</b> <tt>'.          $r->print('</tt></h2><b>'.&mt('Target').':</b> <tt>'.
   $thisdistarget.'</tt><br />');    $thisdistarget.'</tt><br />');
         
  if (($cuname ne $ENV{'user.name'})||($cudom ne $ENV{'user.domain'})) {   if (($cuname ne $env{'user.name'})||($cudom ne $env{'user.domain'})) {
     $r->print('<h3><font color="red">'.&mt('Co-Author').': '.      $r->print('<h3><font color="red">'.&mt('Co-Author').': '.
       $cuname.&mt(' at ').$cudom.'</font></h3>');        $cuname.&mt(' at ').$cudom.'</font></h3>');
  }   }
Line 1960  ENDDIFF Line 2147  ENDDIFF
       
 # ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.  # ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.
   
  unless ($ENV{'form.phase'} eq 'two') {   unless ($env{'form.phase'} eq 'two') {
     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,$thisfn);
       }
       unless ($errorcount) {
    my ($outstring,$error)=
       &publish($thisfn,$thistarget,$thisembstyle);
    $r->print('<hr />'.$outstring);
       } else {
    $r->print('<h3>'.
     &mt('The document contains errors and cannot be published.').
     '</h3>');
       }
  } else {   } else {
     $r->print('<hr />'.      &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget); 
     &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget));       $r->print('<hr />');
  }   }
     }      }
     $r->print('</body></html>');      $r->print(&Apache::loncommon::end_page());
   
     return OK;      return OK;
 }  }
Removed from v.1.162  
changed lines
  Added in v.1.238

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