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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.244 and 1.298

version 1.244, 2008/08/01 18:11:19 version 1.298, 2021/06/03 13:59:44
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();
Line 129  use Apache::lonlocal; Line 128  use Apache::lonlocal;
 use Apache::loncfile;  use Apache::loncfile;
 use LONCAPA::lonmetadata;  use LONCAPA::lonmetadata;
 use Apache::lonmsg;  use Apache::lonmsg;
 use vars qw(%metadatafields %metadatakeys);  use vars qw(%metadatafields %metadatakeys %addid $readit);
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
     
   
 my %addid;  
 my %nokey;  
   
 my $docroot;  my $docroot;
   
 my $cuname;  my $cuname;
Line 148  my $lock; Line 143  my $lock;
   
 =pod  =pod
   
   =over 4
   
 =item B<metaeval>  =item B<metaeval>
   
 Evaluates a string that contains metadata.  This subroutine  Evaluates a string that contains metadata.  This subroutine
Line 199  sub metaeval { Line 196  sub metaeval {
     if (defined($token->[2]->{'name'})) {       if (defined($token->[2]->{'name'})) { 
  $unikey.="\0".$token->[2]->{'name'};    $unikey.="\0".$token->[2]->{'name'}; 
     }      }
     foreach (@{$token->[3]}) {      foreach my $item (@{$token->[3]}) {
  $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};   $metadatafields{$unikey.'.'.$item}=$token->[2]->{$item};
  if ($metadatakeys{$unikey}) {   if ($metadatakeys{$unikey}) {
     $metadatakeys{$unikey}.=','.$_;      $metadatakeys{$unikey}.=','.$item;
  } else {   } else {
     $metadatakeys{$unikey}=$_;      $metadatakeys{$unikey}=$item;
  }   }
     }      }
     my $newentry=$parser->get_text('/'.$entry);      my $newentry=$parser->get_text('/'.$entry);
Line 264  sub metaread { Line 261  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 274  sub metaread { Line 272  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><br />';            .&mt('Processed file: [_1]',&Apache::loncfile::display($fn))
             .'</p>';
 }  }
   
 #########################################  #########################################
Line 290  sub coursedependencies { Line 289  sub coursedependencies {
     my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,      my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
        $aauthor,$regexp);         $aauthor,$regexp);
     my %courses=();      my %courses=();
     foreach (keys %evaldata) {      foreach my $item (keys(%evaldata)) {
  if ($_=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) {   if ($item=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) {
     $courses{$1}=1;      $courses{$1}=1;
         }          }
     }      }
Line 315  string which presents the form field (fo Line 314  string which presents the form field (fo
   
 =item B<textfield>  =item B<textfield>
   
   =item B<text_with_browse_field>
   
 =item B<hiddenfield>  =item B<hiddenfield>
   
   =item B<checkbox>
   
 =item B<selectbox>  =item B<selectbox>
   
 =back  =back
Line 379  sub selectbox { Line 382  sub selectbox {
     }      }
     my $selout="\n".&Apache::lonhtmlcommon::row_title($title)      my $selout="\n".&Apache::lonhtmlcommon::row_title($title)
               .'<select name="'.$name.'">';                .'<select name="'.$name.'">';
     foreach (@idlist) {      foreach my $id (@idlist) {
         $selout.='<option value=\''.$_.'\'';          $selout.='<option value="'.$id.'"';
         if ($_ eq $value) {          if ($id eq $value) {
     $selout.=' selected>'.&{$functionref}($_).'</option>';      $selout.=' selected="selected"';
  }          }
         else {$selout.='>'.&{$functionref}($_).'</option>';}          $selout.='>'.&{$functionref}($id).'</option>';
     }      }
     $selout.='</select>'.&Apache::lonhtmlcommon::row_closure();      $selout.='</select>'.&Apache::lonhtmlcommon::row_closure();
     return $selout;      return $selout;
Line 396  sub select_level_form { Line 399  sub select_level_form {
     if (!defined($value)) { $env{'form.'.$name}=0; }      if (!defined($value)) { $env{'form.'.$name}=0; }
     return  &Apache::loncommon::select_level_form($value,$name);      return  &Apache::loncommon::select_level_form($value,$name);
 }  }
   
   sub common_access {
       my ($name,$text,$options)=@_;
       return unless (ref($options) eq 'ARRAY');
       my $formname = 'pubdirpref';
       my $chkname = 'common'.$name;
       my $chkid = 'LC_'.$chkname;
       my $divid = $chkid.'div';
       my $customdivid = 'LC_customfile'; 
       my $selname = $chkname.'select';
       my $selid = $chkid.'select';
       my $selonchange;
       if ($name eq 'dist') {
           $selonchange = ' onchange="showHideCustom(this,'."'$customdivid'".');"';
       }
       my %lt = &Apache::lonlocal::texthash(
                                               'default' => 'System wide - can be used for any courses system wide',
                                               'domain'  => 'Domain only - use limited to courses in the domai',
                                               'custom'  => 'Customized right of use ...',
                                               'public'  => 'Public - no authentication or authorization required for use',
                                               'closed'  => 'Closed - XML source is closed to everyone',
                                               'open'    => 'Open - XML source is open to people who want to use it',
                                               'sel'     => 'Select',
                                           );
       my $output = <<"END";
   <br />
   <span class="LC_nobreak">
   <label>
   <input type="checkbox" name="commonaccess" value="$name" id="$chkid"  
   onclick="showHideAccess(this,'$divid');" />
   $text</label></span>
   <div id="$divid" style="padding:0;clear:both;margin:0;border:0;display:none">
   <select name="$selname" id="$selid" $selonchange>
   <option value="" selected="selected">$lt{'sel'}</option>
   END
       foreach my $val (@{$options}) {
           $output .= '<option value="'.$val.'">'.$lt{$val}.'</option>'."\n";
       }
       $output .= '
   </select>';
       if ($name eq 'dist') {
           $output .= <<"END";
   <div id="$customdivid" style="padding:0;clear:both;margin:0;border:0;display:none">
   <input type="text" name="commoncustomrights" size="60" value="" />
   <a href="javascript:openbrowser('$formname','commoncustomrights','rights');">
   $lt{'sel'}</a></div>
   END
       }
       $output .= '
   </div>
   ';
   }
   
 #########################################  #########################################
 #########################################  #########################################
   
Line 465  Currently undocumented Line 521  Currently undocumented
 #########################################  #########################################
 #########################################  #########################################
 sub set_allow {  sub set_allow {
     my ($allow,$logfile,$target,$tag,$oldurl)=@_;      my ($allow,$logfile,$target,$tag,$oldurl,$type)=@_;
     my $newurl=&urlfixup($oldurl,$target);      my $newurl=&urlfixup($oldurl,$target);
     my $return_url=$oldurl;      my $return_url=$oldurl;
     print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n";      print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n";
Line 477  sub set_allow { Line 533  sub set_allow {
  ($newurl !~ /^mailto:/i) &&   ($newurl !~ /^mailto:/i) &&
  ($newurl !~ /^(?:http|https|ftp):/i) &&   ($newurl !~ /^(?:http|https|ftp):/i) &&
  ($newurl !~ /^\#/)) {   ($newurl !~ /^\#/)) {
           if (($type eq 'src') || ($type eq 'href')) {
               if ($newurl =~ /^([^?]+)\?[^?]*$/) {
                   $newurl = $1;
               }
           }
  $$allow{&absoluteurl($newurl,$target)}=1;   $$allow{&absoluteurl($newurl,$target)}=1;
     }      }
     return $return_url;      return $return_url;
Line 691  sub fix_ids_and_indices { Line 752  sub fix_ids_and_indices {
                     $responsecounter=0;                      $responsecounter=0;
                 }                  }
                 if ($lctag=~/response$/) { $responsecounter++; }                  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}; }
Line 717  sub fix_ids_and_indices { Line 779  sub fix_ids_and_indices {
     foreach my $type ('src','href','background','bgimg') {      foreach my $type ('src','href','background','bgimg') {
  foreach my $key (keys(%parms)) {   foreach my $key (keys(%parms)) {
     if ($key =~ /^$type$/i) {      if ($key =~ /^$type$/i) {
                                   next if (($lctag eq 'img') && ($type eq 'src') && 
                                            ($parms{$key} =~ m{^data\:image/gif;base64,}));
  $parms{$key}=&set_allow(\%allow,$logfile,   $parms{$key}=&set_allow(\%allow,$logfile,
  $target,$tag,   $target,$tag,
  $parms{$key});   $parms{$key},$type);
     }      }
  }   }
     }      }
Line 776  sub fix_ids_and_indices { Line 840  sub fix_ids_and_indices {
  }   }
  my $newparmstring='';   my $newparmstring='';
  my $endtag='';   my $endtag='';
  foreach (keys %parms) {   foreach my $parkey (keys(%parms)) {
     if ($_ eq '/') {      if ($parkey eq '/') {
  $endtag=' /';   $endtag=' /';
     } else {       } else { 
  my $quote=($parms{$_}=~/\"/?"'":'"');   my $quote=($parms{$parkey}=~/\"/?"'":'"');
  $newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote;   $newparmstring.=' '.$parkey.'='.$quote.$parms{$parkey}.$quote;
     }      }
  }   }
  if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }   if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
  $outstring.='<'.$tag.$newparmstring.$endtag.'>';   $outstring.='<'.$tag.$newparmstring.$endtag.'>';
  if ($lctag eq 'm' || $lctag eq 'script' || $lctag eq 'answer'    if ($lctag eq 'm' || $lctag eq 'answer' || $lctag eq 'display' ||
                     || $lctag eq 'display' || $lctag eq 'tex') {                      $lctag eq 'tex') {
     $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);      $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);
  }                  } elsif ($lctag eq 'script') {
                       if ($parms{'type'} eq 'loncapa/perl') {
                           $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);
                       } else {
                           my $script = &get_all_text_unbalanced('/'.$lctag,\@parser);
                           if ($script =~ m{\.set\w+(Src|Swf)\(["']}i) {
                               my @srcs = split(/\.set/i,$script);
                               if (scalar(@srcs) > 1) {
                                   foreach my $item (@srcs) {
                                       if ($item =~ m{^(FlashPlayerSwf|MediaSrc|XMPSrc|ConfigurationSrc|PosterImageSrc)\((['"])(?:(?!\2).)+\2\)}is) {
                                           my $srctype = $1;
                                           my $quote = $2;
                                           my ($url) = ($item =~ m{^\Q$srctype($quote\E([^$quote]+)\Q$quote)\E});
                                           $url = &urlfixup($url);
                                           unless ($url=~m{^(?:http|https|ftp)://}) {
                                               $allow{&absoluteurl($url,$target)}=1;
                                               if ($srctype eq 'ConfigurationSrc') {
                                                   if ($url =~ m{^(.+/)configuration_express\.xml$}) {
   #
   # Camtasia 8.1: express_show/spritesheet.png needed, and included in zip archive.
   # Not referenced directly in <main>.html or <main>_player.html files,
   # so add this file to %allow (where <main> is name user gave to file/archive).
   #
                                                       my $spritesheet = $1.'express_show/spritesheet.png';
                                                       $allow{&absoluteurl($spritesheet,$target)}=1;
   
   #
   # Camtasia 8.4: skins/express_show/spritesheet.min.css needed, and included in zip archive.
   # Not referenced directly in <main>.html or <main>_player.html files,
   # so add this file to %allow (where <main> is name user gave to file/archive).
   #
                                                       my $spritecss = $1.'express_show/spritesheet.min.css';
                                                       $allow{&absoluteurl($spritecss,$target)}=1;
                                                   }
                                               } elsif ($srctype eq 'PosterImageSrc') {
                                                   if ($url =~ m{^(.+)_First_Frame\.png$}) {
                                                       my $prefix = $1;
   #
   # Camtasia 8.1: <main>_Thumbnails.png needed, and included in zip archive.
   # Not referenced directly in <main>.html or <main>_player.html files,
   # so add this file to %allow (where <main> is name user gave to file/archive).
   #
                                                       my $thumbnail = $prefix.'_Thumbnails.png';
                                                       $allow{&absoluteurl($thumbnail,$target)}=1;
                                                   }
                                               }
                                           }
                                       }
                                   }
                               }
                           }
                           if ($script =~ m{\.addMediaSrc\((["'])((?!\1).+)\1\);}) {
                               my $src = $2;
                               if ($src) {
                                   my $url = &urlfixup($src);
                                   unless ($url=~m{^(?:http|https|ftp)://}) {
                                       $allow{&absoluteurl($url,$target)}=1;
                                   }
                               }
                           }
                           if ($script =~ /\(document,\s*(['"])script\1,\s*\[([^\]]+)\]\);/s) {
                               my $scriptslist = $2;
                               my @srcs = split(/\s*,\s*/,$scriptslist);
                               foreach my $src (@srcs) {
                                   if ($src =~ /(["'])(?:(?!\1).)+\.js\1/) {
                                       my $quote = $1;
                                       my ($url) = ($src =~ m/\Q$quote\E([^$quote]+)\Q$quote\E/);
                                       $url = &urlfixup($url);
                                       unless ($url=~m{^(?:http|https|ftp)://}) {
                                           $allow{&absoluteurl($url,$target)}=1;
                                       }
                                   }
                               }
                           }
                           if ($script =~ m{loadScript\(\s*(['"])((?:(?!\1).)+\.js)\1,\s*function}is) {
                               my $src = $2;
                               if ($src) {
                                   my $url = &urlfixup($src);
                                   unless ($url=~m{^(?:http|https|ftp)://}) {
                                       $allow{&absoluteurl($url,$target)}=1;
                                   }
                               }
                           }
                           $outstring .= $script;
                       }
                   }
     } elsif ($token->[0] eq 'E') {      } elsif ($token->[0] eq 'E') {
  if ($token->[2]) {   if ($token->[2]) {
     unless ($token->[1] eq 'allow') {      unless ($token->[1] eq 'allow') {
Line 843  sub store_metadata { Line 992  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='<span class="LC_error">WARNING: Cannot connect to '.          $error='<span class="LC_error">'
             'database!</span>';                .&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 ='<span class="LC_error">WARNING: The metadata table does not '.          $error ='<span class="LC_error">'
             'exist in the LON-CAPA database.</span>';                 .&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);
     }      }
Line 866  sub store_metadata { Line 1017  sub store_metadata {
                                                          \%metadata);                                                           \%metadata);
     }      }
     if (defined($status) && $status ne '') {      if (defined($status) && $status ne '') {
         $error='<span class="LC_error">Error occured saving new values in '.          $error='<span class="LC_error">'
             'metadata table in LON-CAPA database</span>';                .&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);
Line 940  backup copies, performs any automatic pr Line 1092  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 951  I<Additional documentation needed.> Line 1103  I<Additional documentation needed.>
 #########################################  #########################################
 sub publish {  sub publish {
   
     my ($source,$target,$style,$batch)=@_;      my ($source,$target,$style,$batch,$nokeyref)=@_;
     my $logfile;      my $logfile;
     my $scrout='';      my $scrout='';
     my $allmeta='';      my $allmeta='';
Line 983  sub publish { Line 1135  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 my $thisdep (sort(keys(%allow))) {          foreach my $thisdep (sort(keys(%allow))) {
    if ($thisdep !~ /[^\s]/) { next; }     if ($thisdep !~ /[^\s]/) { next; }
            if ($thisdep =~/\$/) {             if ($thisdep =~/\$/) {
               $scrout.='<br /><span class="LC_warning">'                $outdep.='<div class="LC_warning">'
                        .&mt('The resource depends on another resource with variable filename, i.e., [_1].','<tt>'.$thisdep.'</tt>').'<br />'                         .&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>')                         .&mt('You likely need to explicitly allow access to all possible dependencies using the [_1]-tag.','<tt>&lt;allow&gt;</tt>')
                        .'</span><br />';                         ."</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.= ' - <span class="LC_error">'.&mt('Currently not available').     $outdep.= ' - <span class="LC_error">'.&mt('Currently not available').
        '</span>';         '</span>';
                } else {                 } else {
   #
   # Store the fact that the dependency has been used by the target file
   # Unfortunately, usage is erroneously named sequsage in lonmeta.pm
   # The translation happens in lonmetadata.pm
   #
                    my %temphash=(&Apache::lonnet::declutter($target).'___'.                     my %temphash=(&Apache::lonnet::declutter($target).'___'.
                              &Apache::lonnet::declutter($thisdep).'___usage'                               &Apache::lonnet::declutter($thisdep).'___usage'
                                  => time);                                   => time);
Line 1019  sub publish { Line 1176  sub publish {
    }     }
        }         }
            }             }
              $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 1048  sub publish { Line 1211  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>';
     }      }
Line 1066  sub publish { Line 1229  sub publish {
 # ------------------------------------------------ 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|^\.\./||;
         }          }
Line 1087  sub publish { Line 1250  sub publish {
   
 # ------------------- Clear out parameters and stores (there should not be any)  # ------------------- Clear out parameters and stores (there should not be any)
   
         foreach (keys %metadatafields) {          foreach my $field (keys(%metadatafields)) {
     if (($_=~/^parameter/) || ($_=~/^stores/)) {      if (($field=~/^parameter/) || ($field=~/^stores/)) {
  delete $metadatafields{$_};   delete $metadatafields{$field};
             }              }
         }          }
   
Line 1098  sub publish { Line 1261  sub publish {
   
         $scrout.=&metaread($logfile,$source.'.meta');          $scrout.=&metaread($logfile,$source.'.meta');
   
         foreach (keys %metadatafields) {          foreach my $field (keys(%metadatafields)) {
     if (($_=~/^parameter/) || ($_=~/^stores/)) {      if (($field=~/^parameter/) || ($field=~/^stores/)) {
                 $oldparmstores{$_}=1;                  $oldparmstores{$field}=1;
  delete $metadatafields{$_};   delete $metadatafields{$field};
             }              }
         }          }
 # ------------------------------------------------------------- Save some stuff  # ------------------------------------------------------------- Save some stuff
         my %savemeta=();          my %savemeta=();
         foreach ('title') {          if ($metadatafields{'title'}) { $savemeta{'title'}=$metadatafields{'title'}; }
             $savemeta{$_}=$metadatafields{$_};  
  }  
 # ------------------------------------------ See if anything new in file itself  # ------------------------------------------ See if anything new in file itself
     
  $allmeta=&parseformeta($source,$style);   $allmeta=&parseformeta($source,$style);
 # ----------------------------------------------------------- Restore the stuff  # ----------------------------------------------------------- Restore the stuff
         foreach (keys %savemeta) {          foreach my $item (keys(%savemeta)) {
     $metadatafields{$_}=$savemeta{$_};      $metadatafields{$item}=$savemeta{$item};
  }   }
    }     }
   
Line 1122  sub publish { Line 1283  sub publish {
 # ---------------- Find and document discrepancies in the parameters and stores  # ---------------- Find and document discrepancies in the parameters and stores
   
     my $chparms='';      my $chparms='';
     foreach (sort keys %metadatafields) {      foreach my $field (sort(keys(%metadatafields))) {
  if (($_=~/^parameter/) || ($_=~/^stores/)) {   if (($field=~/^parameter/) || ($field=~/^stores/)) {
     unless ($_=~/\.\w+$/) {       unless ($field=~/\.\w+$/) {
  unless ($oldparmstores{$_}) {   unless ($oldparmstores{$field}) {
     my $disp_key = $_;      my $disp_key = $field;
     $disp_key =~ tr/\0/_/;      $disp_key =~ tr/\0/_/;
     print $logfile ('New: '.$disp_key."\n");      print $logfile ('New: '.$disp_key."\n");
     $chparms .= $disp_key.' ';      $chparms .= $disp_key.' ';
Line 1140  sub publish { Line 1301  sub publish {
     }      }
   
     $chparms='';      $chparms='';
     foreach (sort keys %oldparmstores) {      foreach my $olditem (sort(keys(%oldparmstores))) {
  if (($_=~/^parameter/) || ($_=~/^stores/)) {   if (($olditem=~/^parameter/) || ($olditem=~/^stores/)) {
     unless (($metadatafields{$_.'.name'}) ||      unless (($metadatafields{$olditem.'.name'}) ||
     ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {      ($metadatafields{$olditem.'.package'}) || ($olditem=~/\.\w+$/)) {
  my $disp_key = $_;   my $disp_key = $olditem;
  $disp_key =~ tr/\0/_/;   $disp_key =~ tr/\0/_/;
  print $logfile ('Obsolete: '.$disp_key."\n");   print $logfile ('Obsolete: '.$disp_key."\n");
  $chparms.=$disp_key.' ';   $chparms.=$disp_key.' ';
Line 1152  sub publish { Line 1313  sub publish {
  }   }
     }      }
     if ($chparms) {      if ($chparms) {
  $scrout.='<p><b>'.&mt('Obsolete parameters or saved values').':</b> '.          $scrout.='<p><b>'.&mt('Obsolete parameters or saved values').':</b> '
     $chparms.'</p><h1><span class="LC_warning">'.&mt('Warning!').          .$chparms.'</p>'
     '</span></h1><p><span class="LC_warning">'.                  .'<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.').'</span></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') {      if ($metadatafields{'copyright'} eq 'priv') {
         $scrout.='</p><h1><span class="LC_warning">'.&mt('Warning!').          $scrout.='<p class="LC_warning"><b>'.&mt('Warning!').'</b><br />'
             '</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.')
             &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 />';                  .'</p><hr />';
     }      }
   
 # ------------------------------------------------------- Now have all metadata  # ------------------------------------------------------- Now have all metadata
Line 1172  sub publish { Line 1334  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 ($nokeyref->{$_}) {
                   $keywords{$_}=1;
               }
           }
   
   
       }
                           
     foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {      foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {
  $addkey=~s/\s+/ /g;   $addkey=~s/\s+/ /g;
Line 1203  sub publish { Line 1370  sub publish {
     my $intr_scrout.='<br />'      my $intr_scrout.='<br />'
                     .'<form name="pubform" action="/adm/publish" method="post">';                      .'<form name="pubform" action="/adm/publish" method="post">';
     unless ($env{'form.makeobsolete'}) {      unless ($env{'form.makeobsolete'}) {
        $intr_scrout.='<p>'         $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.')                      .&mt('Searching for your resource will be based on the following metadata. Please provide as much data as possible.')
                     .'</p>'                      .'</p>'
                     .'<p><input type="submit" value="'                      .'<p><input type="submit" value="'
                     .&mt('Finalize Publication')                      .&mt('Finalize Publication')
                     .'" /></p>';                      .'" /> <a href="'.&Apache::loncfile::url($source).'">'.&mt('Cancel').'</a></p>';
     }      }
     $intr_scrout.=&Apache::lonhtmlcommon::start_pick_box();      $intr_scrout.=&Apache::lonhtmlcommon::start_pick_box();
     $intr_scrout.=      $intr_scrout.=
  &hiddenfield('phase','two').   &hiddenfield('phase','two').
  &hiddenfield('filename',$env{'form.filename'}).   &hiddenfield('filename',$env{'form.filename'}).
  &hiddenfield('allmeta',&escape($allmeta)).   &hiddenfield('allmeta',&escape($allmeta)).
  &hiddenfield('dependencies',join(',',keys %allow));   &hiddenfield('dependencies',join(',',keys(%allow)));
     unless ($env{'form.makeobsolete'}) {      unless ($env{'form.makeobsolete'}) {
        $intr_scrout.=         $intr_scrout.=
  &textfield('Title','title',$metadatafields{'title'}).   &textfield('Title','title',$metadatafields{'title'}).
Line 1242  END Line 1409  END
                 .'<input type="button" value="'.&mt('check all').'" onclick="javascript:checkAll(document.pubform.keywords)" />'                  .'<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)" />'                  .'<input type="button" value="'.&mt('uncheck all').'" onclick="javascript:uncheckAll(document.pubform.keywords)" />'
                 .'</p><br />'                  .'</p><br />'
                 .&Apache::loncommon::start_data_table()                  .&Apache::loncommon::start_data_table();
                 .&Apache::loncommon::start_data_table_row();      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))) {
  $colcount++;          if ($colcount == 0) {
  $keywordout.='<td><label><input type="checkbox" name="keywords" value="'.$_.'"';              $keywordout .= &Apache::loncommon::start_data_table_row();
  if ($metadatafields{'keywords'}) {          }
     if ($metadatafields{'keywords'}=~/\Q$_\E/) {          $colcount++;
  $keywordout.=' checked="on"';          $wordcount++;
  $env{'form.keywords'}.=$_.',';          if (($wordcount == $numkeywords) && ($colcount < $cols_per_row)) {
     }              my $colspan = 1+$cols_per_row-$colcount;
  } elsif (&Apache::loncommon::keyword($_)) {              $keywordout .= '<td colspan="'.$colspan.'">';
     $keywordout.=' checked="on"';          } else {
     $env{'form.keywords'}.=$_.',';              $keywordout .= '<td>';
  }          }
  $keywordout.=' />'.$_.'</label></td>';          $keywordout.='<label><input type="checkbox" name="keywords" value="'.$word.'"';
  if ($colcount>=10) {          if ($metadatafields{'keywords'}) {
     $keywordout.=&Apache::loncommon::end_data_table_row()              if ($metadatafields{'keywords'}=~/\Q$word\E/) {
                         .&Apache::loncommon::start_data_table_row();                  $keywordout.=' checked="checked"';
     $colcount=0;                  $env{'form.keywords'}.=$word.',';
  }              }
     }          } elsif (&Apache::loncommon::keyword($word)) {
     # Proper end of started table row:              $keywordout.=' checked="checked"';
     if ($colcount != 0) { # has still to be improved: if amount of keywords mod 10 == 0, then do not start another table row              $env{'form.keywords'}.=$word.',';
         while ($colcount<10) {          }
             $keywordout.='<td>&nbsp;</td>';          $keywordout.=' />'.$word.'</label></td>';
             $colcount++;          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/\,$//;      $env{'form.keywords'}=~s/\,$//;
   
Line 1376  END Line 1549  END
  (&Apache::loncommon::source_copyrightids));   (&Apache::loncommon::source_copyrightids));
 # $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights');  # $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights');
  my $uctitle=&mt('Obsolete');   my $uctitle=&mt('Obsolete');
         my $obsolete_checked=($metadatafields{'obsolete'})?' checked="1" ':'';          my $obsolete_checked=($metadatafields{'obsolete'})?' checked="checked"':'';
         $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title($uctitle)          $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title($uctitle)
                      .'<input type="checkbox" name="obsolete" '.$obsolete_checked.'/ >'                       .'<input type="checkbox" name="obsolete"'.$obsolete_checked.' />'
                      .&Apache::lonhtmlcommon::row_closure(1);                       .&Apache::lonhtmlcommon::row_closure(1);
         $intr_scrout.=&text_with_browse_field('Suggested Replacement for Obsolete File',          $intr_scrout.=&text_with_browse_field('Suggested Replacement for Obsolete File',
     'obsoletereplacement',      'obsoletereplacement',
Line 1421  END Line 1594  END
     return($scrout,0);      return($scrout,0);
 }  }
   
   sub getnokey {
       my ($includedir) = @_;
       my $nokey={};
       my $fh=Apache::File->new($includedir.'/un_keyword.tab');
       while (<$fh>) {
           my $word=$_;
           chomp($word);
           $nokey->{$word}=1;
       }
       return $nokey;
   }
   
 #########################################  #########################################
 #########################################  #########################################
   
Line 1443  Parameters: Line 1628  Parameters:
   
 =item I<$distarget>  =item I<$distarget>
   
   =item I<$batch>
   
   =item I<$usebuffer>
   
 =back  =back
   
 Returns:  Returns:
   
 =over 4  =over 4
   
 =item integer  =item integer or array
   
   if $userbuffer arg is true, and if caller wants an array
   then the array ($output,$rtncode) will be returned, otherwise
   just the $rtncode will be returned.  $rtncode is an integer:
   
 0: fail  0: fail
 1: success  1: success
   
   =back
   
 =cut  =cut
   
 #'stupid emacs  #'stupid emacs
Line 1461  Returns: Line 1656  Returns:
 #########################################  #########################################
 sub phasetwo {  sub phasetwo {
   
     my ($r,$source,$target,$style,$distarget,$batch)=@_;      my ($r,$source,$target,$style,$distarget,$batch,$usebuffer)=@_;
     $source=~s/\/+/\//g;      $source=~s/\/+/\//g;
     $target=~s/\/+/\//g;      $target=~s/\/+/\//g;
 #  #
 # Unless trying to get rid of something, check name validity  # Unless trying to get rid of something, check name validity
 #  #
       my $output;
     unless ($env{'form.obsolete'}) {      unless ($env{'form.obsolete'}) {
  if ($target=~/(\_\_\_|\&\&\&|\:\:\:)/) {   if ($target=~/(\_\_\_|\&\&\&|\:\:\:)/) {
     $r->print('<span class="LC_error">'.      $output = '<span class="LC_error">'.
       &mt('Unsupported character combination [_1] in filename, FAIL.',"<tt>'.$1.'</tt>").        &mt('Unsupported character combination [_1] in filename, FAIL.',"<tt>'.$1.'</tt>").
       '</span>');        '</span>';
     return 0;              if ($usebuffer) {
                   if (wantarray) { 
                       return ($output,0);
                   } else {
                       return 0;
                   }
               } else {
                   $r->print($output);
           return 0;
               }
  }   }
  unless ($target=~/\.(\w+)$/) {   unless ($target=~/\.(\w+)$/) {
     $r->print('<span class="LC_error">'.&mt('No valid extension found in filename, FAIL').'</span>');              $output = '<span class="LC_error">'.&mt('No valid extension found in filename, FAIL').'</span>'; 
     return 0;              if ($usebuffer) {
                   if (wantarray) {
                       return ($output,0);
                   } else {
                       return 0;
                   }
               } else {
           $r->print($output);
           return 0;
               }
  }   }
  if ($target=~/\.(\d+)\.(\w+)$/) {   if ($target=~/\.(\d+)\.(\w+)$/) {
     $r->print('<span class="LC_error">'.&mt('Cannot publish versioned resource, FAIL').'</span>');      $output = '<span class="LC_error">'.&mt('Filename of resource contains internal version number. Cannot publish such resources, FAIL').'</span>';
     return 0;              if ($usebuffer) {
                   if (wantarray) {
                       return ($output,0);
                   } else {
                       return 0;
                   }
               } else { 
                   $r->print($output);
           return 0;
               }
  }   }
     }      }
   
Line 1490  sub phasetwo { Line 1713  sub phasetwo {
     $distarget=~s/\/+/\//g;      $distarget=~s/\/+/\//g;
     my $logfile;      my $logfile;
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
  $r->print(          $output = '<span class="LC_error">'.
         '<span class="LC_error">'.    &mt('No write permission to user directory, FAIL').'</span>';
  &mt('No write permission to user directory, FAIL').'</span>');          if ($usebuffer) {
         return 0;              if (wantarray) {
                   return ($output,0);
               } else {
                   return 0;
               }
           } else {
               return 0;
           }
     }      }
           
     if ($source =~ /\.rights$/) {      if ($source =~ /\.rights$/) {
  $r->print('<p><span class="LC_warning">'.&mt('Warning: It can take up to 1 hour for rights changes to fully propagate.').'</span></p>');   $output = '<p><span class="LC_warning">'.&mt('Warning: It can take up to 1 hour for rights changes to fully propagate.').'</span></p>';
           unless ($usebuffer) {
               $r->print($output);
               $output = ''; 
           }
     }      }
   
     print $logfile       print $logfile 
Line 1507  sub phasetwo { Line 1741  sub phasetwo {
     %metadatakeys=();      %metadatakeys=();
   
     &metaeval(&unescape($env{'form.allmeta'}));      &metaeval(&unescape($env{'form.allmeta'}));
       
       if ($batch) {
           my %commonaccess;
           map { $commonaccess{$_} = 1; } &Apache::loncommon::get_env_multiple('form.commonaccess');
           if ($commonaccess{'dist'}) {
               unless ($style eq 'prv') { 
                   if ($env{'form.commondistselect'} eq 'custom') {
                       unless ($source =~ /\.rights$/) {
                           if ($env{'form.commoncustomrights'} =~ m{^/res/.+\.rights$}) { 
                               $env{'form.customdistributionfile'} = $env{'form.commoncustomrights'}; 
                               $env{'form.copyright'} = $env{'form.commondistselect'};
                           }
                       }
                   } elsif ($env{'form.commondistselect'} =~ /^default|domain|public$/) {
                       $env{'form.copyright'} = $env{'form.commondistselect'};
                   }
               }
           }
           unless ($style eq 'prv') {
               if ($commonaccess{'source'}) {
                   if (($env{'form.commonsourceselect'} eq 'open') || ($env{'form.commonsourceselect'} eq 'closed')) {
                       $env{'form.sourceavail'} = $env{'form.commonsourceselect'};
                   }
               }
           }
       }
   
     $metadatafields{'title'}=$env{'form.title'};      $metadatafields{'title'}=$env{'form.title'};
     $metadatafields{'author'}=$env{'form.author'};      $metadatafields{'author'}=$env{'form.author'};
     $metadatafields{'subject'}=$env{'form.subject'};      $metadatafields{'subject'}=$env{'form.subject'};
Line 1553  sub phasetwo { Line 1813  sub phasetwo {
     if ($metadatafields{'copyright'} eq 'custom') {      if ($metadatafields{'copyright'} eq 'custom') {
  my $file=$metadatafields{'customdistributionfile'};   my $file=$metadatafields{'customdistributionfile'};
  unless ($file=~/\.rights$/) {   unless ($file=~/\.rights$/) {
             $r->print(              $output .= '<span class="LC_error">'.&mt('No valid custom distribution rights file specified, FAIL').
                 '<span class="LC_error">'.&mt('No valid custom distribution rights file specified, FAIL').         '</span>';
  '</span>');              if ($usebuffer) {
     return 0;                  if (wantarray) {
                       return ($output,0);
                   } else {
                       return 0;
                   }
               } else {
                   $r->print($output);
           return 0;
               }
         }          }
     }      }
     {      {
         print $logfile "\nWrite metadata file for ".$source;          print $logfile "\nWrite metadata file for ".$source;
         my $mfh;          my $mfh;
         unless ($mfh=Apache::File->new('>'.$source.'.meta')) {          unless ($mfh=Apache::File->new('>'.$source.'.meta')) {
             $r->print(               $output .= '<span class="LC_error">'.&mt('Could not write metadata, FAIL').
                 '<span class="LC_error">'.&mt('Could not write metadata, FAIL').         '</span>';
  '</span>');              if ($usebuffer) {
     return 0;                  if (wantarray) {
         }                      return ($output,0);
         foreach (sort keys %metadatafields) {                  } else {
             unless ($_=~/\./) {                      return 0;
                 my $unikey=$_;                  }
               } else {
                   $r->print($output);
           return 0;
               }
           }
           foreach my $field (sort(keys(%metadatafields))) {
               unless ($field=~/\./) {
                   my $unikey=$field;
                 $unikey=~/^([A-Za-z]+)/;                  $unikey=~/^([A-Za-z]+)/;
                 my $tag=$1;                  my $tag=$1;
                 $tag=~tr/A-Z/a-z/;                  $tag=~tr/A-Z/a-z/;
                 print $mfh "\n\<$tag";                  print $mfh "\n\<$tag";
                 foreach (split(/\,/,$metadatakeys{$unikey})) {                  foreach my $item (split(/\,/,$metadatakeys{$unikey})) {
                     my $value=$metadatafields{$unikey.'.'.$_};                      my $value=$metadatafields{$unikey.'.'.$item};
                     $value=~s/\"/\'\'/g;                      $value=~s/\"/\'\'/g;
                     print $mfh ' '.$_.'="'.$value.'"';                      print $mfh ' '.$item.'="'.$value.'"';
                 }                  }
                 print $mfh '>'.                  print $mfh '>'.
                     &HTML::Entities::encode($metadatafields{$unikey},'<>&"')                      &HTML::Entities::encode($metadatafields{$unikey},'<>&"')
                         .'</'.$tag.'>';                          .'</'.$tag.'>';
             }              }
         }          }
         $r->print('<p>'.&mt('Wrote Metadata').'</p>');  
           $output  .= '<p>'.&mt('Wrote Metadata').'</p>';
           unless ($usebuffer) {
               $r->print($output);
               $output = '';
           }
         print $logfile "\nWrote metadata";          print $logfile "\nWrote metadata";
     }      }
           
Line 1594  sub phasetwo { Line 1875  sub phasetwo {
     $metadatafields{'url'} = $distarget;      $metadatafields{'url'} = $distarget;
     $metadatafields{'version'} = 'current';      $metadatafields{'version'} = 'current';
   
     my ($error,$success) = &store_metadata(%metadatafields);      my $crsauthor;
     if ($success) {      if ($env{'request.course.id'}) {
  $r->print('<p>'.&mt('Synchronized SQL metadata database').'</p>');          my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
  print $logfile "\nSynchronized SQL metadata database";          my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
     } else {          if ($distarget =~ m{^/res/$cdom/$cnum}) {
  $r->print($error);              $crsauthor = 1;
  print $logfile "\n".$error;          }
       }
       unless ($crsauthor) {
           my ($error,$success) = &store_metadata(%metadatafields);
           if ($success) {
       $output .= '<p>'.&mt('Synchronized SQL metadata database').'</p>';
       print $logfile "\nSynchronized SQL metadata database";
           } else {
       $output .= $error;
       print $logfile "\n".$error;
           }
           unless ($usebuffer) {
               $r->print($output);
               $output = '';
           }
     }      }
 # --------------------------------------------- Delete author resource messages  # --------------------------------------------- Delete author resource messages
     my $delresult=&Apache::lonmsg::del_url_author_res_msg($target);       my $delresult=&Apache::lonmsg::del_url_author_res_msg($target); 
     $r->print('<p>'.&mt('Removing error messages:').' '.$delresult.'</p>');      $output .= '<p>'.&mt('Removing error messages:').' '.$delresult.'</p>';
       unless ($usebuffer) {
           $r->print($output);
           $output = '';
       }
     print $logfile "\nRemoving error messages: $delresult";      print $logfile "\nRemoving error messages: $delresult";
 # ----------------------------------------------------------- Copy old versions  # ----------------------------------------------------------- Copy old versions
         
Line 1615  sub phasetwo { Line 1914  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;
             $r->print(              $output .= 
  "<span class=\"LC_error\">".&mt('Invalid target directory, FAIL')."</span>");   "<span class=\"LC_error\">".&mt('Invalid target directory, FAIL')."</span>";
     return 0;              if ($usebuffer) {
                   if (wantarray) {
                       return ($output,0);
                   } else {
                       return 0;
                   }
               } else {
                   $r->print($output);
           return 0;
               }
         }          }
         opendir(DIR,$srcd);          opendir(DIR,$srcd);
         while ($filename=readdir(DIR)) {          while ($filename=readdir(DIR)) {
Line 1627  sub phasetwo { Line 1936  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>');          $output .= '<p>'.&mt('Creating old version [_1]',$maxversion).'</p>';
           unless ($usebuffer) {
               $r->print($output);
               $output = '';
           }
         print $logfile "\nCreating old version ".$maxversion."\n";          print $logfile "\nCreating old version ".$maxversion."\n";
                   
         my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;          my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;
                   
         if (copy($target,$copyfile)) {          if (copy($target,$copyfile)) {
     print $logfile "Copied old target to ".$copyfile."\n";      print $logfile "Copied old target to ".$copyfile."\n";
             $r->print('<p>'.&mt('Copied old target file').'</p>');              $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied old target file'));
               unless ($usebuffer) {
                   $r->print($output);
                   $output = '';
               }
         } else {          } else {
     print $logfile "Unable to write ".$copyfile.':'.$!."\n";      print $logfile "Unable to write ".$copyfile.':'.$!."\n";
             $r->print("<span class=\"LC_error\">".&mt('Failed to copy old target').              $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1);
  ", $!, ".&mt('FAIL')."</span>");              if ($usebuffer) {
     return 0;                  if (wantarray) {
                       return ($output,0);
                   } else {
                       return 0;
                   }
               } else {
                   $r->print($output); 
           return 0;
               }
         }          }
                   
 # --------------------------------------------------------------- Copy Metadata  # --------------------------------------------------------------- Copy Metadata
Line 1655  sub phasetwo { Line 1980  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>')              $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata'));
               unless ($usebuffer) {
                   $r->print($output);
                   $output = '';
               }
         } else {          } else {
     print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";      print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
             if (-e $target.'.meta') {              if (-e $target.'.meta') {
                 $r->print(                   $output .= &Apache::lonhtmlcommon::confirm_success(
                     "<span class=\"LC_error\">".                                 &mt('Failed to write old metadata copy').", $!",1);
 &mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')."</span>");                  if ($usebuffer) {
  return 0;                      if (wantarray) {
                           return ($output,0);
                       } else {
                           return 0;
                       }
                   } else {
                       $r->print($output);
                       return 0;
                   }
     }      }
         }          }
           
           
     } else {      } else {
         $r->print('<p>'.&mt('Initial version').'</p>');          $output .= '<p>'.&mt('Initial version').'</p>';
           unless ($usebuffer) {
               $r->print($output);
               $output = '';
           }
         print $logfile "\nInitial version";          print $logfile "\nInitial version";
     }      }
   
Line 1683  sub phasetwo { Line 2022  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);
               $output .= '<p>'
                         .&mt('Created directory [_1]'
                              ,'<span class="LC_filename">'.$parts[$count].'</span>')
                         .'</p>';
               unless ($usebuffer) {
                   $r->print($output);
                   $output = '';
               }
         }          }
     }      }
           
     if (copy($source,$copyfile)) {      if (copy($source,$copyfile)) {
         print $logfile "\nCopied original source to ".$copyfile."\n";          print $logfile "\nCopied original source to ".$copyfile."\n";
         $r->print('<p>'.&mt('Copied source file').'</p>');          $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied source file'));
           unless ($usebuffer) {
               $r->print($output);
               $output = '';
           }
     } else {      } else {
         print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";          print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
         $r->print("<span class=\"LC_error\">".          $output .= &Apache::lonhtmlcommon::confirm_success(
     &mt('Failed to copy source').", $!, ".&mt('FAIL')."</span>");      &mt('Failed to copy source').", $!",1);
  return 0;          if ($usebuffer) {
               if (wantarray) {
                   return ($output,0);
               } else {
                   return 0;
               }
           } else {
               $r->print($output);
               return 0;
           }
     }      }
           
   # ---------------------------------------------- Delete local tmp-preview files
       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>');          $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied metadata'));
           unless ($usebuffer) {
               $r->print($output);
               $output = '';
           }
     } else {      } else {
         print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";          print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
         $r->print(          $output .= &Apache::lonhtmlcommon::confirm_success(
             "<span class=\"LC_error\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</span>");                       &mt('Failed to write metadata copy').", $!",1);
  return 0;          if ($usebuffer) {
               if (wantarray) {
                   return ($output,0);
               } else {
                   return 0;
               }
           } else {
               $r->print($output);
               return 0;
           }
       }
       unless ($usebuffer) {
           $r->rflush;
     }      }
     $r->rflush;  
   
 # ------------------------------------------------------------- Trigger updates  # ------------------------------------------------------------- Trigger updates
     push(@{$modified_urls},[$target,$source]);      push(@{$modified_urls},[$target,$source]);
     unless ($registered_cleanup) {      unless ($registered_cleanup) {
  $r->register_cleanup(\&notify);          my $handlers = $r->get_handlers('PerlCleanupHandler');
           $r->set_handlers('PerlCleanupHandler' => [\&notify,@{$handlers}]);
  $registered_cleanup=1;   $registered_cleanup=1;
     }      }
   
Line 1727  sub phasetwo { Line 2104  sub phasetwo {
     &Apache::lonnet::devalidate_cache_new('meta',      &Apache::lonnet::devalidate_cache_new('meta',
  &Apache::lonnet::declutter($thisdistarget));   &Apache::lonnet::declutter($thisdistarget));
   
   # ------------------------------------------------------------- Everything done
       $logfile->close();
       $output .= '<p class="LC_success">'.&mt('Done').'</p>';
       unless ($usebuffer) {
           $r->print($output);
           $output = '';
       }
   
 # ------------------------------------------------ Provide link to new resource  # ------------------------------------------------ Provide link to new resource
     unless ($batch) {      unless ($batch) {
                   
         my $thissrc=$source;          my $thissrc=&Apache::loncfile::url($source);
         $thissrc=~s{^/home/($match_username)/public_html}{/priv/$1};  
           
         my $thissrcdir=$thissrc;          my $thissrcdir=$thissrc;
         $thissrcdir=~s/\/[^\/]+$/\//;          $thissrcdir=~s/\/[^\/]+$/\//;
                   
                   $output .= 
         $r->print(              &Apache::lonhtmlcommon::actionbox([
            '<hr /><a href="'.$thisdistarget.'"><font size="+2">'.                  '<a href="'.$thisdistarget.'">'.
            &mt('View Published Version').'</font></a>'.                  &mt('View Published Version').
            '<p><a href="'.$thissrc.'"><font size="+2">'.                  '</a>',
   &mt('Back to Source').'</font></a></p>'.                  '<a href="'.$thissrc.'">'.
            '<p><a href="'.$thissrcdir.                  &mt('Back to Source').
                    '"><font size="+2">'.                  '</a>',
   &mt('Back to Source Directory').'</font></a></p>');                  '<a href="'.$thissrcdir.'">'.
                   &mt('Back to Source Directory').
                   '</a>']);
           unless ($usebuffer) {
               $r->print($output);
               $output = '';
           }
       }
   
       if ($usebuffer) {
           if (wantarray) {
               return ($output,1);
           } else {
               return 1;
           }
       } else {
           if (wantarray) {
               return ('',1);
           } else {
               return 1;
           }
     }      }
     $logfile->close();  
     $r->print('<p><font color="green">'.&mt('Done').'</font></p>');  
     return 1;  
 }  }
   
 # =============================================================== Notifications  # =============================================================== Notifications
Line 1775  sub notify { Line 2175  sub notify {
 # --------------------------------------------------- Notify subscribed courses  # --------------------------------------------------- Notify subscribed courses
  my %courses=&coursedependencies($target);   my %courses=&coursedependencies($target);
  my $now=time;   my $now=time;
  foreach (keys %courses) {   foreach my $course (keys(%courses)) {
     print $logfile "\nNotifying course ".$_.':';      print $logfile "\nNotifying course ".$course.':';
     my ($cdom,$cname)=split(/\_/,$_);      my ($cdom,$cname)=split(/\_/,$course);
     my $reply=&Apache::lonnet::cput      my $reply=&Apache::lonnet::cput
  ('versionupdate',{$target => $now},$cdom,$cname);   ('versionupdate',{$target => $now},$cdom,$cname);
     print $logfile $reply;      print $logfile $reply;
Line 1792  sub notify { Line 2192  sub notify {
 #########################################  #########################################
   
 sub batchpublish {  sub batchpublish {
     my ($r,$srcfile,$targetfile)=@_;      my ($r,$srcfile,$targetfile,$nokeyref,$usebuffer)=@_;
     #publication pollutes %env with form.* values      #publication pollutes %env with form.* values
     my %oldenv=%env;      my %oldenv=%env;
     $srcfile=~s/\/+/\//g;      $srcfile=~s/\/+/\//g;
     $targetfile=~s/\/+/\//g;      $targetfile=~s/\/+/\//g;
     my $thisdisfn=$srcfile;  
     $thisdisfn=~s/\/home\/korte\/public_html\///;  
     $srcfile=~s/\/+/\//g;  
   
     my $docroot=$r->dir_config('lonDocRoot');      my $docroot=$r->dir_config('lonDocRoot');
     my $thisdistarget=$targetfile;      my $thisdistarget=$targetfile;
Line 1814  sub batchpublish { Line 2211  sub batchpublish {
   
     my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);      my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
             
     $r->print('<h2>'.&mt('Publishing').' <tt>'.$thisdisfn.'</tt></h2>');      my $output = '<h2>'
                .&mt('Publishing [_1]',&Apache::loncfile::display($srcfile))
                .'</h2>';
       unless ($usebuffer) {
           $r->print($output);
           $output = '';
       }
   
 # phase one takes  # phase one takes
 #  my ($source,$target,$style,$batch)=@_;  #  my ($source,$target,$style,$batch)=@_;
     my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1);      my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1,$nokeyref);
     $r->print('<p>'.$outstring.'</p>');      
       if ($usebuffer) {
           $output .= '<p>'.$outstring.'</p>';
       } else {
           $r->print('<p>'.$outstring.'</p>');
       }
 # phase two takes  # phase two takes
 # my ($source,$target,$style,$distarget,batch)=@_;  # my ($source,$target,$style,$distarget,batch)=@_;
 # $env{'form.allmeta'},$env{'form.title'},$env{'form.author'},...  # $env{'form.allmeta'},$env{'form.title'},$env{'form.author'},...
     if (!$error) {      if (!$error) {
  $r->print('<p>');          if ($usebuffer) {
  &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);      my ($result,$error) = &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1,$usebuffer);
  $r->print('</p>');      $output .= '<p>'.$result.'</p>';
           } else {
               &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
           }
     }      }
     %env=%oldenv;      %env=%oldenv;
     return '';      if ($usebuffer) {
           return $output;
       } else {
           return '';
       } 
 }  }
   
 #########################################  #########################################
   
 sub publishdirectory {  sub publishdirectory {
     my ($r,$fn,$thisdisfn)=@_;      my ($r,$fn,$thisdisfn,$nokeyref)=@_;
     $fn=~s/\/+/\//g;      $fn=~s/\/+/\//g;
     $thisdisfn=~s/\/+/\//g;      $thisdisfn=~s/\/+/\//g;
     my $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('<form name="pubdirpref" method="post" action="">'
       &mt('Target').': <tt>'.$resdir.'</tt><br />');               .&Apache::lonhtmlcommon::start_pick_box()
                .&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') {      unless ($env{'form.phase'} eq 'two') {
 # ask user what they want  # ask user what they want
         $r->print('<form name="pubdirpref" method="post">'.          $r->print(&Apache::lonhtmlcommon::row_closure()
   &hiddenfield('phase','two').                   .&Apache::lonhtmlcommon::row_title(&mt('Options'))
           );
           $r->print(&hiddenfield('phase','two').
   &hiddenfield('filename',$env{'form.filename'}).    &hiddenfield('filename',$env{'form.filename'}).
   &checkbox('pubrec','include subdirectories').    &checkbox('pubrec','include subdirectories').
   &checkbox('forcerepub','force republication of previously published files').    &checkbox('forcerepub','force republication of previously published files').
                   &checkbox('obsolete','make file(s) obsolete').                    &checkbox('obsolete','make file(s) obsolete').
   &checkbox('forceoverride','force directory level catalog information over existing').    &checkbox('forceoverride','force directory level metadata over existing').
   '<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');                    &checkbox('excludeunpub','exclude currently unpublished files').
                     &common_access('dist',&mt('apply common copyright/distribution'),
                                    ['default','domain','custom']).
                     &common_access('source',&mt('apply common source availability'),
                                    ['closed','open'])
           );
           $r->print(&Apache::lonhtmlcommon::row_closure(1)
                    .&Apache::lonhtmlcommon::end_pick_box()
                    .'<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>'
           );
         $lock=0;          $lock=0;
     } else {      } else {
           $r->print(&Apache::lonhtmlcommon::row_closure(1)
                    .&Apache::lonhtmlcommon::end_pick_box()
           );
         unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); }          unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); }
 # actually publish things  # actually publish things
  opendir(DIR,$fn);   opendir(DIR,$fn);
Line 1871  sub publishdirectory { Line 2306  sub publishdirectory {
     if ($filename=~/\.(\w+)$/) { $extension=$1; }      if ($filename=~/\.(\w+)$/) { $extension=$1; }
     if ($cmode&$dirptr) {      if ($cmode&$dirptr) {
  if (($filename!~/^\./) && ($env{'form.pubrec'})) {   if (($filename!~/^\./) && ($env{'form.pubrec'})) {
     &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);      &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename,$nokeyref);
  }   }
     } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&      } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
      ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {       ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
 # find out publication status and/or exiting metadata  # find out publication status and/or existing metadata
  my $publishthis=0;   my $publishthis=0;
  if (-e $resdir.'/'.$filename) {   if (-e $resdir.'/'.$filename) {
     my ($rdev,$rino,$rmode,$rnlink,      my ($rdev,$rino,$rmode,$rnlink,
Line 1893  sub publishdirectory { Line 2328  sub publishdirectory {
     }      }
  } else {   } else {
 # never published  # never published
     $publishthis=1;      unless ($env{'form.excludeunpub'}) {
           $publishthis=1;
       }
  }   }
   
  if ($publishthis) {   if ($publishthis) {
     &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);      &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename,$nokeyref);
  } else {   } else {
     $r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');      $r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');
  }   }
Line 1913  sub publishdirectory { Line 2350  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(&Apache::loncommon::start_page('Catalog Information Publication'));      $r->print(&Apache::loncommon::start_page('Metadata Publication'));
   
 # ---------------------------------------------------------------- Write Source  # ---------------------------------------------------------------- Write Source
     my $copyfile=$target;      my $copyfile=$target;
Line 1936  sub defaultmetapublish { Line 2372  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>'
               );
         }          }
     }      }
           
Line 1957  sub defaultmetapublish { Line 2397  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("<a href='$link'>".&mt('Back to Catalog Information').'</a>');  
     $r->print(&Apache::loncommon::end_page());      $r->print(&Apache::loncommon::end_page());
     return OK;      return OK;
 }  }
Line 2023  sub handler { Line 2461  sub handler {
 # -------------------------------------------------------------- Check filename  # -------------------------------------------------------------- Check filename
   
     my $fn=&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{^/~($match_username)}{/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.')', 
Line 2083  sub handler { Line 2496  sub handler {
  return HTTP_NOT_FOUND;   return HTTP_NOT_FOUND;
     }       } 
   
 # -------------------------------- File is there and owned, init lookup tables.  # --------------------------------- File is there and owned, start page output
   
     %addid=();  
       
     {  
  my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');  
  while (<$fh>=~/(\w+)\s+(\w+)/) {  
     $addid{$1}=$2;  
  }  
     }  
   
     %nokey=();  
   
     {  
  my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');  
  while (<$fh>) {  
     my $word=$_;  
     chomp($word);  
     $nokey{$word}=1;  
  }  
     }  
   
 # ---------------------------------------------------------- Start page output.  
   
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
     $r->send_http_header;      $r->send_http_header;
           
       # Breadcrumbs
       &Apache::lonhtmlcommon::clear_breadcrumbs();
       &Apache::lonhtmlcommon::add_breadcrumb({
           'text'  => 'Authoring Space',
           'href'  => &Apache::loncommon::authorspace($fn),
       });
       &Apache::lonhtmlcommon::add_breadcrumb({
           'text'  => 'Resource Publication',
           'href'  => '',
       });
   
     my $js='<script type="text/javascript">'.      my $js='<script type="text/javascript">'.
  &Apache::loncommon::browser_and_searcher_javascript().   &Apache::loncommon::browser_and_searcher_javascript().
  '</script>';   '</script>';
     $r->print(&Apache::loncommon::start_page('Resource Publication',$js));      my $startargs = {};
       if ($fn=~/\/$/) {
           unless ($env{'form.phase'} eq 'two') {
     my $thisfn=$fn;              $startargs->{'add_entries'} = { onload => 'javascript:setDefaultAccess();' };
               $js .= <<"END";
     my $thistarget=$thisfn;  <script type="text/javascript">
         // <![CDATA[
     $thistarget=~s/^\/home/$targetdir/;  function showHideAccess(caller,div) {
     $thistarget=~s/\/public\_html//;      if (document.getElementById(div)) {
           if (caller.checked) {
               document.getElementById(div).style.display='inline-block';
           } else {
               document.getElementById(div).style.display='none';
           }
       }
   }
   
     my $thisdistarget=$thistarget;  function showHideCustom(caller,divid) {
     $thisdistarget=~s/^\Q$docroot\E//;      if (document.getElementById(divid)) {
           if (caller.options[caller.selectedIndex].value == 'custom') {
               document.getElementById(divid).style.display="inline-block";
           } else {
               document.getElementById(divid).style.display="none";
           }
       }
   }
   function setDefaultAccess() {
       var chkids = Array('LC_commondist','LC_commonsource');
       for (var i=0; i<chkids.length; i++) {
           if (document.getElementById(chkids[i])) {
               document.getElementById(chkids[i]).checked = false;
           }
           if (document.getElementById(chkids[i]+'select')) {
              document.getElementById(chkids[i]+'select').selectedIndex = 0; 
           }
           if (document.getElementById(chkids[i]+'div')) {
               document.getElementById(chkids[i]+'div').style.display = 'none';
           }
       }
   }
   // ]]>
   </script>
   
     my $thisdisfn=$thisfn;  END
     $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///;          }
       }
       $r->print(&Apache::loncommon::start_page('Resource Publication',$js,$startargs)
                .&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,'<>&"');
       my $nokeyref = &getnokey($r->dir_config('lonIncludes'));
   
     if ($fn=~/\/$/) {      if ($fn=~/\/$/) {
 # -------------------------------------------------------- This is a directory  # -------------------------------------------------------- This is a directory
  &publishdirectory($r,$fn,$thisdisfn);   &publishdirectory($r,$docroot.$fn,$thisdisfn,$nokeyref);
  $r->print('<hr /><a href="/priv/'          $r->print(
   .$cuname.'/'.$thisdisfn              '<br /><br />'.
   .'">'.&mt('Return to Directory').'</a>');              &Apache::lonhtmlcommon::actionbox([
                   '<a href="'.$thisdisfn.'">'.&mt('Return to Directory').'</a>']));
   
     } else {      } else {
 # ---------------------- Evaluate individual file, and then output information.  # ---------------------- Evaluate individual file, and then output information.
  $thisfn=~/\.(\w+)$/;   $fn=~/\.(\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'; }          if ($thistype eq 'page') {  $thisembstyle = 'rat'; }
   
  $r->print('<h2>'.&mt('Publishing [_1]','<tt>'.$thisdisfn.'</tt>').'</h2>');          $r->print('<h2>'
                    .&mt('Publishing [_1]'
                        ,'<span class="LC_filename">'.$thisdisfn.'</span>')
                    .'</h2>'
           );
   
         $r->print('<h3>'.&mt('Resource Details').'</h3>');          $r->print('<h3>'.&mt('Resource Details').'</h3>');
   
Line 2159  sub handler { Line 2606  sub handler {
                  .'<tt>'                   .'<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>'          $r->print('</tt>'
Line 2169  ENDCAPTION Line 2616  ENDCAPTION
         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Target'))          $r->print(&Apache::lonhtmlcommon::row_title(&mt('Target'))
                  .'<tt>'.$thisdistarget.'</tt>'                   .'<tt>'.$thisdistarget.'</tt>'
                  );                   );
 # SB - ToDo:     
  if (($cuname ne $env{'user.name'})||($cudom ne $env{'user.domain'})) {   if (($cuname ne $env{'user.name'})||($cudom ne $env{'user.domain'})) {
 #           $r->print(&Apache::lonhtmlcommon::row_title('<span class="LC_warning">'.&mt('Co-Author').'</span>')  
             $r->print(&Apache::lonhtmlcommon::row_closure()              $r->print(&Apache::lonhtmlcommon::row_closure()
                      .&Apache::lonhtmlcommon::row_title(&mt('Co-Author'))                       .&Apache::lonhtmlcommon::row_title(&mt('Co-Author'))
                      .'<span class="LC_warning">'                       .'<span class="LC_warning">'
      .&mt('[_1] at [_2]',$cuname,$cudom)       .&Apache::loncommon::plainname($cuname,$cudom) .' ('.$cuname.':'.$cudom.')'
                      .'</span>'                       .'</span>'
                      );                       );
  }   }
Line 2184  ENDCAPTION Line 2629  ENDCAPTION
             $r->print(&Apache::lonhtmlcommon::row_closure()              $r->print(&Apache::lonhtmlcommon::row_closure()
                      .&Apache::lonhtmlcommon::row_title(&mt('Diffs')));                       .&Apache::lonhtmlcommon::row_title(&mt('Diffs')));
     $r->print(<<ENDDIFF);      $r->print(<<ENDDIFF);
 <a href='javascript:void(window.open("/adm/diff?filename=/~$cuname/$thisdisfn&versiontwo=priv","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>  <a href='javascript:void(window.open("/adm/diff?filename=$thisdisfn&amp;versiontwo=priv","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>
 ENDDIFF  ENDDIFF
             $r->print(&mt('Diffs with Current Version').'</a>');              $r->print(&mt('Diffs with Current Version').'</a>');
  }   }
Line 2193  ENDDIFF Line 2638  ENDDIFF
                  .&Apache::lonhtmlcommon::end_pick_box()                   .&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') {
 # ---------------------------------------------------------- Parse for problems  # ---------------------------------------------------------- Parse for problems
     my ($warningcount,$errorcount);      my ($warningcount,$errorcount);
     if ($thisembstyle eq 'ssi') {      if ($thisembstyle eq 'ssi') {
  ($warningcount,$errorcount)=&checkonthis($r,$thisfn);   ($warningcount,$errorcount)=&checkonthis($r,$fn);
     }      }
     unless ($errorcount) {      unless ($errorcount) {
  my ($outstring,$error)=   my ($outstring,$error)=
     &publish($thisfn,$thistarget,$thisembstyle);      &publish($docroot.$fn,$docroot.$thistarget,$thisembstyle,undef,$nokeyref);
  $r->print('<hr />'.$outstring);   $r->print($outstring);
     } else {      } else {
  $r->print('<h3 class="LC_error">'.   $r->print('<h3 class="LC_error">'.
   &mt('The document contains errors and cannot be published.').    &mt('The document contains errors and cannot be published.').
   '</h3>');    '</h3>');
     }      }
  } else {   } else {
     &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget);       my ($output,$error) = &phasetwo($r,$docroot.$fn,$docroot.$thistarget,
     $r->print('<hr />');                                              $thisembstyle,$thisdistarget);
               $r->print($output);
  }   }
     }      }
     $r->print(&Apache::loncommon::end_page());      $r->print(&Apache::loncommon::end_page());
Line 2220  ENDDIFF Line 2666  ENDDIFF
     return OK;      return OK;
 }  }
   
   BEGIN {
   
   # ----------------------------------- Read addid.tab
       unless ($readit) {
           %addid=();
   
           {
               my $tabdir = $Apache::lonnet::perlvar{'lonTabDir'};
               my $fh=Apache::File->new($tabdir.'/addid.tab');
               while (<$fh>=~/(\w+)\s+(\w+)/) {
                   $addid{$1}=$2;
               }
           }
       }
       $readit=1;
   }
   
   
 1;  1;
 __END__  __END__
   
Line 2227  __END__ Line 2691  __END__
   
 =back  =back
   
 =back  
   
 =cut  =cut
   
Removed from v.1.244  
changed lines
  Added in v.1.298

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