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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.138 and 1.184

version 1.138, 2003/09/25 22:30:06 version 1.184, 2005/01/24 21:55:20
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 #   
 # (TeX Content Handler  
 #  
 # 05/29/00,05/30,10/11 Gerd Kortemeyer)  
 #  
 # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer  
 # 03/23 Guy Albertelli  
 # 03/24,03/29,04/03 Gerd Kortemeyer  
 # 05/03,05/05,05/07 Gerd Kortemeyer  
 # 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26,10/16 Gerd Kortemeyer  
 # 12/04,12/05 Guy Albertelli  
 # 12/05 Gerd Kortemeyer  
 # 12/05 Guy Albertelli  
 # 12/06,12/07 Gerd Kortemeyer  
 # 12/25 Gerd Kortemeyer  
 # YEAR=2002  
 # 1/17 Gerd Kortemeyer  
 #  
 ###  ###
   
 ###############################################################################  ###############################################################################
Line 143  use Apache::lonnet(); Line 125  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 LONCAPA::lonmetadata;
   use Apache::lonmsg;
 use vars qw(%metadatafields %metadatakeys);  use vars qw(%metadatafields %metadatakeys);
   
 my %addid;  my %addid;
Line 153  my $docroot; Line 138  my $docroot;
 my $cuname;  my $cuname;
 my $cudom;  my $cudom;
   
   my $registered_cleanup;
   my $modified_urls;
   
 =pod  =pod
   
 =item B<metaeval>  =item B<metaeval>
Line 180  nothing Line 168  nothing
   
 #########################################  #########################################
 #########################################  #########################################
   #
   # Modifies global %metadatafields %metadatakeys 
   #
   
 sub metaeval {  sub metaeval {
     my $metastring=shift;      my ($metastring,$prefix)=@_;
         
         my $parser=HTML::LCParser->new(\$metastring);      my $parser=HTML::LCParser->new(\$metastring);
         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 $entry=$token->[1];      my $entry=$token->[1];
               my $unikey=$entry;      my $unikey=$entry;
               if (defined($token->[2]->{'package'})) {       if (defined($token->[2]->{'package'})) { 
                   $unikey.='_package_'.$token->[2]->{'package'};   $unikey.='_package_'.$token->[2]->{'package'};
               }       } 
               if (defined($token->[2]->{'part'})) {       if (defined($token->[2]->{'part'})) { 
                  $unikey.='_'.$token->[2]->{'part'};    $unikey.='_'.$token->[2]->{'part'}; 
       }      }
               if (defined($token->[2]->{'id'})) {       if (defined($token->[2]->{'id'})) { 
                   $unikey.='_'.$token->[2]->{'id'};   $unikey.='_'.$token->[2]->{'id'};
               }       } 
               if (defined($token->[2]->{'name'})) {       if (defined($token->[2]->{'name'})) { 
                  $unikey.='_'.$token->[2]->{'name'};    $unikey.='_'.$token->[2]->{'name'}; 
       }      }
               foreach (@{$token->[3]}) {      foreach (@{$token->[3]}) {
   $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};   $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
                   if ($metadatakeys{$unikey}) {   if ($metadatakeys{$unikey}) {
       $metadatakeys{$unikey}.=','.$_;      $metadatakeys{$unikey}.=','.$_;
                   } else {   } else {
                       $metadatakeys{$unikey}=$_;      $metadatakeys{$unikey}=$_;
                   }   }
               }      }
               if ($metadatafields{$unikey}) {      my $newentry=$parser->get_text('/'.$entry);
   my $newentry=$parser->get_text('/'.$entry);      if (($entry eq 'customdistributionfile') ||
                   unless (($metadatafields{$unikey}=~/\Q$newentry\E/) ||   ($entry eq 'sourcerights')) {
                           ($newentry eq '')) {   $newentry=~s/^\s*//;
                      $metadatafields{$unikey}.=', '.$newentry;   if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; }
   }      }
       } else {  # actually store
                  $metadatafields{$unikey}=$parser->get_text('/'.$entry);      if ( $entry eq 'rule' && exists($metadatafields{$unikey})) {
               }   $metadatafields{$unikey}.=','.$newentry;
           }      } else {
        }   $metadatafields{$unikey}=$newentry;
       }
    }
       }
 }  }
   
 #########################################  #########################################
Line 260  XHTML text that indicates successful rea Line 255  XHTML text that indicates successful rea
 #########################################  #########################################
 #########################################  #########################################
 sub metaread {  sub metaread {
     my ($logfile,$fn)=@_;      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>No file:</b> <tt>'.$fn.'</tt>';          return '<br /><b>'.&mt('No file').':</b> <tt>'.
       &Apache::loncfile::display($fn).'</tt>';
     }      }
     print($logfile 'Processing '.$fn."\n");      print($logfile 'Processing '.$fn."\n");
     my $metastring;      my $metastring;
     {      {
      my $metafh=Apache::File->new($fn);   my $metafh=Apache::File->new($fn);
      $metastring=join('',<$metafh>);   $metastring=join('',<$metafh>);
     }      }
     &metaeval($metastring);      &metaeval($metastring,$prefix);
     return '<br /><b>Processed file:</b> <tt>'.$fn.'</tt>';      return '<br /><b>'.&mt('Processed file').':</b> <tt>'.
    &Apache::loncfile::display($fn).'</tt>';
 }  }
   
 #########################################  #########################################
Line 325  string which presents the form field (fo Line 322  string which presents the form field (fo
 #########################################  #########################################
 sub textfield {  sub textfield {
     my ($title,$name,$value)=@_;      my ($title,$name,$value)=@_;
       $value=~s/^\s+//gs;
       $value=~s/\s+$//gs;
       $value=~s/\s+/ /gs;
     $title=&mt($title);      $title=&mt($title);
     my $uctitle=uc($title);      $ENV{'form.'.$name}=$value;
     return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".      return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".
            "</b></font></p><br />".             "</b></font></p><br />".
            '<input type="text" name="'.$name.'" size=80 value="'.$value.'" />';             '<input type="text" name="'.$name.'" size=80 value="'.$value.'" />';
 }  }
   
   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<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".
              "</b></font></p><br />".
              '<input type="text" name="'.$name.'" size=80 value="'.$value.'" />'.
      '<a href="javascript:openbrowser(\'pubform\',\''.$name.'\',\''.$restriction.'\');">Select</a>&nbsp;'.
      '<a href="javascript:opensearcher(\'pubform\',\''.$name.'\');">Search</a>';
      
   }
   
 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 selectbox {  sub selectbox {
     my ($title,$name,$value,$functionref,@idlist)=@_;      my ($title,$name,$value,$functionref,@idlist)=@_;
     $title=&mt($title);      $title=&mt($title);
     my $uctitle=uc($title);  
     $value=(split(/\s*,\s*/,$value))[-1];      $value=(split(/\s*,\s*/,$value))[-1];
     my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".      if (defined($value)) {
    $ENV{'form.'.$name}=$value;
       } else {
    $ENV{'form.'.$name}=$idlist[0];
       }
       my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".
  '</b></font></p><br /><select name="'.$name.'">';   '</b></font></p><br /><select name="'.$name.'">';
     foreach (@idlist) {      foreach (@idlist) {
         $selout.='<option value=\''.$_.'\'';          $selout.='<option value=\''.$_.'\'';
Line 354  sub selectbox { Line 374  sub selectbox {
     return $selout.'</select>';      return $selout.'</select>';
 }  }
   
   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 464  sub get_subscribed_hosts { Line 490  sub get_subscribed_hosts {
     while ($filename=readdir(DIR)) {      while ($filename=readdir(DIR)) {
  if ($filename=~/\Q$srcf\E\.(\w+)$/) {   if ($filename=~/\Q$srcf\E\.(\w+)$/) {
     my $subhost=$1;      my $subhost=$1;
     if (($subhost ne 'meta' && $subhost ne 'subscription') &&      if (($subhost ne 'meta' && $subhost ne 'subscription' &&
    $subhost ne 'tmp') &&
                 ($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) {                  ($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) {
  push(@subscribed,$subhost);   push(@subscribed,$subhost);
     }      }
Line 575  sub get_all_text_unbalanced { Line 602  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 619  sub fix_ids_and_indices { Line 646  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">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='<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>';
  return ($outstring,1);   return ($outstring,1);
     }      }
     if ($needsfixup) {      if ($needsfixup) {
Line 684  sub fix_ids_and_indices { Line 711  sub fix_ids_and_indices {
  }   }
  if ($lctag eq 'applet') {   if ($lctag eq 'applet') {
     my $codebase='';      my $codebase='';
     if (defined($parms{'codebase'})) {      my $havecodebase=0;
  my $oldcodebase=$parms{'codebase'};      foreach my $key (keys(%parms)) {
    if (lc($key) eq 'codebase') { 
       $codebase=$parms{$key};
       $havecodebase=1; 
    }
       }
       if ($havecodebase) {
    my $oldcodebase=$codebase;
  unless ($oldcodebase=~/\/$/) {   unless ($oldcodebase=~/\/$/) {
     $oldcodebase.='/';      $oldcodebase.='/';
  }   }
Line 699  sub fix_ids_and_indices { Line 733  sub fix_ids_and_indices {
  }   }
  $allow{&absoluteurl($codebase,$target).'/*'}=1;   $allow{&absoluteurl($codebase,$target).'/*'}=1;
     } else {      } else {
  foreach ('archive','code','object') {   foreach my $key (keys(%parms)) {
     if (defined($parms{$_})) {      if ($key =~ /(archive|code|object)/i) {
  my $oldurl=$parms{$_};   my $oldurl=$parms{$key};
  my $newurl=&urlfixup($oldurl,$target);   my $newurl=&urlfixup($oldurl,$target);
  $newurl=~s/\/[^\/]+$/\/\*/;   $newurl=~s/\/[^\/]+$/\/\*/;
  print $logfile 'Allow: applet '.$_.':'.   print $logfile 'Allow: applet '.lc($key).':'.
     $oldurl.' allows '.      $oldurl.' allows '.$newurl."\n";
  $newurl."\n";  
  $allow{&absoluteurl($newurl,$target)}=1;   $allow{&absoluteurl($newurl,$target)}=1;
     }      }
  }   }
Line 771  Returns: (error,status).  error is undef Line 804  Returns: (error,status).  error is undef
 #########################################  #########################################
 #########################################  #########################################
 sub store_metadata {  sub store_metadata {
     my %metadata = %{shift()};      my %metadata = @_;
     my $error;      my $error;
     # Determine if the table exists      # Determine if the table exists
     my $status = &Apache::lonmysql::check_table('metadata');      my $status = &Apache::lonmysql::check_table('metadata');
Line 788  sub store_metadata { Line 821  sub store_metadata {
         &Apache::lonnet::logthis($error);          &Apache::lonnet::logthis($error);
         return ($error,undef);          return ($error,undef);
     }      }
     # Remove old value from table      my $dbh = &Apache::lonmysql::get_dbh();
     $status = &Apache::lonmysql::remove_from_table      if (($metadata{'obsolete'}) || ($metadata{'copyright'} eq 'priv') ||
         ('metadata','url',$metadata{'url'});   ($metadata{'copyright'} eq 'custom')) {
     if (! defined($status)) {          # remove this entry
         $error = '<font color="red">Error when removing old values from '.   $status=&LONCAPA::lonmetadata::delete_metadata($dbh,undef,
             'metadata table in LON-CAPA database.</font>';                                                         $metadata{'url'});
         &Apache::lonnet::logthis($error);      } else {
         return ($error,undef);          $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,
                                                            \%metadata);
     }      }
     # Store data in table.      if (defined($status) && $status ne '') {
     $status = &Apache::lonmysql::store_row('metadata',\%metadata);  
     if (! defined($status)) {  
         $error='<font color="red">Error occured storing new values in '.          $error='<font color="red">Error occured storing new values in '.
             'metadata table in LON-CAPA database</font>';              'metadata table in LON-CAPA database</font>';
         &Apache::lonnet::logthis($error);          &Apache::lonnet::logthis($error);
           &Apache::lonnet::logthis($status);
         return ($error,undef);          return ($error,undef);
     }      }
     return (undef,$status);      return (undef,$status);
 }  }
   
   
   # ============================================== Parse file itself for metadata
   #
   # parses a file with target meta, sets global %metadatafields %metadatakeys 
   
   sub parseformeta {
       my ($source,$style)=@_;
       my $allmeta='';
       if (($style eq 'ssi') || ($style eq 'prv')) {
    my $dir=$source;
    $dir=~s-/[^/]*$--;
    my $file=$source;
    $file=(split('/',$file))[-1];
           $source=&Apache::lonnet::hreflocation($dir,$file);
    $allmeta=&Apache::lonnet::ssi_body($source,('grade_target' => 'meta'));
           &metaeval($allmeta);
       }
       return $allmeta;
   }
   
 #########################################  #########################################
 #########################################  #########################################
   
Line 839  sub publish { Line 892  sub publish {
     my %allow=();      my %allow=();
   
     unless ($logfile=Apache::File->new('>>'.$source.'.log')) {      unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
  return ('<font color="red">No write permission to user directory, FAIL</font>',1);   return ('<font color="red">'.&mt('No write permission to user directory, FAIL').'</font>',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";
Line 863  sub publish { Line 916  sub publish {
  if ($error) { return ($outstring,$error); }   if ($error) { return ($outstring,$error); }
 # ------------------------------------------------------------ Construct Allows  # ------------------------------------------------------------ Construct Allows
           
  $scrout.='<h3>Dependencies</h3>';   $scrout.='<h3>'.&mt('Dependencies').'</h3>';
         my $allowstr='';          my $allowstr='';
         foreach (sort(keys(%allow))) {          foreach (sort(keys(%allow))) {
    my $thisdep=$_;     my $thisdep=$_;
Line 872  sub publish { Line 925  sub publish {
               $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">Currently not available'.     $scrout.= ' - <font color="red">'.&mt('Currently not available').
        '</font>';         '</font>';
                } else {                 } else {
                    my %temphash=(&Apache::lonnet::declutter($target).'___'.                     my %temphash=(&Apache::lonnet::declutter($target).'___'.
Line 895  sub publish { Line 948  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.
   
         {          {
Line 920  sub publish { Line 968  sub publish {
 # -------------------------------------------- Initial step done, now metadata.  # -------------------------------------------- Initial step done, now metadata.
   
 # --------------------------------------- Storage for metadata keys and fields.  # --------------------------------------- Storage for metadata keys and fields.
   # these are globals
   #
      %metadatafields=();       %metadatafields=();
      %metadatakeys=();       %metadatakeys=();
             
Line 941  sub publish { Line 990  sub publish {
         $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;
  $metadatafields{'modifyinguser'}=$ENV{'user.name'}.'@'.  
                                  $ENV{'user.domain'};  
  $metadatafields{'authorspace'}=$cuname.'@'.$cudom;  
   
 # ------------------------------------------------ Check out directory hierachy  # ------------------------------------------------ Check out directory hierachy
   
Line 955  sub publish { Line 1001  sub publish {
   
         my $currentpath='/home/'.$cuname.'/';          my $currentpath='/home/'.$cuname.'/';
   
    my $prefix='../'x($#urlparts);
         foreach (@urlparts) {          foreach (@urlparts) {
     $currentpath.=$_.'/';      $currentpath.=$_.'/';
             $scrout.=&metaread($logfile,$currentpath.'default.meta');              $scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);
       $prefix=~s|^\.\./||;
         }          }
   # ----------------------------------------------------------- Parse file itself
   # read %metadatafields from file itself
    
    $allmeta=&parseformeta($source,$style);
   
 # ------------------- Clear out parameters and stores (there should not be any)  # ------------------- Clear out parameters and stores (there should not be any)
   
Line 979  sub publish { Line 1031  sub publish {
  delete $metadatafields{$_};   delete $metadatafields{$_};
             }              }
         }          }
           # ------------------------------------------ See if anything new in file itself
     }   
    $allmeta=&parseformeta($source,$style);
   
 # -------------------------------------------------- Parse content for metadata     }
     if (($style eq 'ssi') || ($style eq 'prv')) {  
  my $dir=$source;  
  $dir=~s-/[^/]*$--;  
  my $file=$source;  
  $file=(split('/',$file))[-1];  
         $source=&Apache::lonnet::hreflocation($dir,$file);  
  $allmeta=&Apache::lonnet::ssi_body($source,('grade_target' => 'meta'));  
   
         &metaeval($allmeta);         
     }  
 # ---------------- Find and document discrepancies in the parameters and stores  # ---------------- Find and document discrepancies in the parameters and stores
   
     my $chparms='';      my $chparms='';
Line 1023  sub publish { Line 1068  sub publish {
     }      }
     if ($chparms) {      if ($chparms) {
  $scrout.='<p><b>'.&mt('Obsolete parameters or stored values').':</b> '.   $scrout.='<p><b>'.&mt('Obsolete parameters or stored values').':</b> '.
     $chparms.'</p>';      $chparms.'</p><h1><font color="red">'.&mt('Warning!').
       '</font></h1><p><font color="red" size="+1">'.
       &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'</font></p><hr />';
     }      }
   
 # ------------------------------------------------------- Now have all metadata  # ------------------------------------------------------- Now have all metadata
Line 1047  sub publish { Line 1094  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="Finalize Publication" /></p>'.  
             &hiddenfield('phase','two').      my $intr_scrout.=
             &hiddenfield('filename',$ENV{'form.filename'}).   '<form name="pubform" action="/adm/publish" method="post">'.
     &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).   '<p><input type="submit" value="'.&mt('Finalize Publication').'" /></p>'.
             &hiddenfield('dependencies',join(',',keys %allow)).   &hiddenfield('phase','two').
             &textfield('Title','title',$metadatafields{'title'}).   &hiddenfield('filename',$ENV{'form.filename'}).
             &textfield('Author(s)','author',$metadatafields{'author'}).   &hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).
     &textfield('Subject','subject',$metadatafields{'subject'});   &hiddenfield('dependencies',join(',',keys %allow)).
    &textfield('Title','title',$metadatafields{'title'}).
    &textfield('Author(s)','author',$metadatafields{'author'}).
    &textfield('Subject','subject',$metadatafields{'subject'});
   
 # --------------------------------------------------- Scan content for keywords  # --------------------------------------------------- Scan content for keywords
   
         my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");      my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");
  my $keywordout=<<"END";      my $KEYWORDS=&mt('Keywords');
       my $CheckAll=&mt('check all');
       my $UncheckAll=&mt('uncheck all');
       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 1081  function uncheckAll(field) { Line 1139  function uncheckAll(field) {
         field[i].checked = false ;          field[i].checked = false ;
 }  }
 </script>  </script>
 <p><font color="#800000" face="helvetica"><b>KEYWORDS:</b></font>  <p><font color="#800000" face="helvetica"><b>$KEYWORDS:</b></font>
  $keywords_help</b>   $keywords_help</b>
 <input type="button" value="check all" onclick="javascript:checkAll(document.pubform.keywords)" />   <input type="button" value="$CheckAll" onclick="javascript:checkAll(document.pubform.keywords)" /> 
 <input type="button" value="uncheck all" onclick="javascript:uncheckAll(document.pubform.keywords)" />   <input type="button" value="$UncheckAll" onclick="javascript:uncheckAll(document.pubform.keywords)" /> 
 </p>  </p>
 <br />  <br />
 END  END
  $keywordout.='<table border="2"><tr>';      $keywordout.='<table border="2"><tr>';
  my $colcount=0;      my $colcount=0;
   
  foreach (sort keys %keywords) {      foreach (sort keys %keywords) {
     $keywordout.='<td><input type="checkbox" name="keywords" value="'.$_.'"';   $keywordout.='<td><label><input type="checkbox" name="keywords" value="'.$_.'"';
     if ($metadatafields{'keywords'}) {   if ($metadatafields{'keywords'}) {
  if ($metadatafields{'keywords'}=~/\Q$_\E/) {      if ($metadatafields{'keywords'}=~/\Q$_\E/) {
     $keywordout.=' checked="on"';  
  }  
     } elsif (&Apache::loncommon::keyword($_)) {  
  $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>';
   
  $scrout.=$keywordout;      $intr_scrout.=$keywordout;
   
  $scrout.=&textfield('Additional Keywords','addkey','');      $intr_scrout.=&textfield('Additional Keywords','addkey','');
   
  $scrout.=&textfield('Notes','notes',$metadatafields{'notes'});      $intr_scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
   
  $scrout.=      $intr_scrout.=
     "\n<p><font color=\"#800000\" face=\"helvetica\"><b>ABSTRACT:".   "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".&mt('Abstract').":".
     "</b></font></p><br />".   "</b></font></p><br />".
     '<textarea cols="80" rows="5" name="abstract">'.   '<textarea cols="80" rows="5" name="abstract">'.
     $metadatafields{'abstract'}.'</textarea></p>';   $metadatafields{'abstract'}.'</textarea></p>';
   
  $source=~/\.(\w+)$/;      $source=~/\.(\w+)$/;
   
  $scrout.=&hiddenfield('mime',$1);  
   
  my $defaultlanguage=$metadatafields{'language'};      $intr_scrout.=
  $defaultlanguage =~ s/\s*notset\s*//g;   "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
  $defaultlanguage =~ s/^,\s*//g;   &mt('Lowest Grade Level').':'.
  $defaultlanguage =~ s/,\s*$//g;   "</b></font></p><br />".
    &select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel').
    "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
    &mt('Highest Grade Level').':'.
    "</b></font></p><br />".
    &select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel').
    &textfield('Standards','standards',$metadatafields{'standards'});
   
  $scrout.=&selectbox('Language','language',  
     $defaultlanguage,  
     \&Apache::loncommon::languagedescription,  
     (&Apache::loncommon::languageids),  
    );  
   
  unless ($metadatafields{'creationdate'}) {  
     $metadatafields{'creationdate'}=time;  
  }  
  $scrout.=&hiddenfield('creationdate',  
       &Apache::loncommon::unsqltime($metadatafields{'creationdate'}));  
   
  $scrout.=&hiddenfield('lastrevisiondate',time);  
   
       $intr_scrout.=&hiddenfield('mime',$1);
   
       my $defaultlanguage=$metadatafields{'language'};
       $defaultlanguage =~ s/\s*notset\s*//g;
       $defaultlanguage =~ s/^,\s*//g;
       $defaultlanguage =~ s/,\s*$//g;
   
       $intr_scrout.=&selectbox('Language','language',
        $defaultlanguage,
        \&Apache::loncommon::languagedescription,
        (&Apache::loncommon::languageids),
        );
   
       unless ($metadatafields{'creationdate'}) {
    $metadatafields{'creationdate'}=time;
       }
       $intr_scrout.=&hiddenfield('creationdate',
          &Apache::lonmysql::unsqltime($metadatafields{'creationdate'}));
   
       $intr_scrout.=&hiddenfield('lastrevisiondate',time);
   
  $scrout.=&textfield('Publisher/Owner','owner',  
     $metadatafields{'owner'});  
   
       $intr_scrout.=&textfield('Publisher/Owner','owner',
        $metadatafields{'owner'});
   
   # ---------------------------------------------- Retrofix for unused copyright
       if ($metadatafields{'copyright'} eq 'free') {
    $metadatafields{'copyright'}='default';
    $metadatafields{'sourceavail'}='open';
       }
   # ------------------------------------------------ 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';  
  }  
  $scrout.=&selectbox('Copyright/Distribution','copyright',  
     $defaultoption,  
     \&Apache::loncommon::copyrightdescription,  
     (grep !/^public$/,(&Apache::loncommon::copyrightids)));  
     } else {  
  $scrout.=&selectbox('Copyright/Distribution','copyright',  
     $defaultoption,  
     \&Apache::loncommon::copyrightdescription,  
     (&Apache::loncommon::copyrightids));  
     }      }
           $intr_scrout.=&selectbox('Copyright/Distribution','copyright',
     my $copyright_help =       $defaultoption,
  Apache::loncommon::help_open_topic('Publishing_Copyright');       \&Apache::loncommon::copyrightdescription,
     $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;      (grep !/^public$/,(&Apache::loncommon::copyrightids)));
     $scrout.=&textfield('Custom Distribution File','customdistributionfile',  
  $metadatafields{'customdistributionfile'}).  
     $copyright_help;  
     my $uctitle=uc(&mt('Obsolete'));  
             $scrout.=  
  "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".  
  '</b></font> <input type="checkbox" name="obsolete" ';  
     if ($metadatafields{'obsolete'}) {  
  $scrout.=' checked="1" ';  
     }  
     $scrout.='/ ></p>'.  
  &textfield('Suggested Replacement for Obsolete File',  
     'obsoletereplacement',  
     $metadatafields{'obsoletereplacement'});  
  } else {   } else {
     $scrout.=&hiddenfield('copyright','private');      $intr_scrout.=&selectbox('Copyright/Distribution','copyright',
  }       $defaultoption,
  return ($scrout.'<p><input type="submit" value="'.       \&Apache::loncommon::copyrightdescription,
  &mt('Finalize Publication').'" /></p></form>',0);       (&Apache::loncommon::copyrightids));
 # =============================================================================  
 # BATCH MODE  
 #  
     } else {  
 # Transfer metadata directly to environment for stage 2  
  foreach (keys %metadatafields) {  
     $ENV{'form.'.$_}=$metadatafields{$_};  
  }  
  $ENV{'form.addkey'}='';  
  $ENV{'form.keywords'}='';  
  foreach (keys %keywords) {  
     if ($metadatafields{'keywords'}) {  
  if ($metadatafields{'keywords'}=~/\Q$_\E/) {   
     $ENV{'form.keywords'}.=$_.',';   
  }  
     } elsif (&Apache::loncommon::keyword($_)) {  
  $ENV{'form.keywords'}.=$_.',';  
     }  
  }   }
  $ENV{'form.keywords'}=~s/\,$//;   my $copyright_help =
  unless ($ENV{'form.creationdate'}) { $ENV{'form.creationdate'}=time; }      Apache::loncommon::help_open_topic('Publishing_Copyright');
  $ENV{'form.lastrevisiondate'}=time;   $intr_scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;
  if ((($style eq 'rat') && ($ENV{'form.copyright'} eq 'public')) ||   $intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights').$copyright_help;
     (!$ENV{'form.copyright'})) {    $intr_scrout.=&selectbox('Source Distribution','sourceavail',
     $ENV{'form.copyright'}='default';   $defaultsourceoption,
    \&Apache::loncommon::source_copyrightdescription,
    (&Apache::loncommon::source_copyrightids));
    $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights');
    my $uctitle=&mt('Obsolete');
    $intr_scrout.=
       "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
       '</b></font> <input type="checkbox" name="obsolete" ';
    if ($metadatafields{'obsolete'}) {
       $intr_scrout.=' checked="1" ';
  }   }
  $ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta);   $intr_scrout.='/ ></p>'.
  return ($scrout,0);      &text_with_browse_field('Suggested Replacement for Obsolete File',
       'obsoletereplacement',
       $metadatafields{'obsoletereplacement'});
       } else {
    $intr_scrout.=&hiddenfield('copyright','private');
       }
       if (!$batch) {
    $scrout.=$intr_scrout.'<p><input type="submit" value="'.
       &mt('Finalize Publication').'" /></p></form>';
     }      }
       return($scrout,0);
 }  }
   
 #########################################  #########################################
Line 1285  sub phasetwo { Line 1346  sub phasetwo {
           
     %metadatafields=();      %metadatafields=();
     %metadatakeys=();      %metadatakeys=();
       
     &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));      &metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));
           
     $metadatafields{'title'}=$ENV{'form.title'};      $metadatafields{'title'}=$ENV{'form.title'};
Line 1299  sub phasetwo { Line 1360  sub phasetwo {
     $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};      $metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};
     $metadatafields{'owner'}=$ENV{'form.owner'};      $metadatafields{'owner'}=$ENV{'form.owner'};
     $metadatafields{'copyright'}=$ENV{'form.copyright'};      $metadatafields{'copyright'}=$ENV{'form.copyright'};
       $metadatafields{'standards'}=$ENV{'form.standards'};
       $metadatafields{'lowestgradelevel'}=$ENV{'form.lowestgradelevel'};
       $metadatafields{'highestgradelevel'}=$ENV{'form.highestgradelevel'};
     $metadatafields{'customdistributionfile'}=      $metadatafields{'customdistributionfile'}=
                                  $ENV{'form.customdistributionfile'};                                   $ENV{'form.customdistributionfile'};
       $metadatafields{'sourceavail'}=$ENV{'form.sourceavail'};
     $metadatafields{'obsolete'}=$ENV{'form.obsolete'};      $metadatafields{'obsolete'}=$ENV{'form.obsolete'};
     $metadatafields{'obsoletereplacement'}=      $metadatafields{'obsoletereplacement'}=
                         $ENV{'form.obsoletereplacement'};                          $ENV{'form.obsoletereplacement'};
     $metadatafields{'dependencies'}=$ENV{'form.dependencies'};      $metadatafields{'dependencies'}=$ENV{'form.dependencies'};
       $metadatafields{'modifyinguser'}=$ENV{'user.name'}.'@'.
                                    $ENV{'user.domain'};
       $metadatafields{'authorspace'}=$cuname.'@'.$cudom;
           
     my $allkeywords=$ENV{'form.addkey'};      my $allkeywords=$ENV{'form.addkey'};
     if (exists($ENV{'form.keywords'})) {      if (exists($ENV{'form.keywords'})) {
Line 1314  sub phasetwo { Line 1382  sub phasetwo {
             $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
       if ($metadatafields{'copyright'} eq 'custom') {
    my $file=$metadatafields{'customdistributionfile'};
    unless ($file=~/\.rights$/) {
               return 
                   '<font color="red">'.&mt('No valid custom distribution rights file specified, FAIL').
    '</font>';
           }
       }
     {      {
         print $logfile "\nWrite metadata file for ".$source;          print $logfile "\nWrite metadata file for ".$source;
         my $mfh;          my $mfh;
Line 1339  sub phasetwo { Line 1419  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 1351  sub phasetwo { Line 1431  sub phasetwo {
   
     $metadatafields{'url'} = $distarget;      $metadatafields{'url'} = $distarget;
     $metadatafields{'version'} = 'current';      $metadatafields{'version'} = 'current';
     unless ($metadatafields{'copyright'} eq 'priv') {  
         my ($error,$success) = &store_metadata(\%metadatafields);      my ($error,$success) = &store_metadata(%metadatafields);
         if ($success) {      if ($success) {
             $r->print('<p>'.&mt('Synchronized SQL metadata database').'</p>');   $r->print('<p>'.&mt('Synchronized SQL metadata database').'</p>');
             print $logfile "\nSynchronized SQL metadata database";   print $logfile "\nSynchronized SQL metadata database";
         } else {  
             $r->print($error);  
             print $logfile "\n".$error;  
         }  
     } else {      } else {
         $r->print('<p>'.   $r->print($error);
      &mt('Private Publication - did not synchronize database').'</p>');   print $logfile "\n".$error;
         print $logfile "\nPrivate: Did not synchronize data into ".  
             "SQL metadata database";  
     }      }
   # --------------------------------------------- Delete author resource messages
       my $delresult=&Apache::lonmsg::del_url_author_res_msg($target); 
       $r->print('<p>'.&mt('Removing error messages:').' '.$delresult.'</p>');
       print $logfile "\nRemoving error messages: $delresult";
 # ----------------------------------------------------------- Copy old versions  # ----------------------------------------------------------- Copy old versions
         
     if (-e $target) {      if (-e $target) {
Line 1466  sub phasetwo { Line 1544  sub phasetwo {
             "<font color=\"red\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</font>";              "<font color=\"red\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</font>";
     }      }
     $r->rflush;      $r->rflush;
 # --------------------------------------------------- Send update notifications  
   
     my @subscribed=&get_subscribed_hosts($target);  
     foreach my $subhost (@subscribed) {  
  $r->print('<p>'.&mt('Notifying host').' '.$subhost.':');$r->rflush;  
  print $logfile "\nNotifying host ".$subhost.':';  
  my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);  
  $r->print($reply.'</p><br />');$r->rflush;  
  print $logfile $reply;  
     }  
       
 # ---------------------------------------- Send update notifications, meta only  
   
     my @subscribedmeta=&get_subscribed_hosts("$target.meta");  # ------------------------------------------------------------- Trigger updates
     foreach my $subhost (@subscribedmeta) {      push(@{$modified_urls},[$target,$source]);
  $r->print('<p>'.      unless ($registered_cleanup) {
 &mt('Notifying host for metadata only').' '.$subhost.':');$r->rflush;   $r->register_cleanup(\&notify);
  print $logfile "\nNotifying host for metadata only ".$subhost.':';   $registered_cleanup=1;
  my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',  
     $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) {
Line 1523  sub phasetwo { Line 1572  sub phasetwo {
                    '"><font size="+2">'.                     '"><font size="+2">'.
   &mt('Back to Source Directory').'</font></a></p>');    &mt('Back to Source Directory').'</font></a></p>');
     }      }
       $logfile->close();
       return '<p><font color="green">'.&mt('Done').'</font></p>';
   }
   
   # =============================================================== 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();
       }
       return OK;
 }  }
   
 #########################################  #########################################
Line 1542  sub batchpublish { Line 1630  sub batchpublish {
     $thisdistarget=~s/^\Q$docroot\E//;      $thisdistarget=~s/^\Q$docroot\E//;
   
   
     undef %metadatafields;      %metadatafields=();
     undef %metadatakeys;      %metadatakeys=();
      %metadatafields=();      $srcfile=~/\.(\w+)$/;
      %metadatakeys=();      my $thistype=$1;
       $srcfile=~/\.(\w+)$/;  
       my $thistype=$1;  
   
   
       my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);      my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
             
     $r->print('<h2>'.&mt('Publishing').' <tt>'.$thisdisfn.'</tt></h2>');      $r->print('<h2>'.&mt('Publishing').' <tt>'.$thisdisfn.'</tt></h2>');
   
Line 1577  sub publishdirectory { Line 1663  sub publishdirectory {
     $fn=~s/\/+/\//g;      $fn=~s/\/+/\//g;
     $thisdisfn=~s/\/+/\//g;      $thisdisfn=~s/\/+/\//g;
     my $resdir=      my $resdir=
     $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'.   $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'.
       $thisdisfn;   $thisdisfn;
       $r->print('<h1>Directory <tt>'.$thisdisfn.'</tt></h1>'.      $r->print('<h1>'.&mt('Directory').' <tt>'.$thisdisfn.'</tt></h1>'.
                 '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.
   
       opendir(DIR,$fn);      opendir(DIR,$fn);
       my @files=sort(readdir(DIR));      my @files=sort(readdir(DIR));
       foreach my $filename (@files) {      foreach my $filename (@files) {
          my ($cdev,$cino,$cmode,$cnlink,   my ($cdev,$cino,$cmode,$cnlink,
             $cuid,$cgid,$crdev,$csize,              $cuid,$cgid,$crdev,$csize,
             $catime,$cmtime,$cctime,              $catime,$cmtime,$cctime,
             $cblksize,$cblocks)=stat($fn.'/'.$filename);              $cblksize,$cblocks)=stat($fn.'/'.$filename);
   
          my $extension='';   my $extension='';
          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);
    }      }
          } 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 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'} eq 'ON')) {
 # previously published, modified now  # previously published, modified now
     $publishthis=1;      $publishthis=1;
                 }                  }
      } else {      } else {
 # never published  # never published
  $publishthis=1;   $publishthis=1;
      }      }
              if ($publishthis) {      if ($publishthis) {
                 &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);                  &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);
      } else {      } else {
                  $r->print('<br />Skipping '.$filename.'<br />');   $r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');
              }      }
              $r->rflush();      $r->rflush();
          }   }
       }      }
       closedir(DIR);      closedir(DIR);
   }
   
   #########################################
   # publish a default.meta file
   
   sub defaultmetapublish {
       my ($r,$fn,$cuname,$cudom)=@_;
       $fn=~s/^\/\~$cuname\//\/home\/$cuname\/public_html\//;
       unless (-e $fn) {
          return HTTP_NOT_FOUND;
       }
       my $target=$fn;
       $target=~s/^\/home\/$cuname\/public_html\//$Apache::lonnet::perlvar{'lonDocRoot'}\/res\/$cudom\/$cuname\//;
   
   
       &Apache::loncommon::content_type($r,'text/html');
       $r->send_http_header;
   
       $r->print('<html><head><title>LON-CAPA Publishing</title></head>');
       $r->print(&Apache::loncommon::bodytag('Catalog Information Publication'));
   
   # ---------------------------------------------------------------- Write Source
       my $copyfile=$target;
       
       my @parts=split(/\//,$copyfile);
       my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
       
       my $count;
       for ($count=5;$count<$#parts;$count++) {
           $path.="/$parts[$count]";
           if ((-e $path)!=1) {
               $r->print('<p>'.&mt('Created directory').' '.$parts[$count].'</p>');
               mkdir($path,0777);
           }
       }
       
       if (copy($fn,$copyfile)) {
           $r->print('<p>'.&mt('Copied source file').'</p>');
       } else {
           return "<font color=\"red\">".
       &mt('Failed to copy source').", $!, ".&mt('FAIL')."</font>";
       }
   
   # --------------------------------------------------- Send update notifications
   
       my @subscribed=&get_subscribed_hosts($target);
       foreach my $subhost (@subscribed) {
    $r->print('<p>'.&mt('Notifying host').' '.$subhost.':');$r->rflush;
    my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
    $r->print($reply.'</p><br />');$r->rflush;
       }
   # ------------------------------------------------------------------- Link back
       my $link=$fn;
       $link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//;
       $r->print("<a href='$link'>".&mt('Back to Catalog Information').'</a>');
       $r->print('</body></html>');
       return OK;
 }  }
 #########################################  #########################################
   
Line 1666  Publishing from $thisfn to $thistarget w Line 1809  Publishing from $thisfn to $thistarget w
 #########################################  #########################################
 #########################################  #########################################
 sub handler {  sub handler {
   my $r=shift;      my $r=shift;
   
   if ($r->header_only) {      if ($r->header_only) {
      &Apache::loncommon::content_type($r,'text/html');   &Apache::loncommon::content_type($r,'text/html');
      $r->send_http_header;   $r->send_http_header;
      return OK;   return OK;
   }      }
   
 # Get query string for limited number of parameters  # Get query string for limited number of parameters
   
     &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=&Apache::lonnet::unescape($ENV{'form.filename'});
   
       ($cuname,$cudom)=
    &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
   
   # special publication: default.meta file
       if ($fn=~/\/default.meta$/) {
    return &defaultmetapublish($r,$fn,$cuname,$cudom); 
       }
       $fn=~s/\.meta$//;
       
   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;
   }       } 
   
   ($cuname,$cudom)=      unless (($cuname) && ($cudom)) {
     &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));   $r->log_reason($cuname.' at '.$cudom.
   unless (($cuname) && ($cudom)) {         ' trying to publish file '.$ENV{'form.filename'}.
      $r->log_reason($cuname.' at '.$cudom.         ' ('.$fn.') - not authorized', 
          ' trying to publish file '.$ENV{'form.filename'}.         $r->filename); 
          ' ('.$fn.') - not authorized',    return HTTP_NOT_ACCEPTABLE;
          $r->filename);       }
      return HTTP_NOT_ACCEPTABLE;  
   }      my $home=&Apache::lonnet::homeserver($cuname,$cudom);
       my $allowed=0;
   unless (&Apache::lonnet::homeserver($cuname,$cudom)       my @ids=&Apache::lonnet::current_machine_ids();
           eq $r->dir_config('lonHostID')) {      foreach my $id (@ids) { if ($id eq $home) { $allowed = 1; }  }
      $r->log_reason($cuname.' at '.$cudom.      unless ($allowed) {
          ' trying to publish file '.$ENV{'form.filename'}.   $r->log_reason($cuname.' at '.$cudom.
          ' ('.$fn.') - not homeserver ('.         ' trying to publish file '.$ENV{'form.filename'}.
          &Apache::lonnet::homeserver($cuname,$cudom).')',          ' ('.$fn.') - not homeserver ('.$home.')', 
          $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/^\/\~(\w+)/\/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 '.$ENV{'form.filename'}.         ' trying to publish unowned file '.
          ' ('.$fn.')',          $ENV{'form.filename'}.' ('.$fn.')', 
          $r->filename);          $r->filename); 
      return HTTP_NOT_ACCEPTABLE;   return HTTP_NOT_ACCEPTABLE;
   } else {      } else {
       $targetdir=$docroot.'/res/'.$cudom;   $targetdir=$docroot.'/res/'.$cudom;
   }      }
                                                                     
       
   unless (-e $fn) {       unless (-e $fn) { 
      $r->log_reason($cuname.' at '.$cudom.   $r->log_reason($cuname.' at '.$cudom.
          ' trying to publish non-existing file '.$ENV{'form.filename'}.         ' trying to publish non-existing file '.
          ' ('.$fn.')',          $ENV{'form.filename'}.' ('.$fn.')', 
          $r->filename);          $r->filename); 
      return HTTP_NOT_FOUND;   return HTTP_NOT_FOUND;
   }       } 
   
 unless ($ENV{'form.phase'} eq 'two') {      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=();  
   
   {  
      my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');  
       while (<$fh>) {  
           my $word=$_;  
           chomp($word);  
           $nokey{$word}=1;  
       }  
   }  
   
 }   %nokey=();
   
 # ---------------------------------------------------------- Start page output.   {
       my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
       while (<$fh>) {
    my $word=$_;
    chomp($word);
    $nokey{$word}=1;
       }
    }
   
   &Apache::loncommon::content_type($r,'text/html');      }
   $r->send_http_header;  
   
   $r->print('<html><head><title>LON-CAPA Publishing</title></head>');  # ---------------------------------------------------------- Start page output.
   $r->print(&Apache::loncommon::bodytag('Resource Publication'));  
       &Apache::loncommon::content_type($r,'text/html');
       $r->send_http_header;
       
       my $js=&Apache::loncommon::browser_and_searcher_javascript();
       $r->print('<html><head><title>LON-CAPA Publishing</title>
                 <script type="text/javascript">'.$js.'
                 </script></head>');
       $r->print(&Apache::loncommon::bodytag('Resource Publication'));
   
   
   my $thisfn=$fn;      my $thisfn=$fn;
   
   my $thistarget=$thisfn;      my $thistarget=$thisfn;
               
   $thistarget=~s/^\/home/$targetdir/;      $thistarget=~s/^\/home/$targetdir/;
   $thistarget=~s/\/public\_html//;      $thistarget=~s/\/public\_html//;
   
   my $thisdistarget=$thistarget;      my $thisdistarget=$thistarget;
   $thisdistarget=~s/^\Q$docroot\E//;      $thisdistarget=~s/^\Q$docroot\E//;
   
   my $thisdisfn=$thisfn;      my $thisdisfn=$thisfn;
   $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///;      $thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///;
   
   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><font size="+2">'.&mt('Done').'</font><br><a href="/priv/'
  .$cuname.'/'.$thisdisfn    .$cuname.'/'.$thisdisfn
  .'">'.&mt('Return to Directory').'</a>');    .'">'.&mt('Return to Directory').'</a>');
   
   
   } else {      } else {
 # ---------------------- Evaluate individual file, and then output information.  # ---------------------- Evaluate individual file, and then output information.
       $thisfn=~/\.(\w+)$/;   $thisfn=~/\.(\w+)$/;
       my $thistype=$1;   my $thistype=$1;
       my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);   my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
       $r->print('<h2>'.&mt('Publishing').' '.   $r->print('<h2>'.&mt('Publishing').' '.
  &Apache::loncommon::filedescription($thistype).' <tt>');    &Apache::loncommon::filedescription($thistype).' <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("/~$cuname/$thisdisfn","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>
 $thisdisfn</a>  $thisdisfn</a>
 ENDCAPTION  ENDCAPTION
       $r->print(          $r->print('</tt></h2><b>'.&mt('Target').':</b> <tt>'.
         '</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').': '.$cuname.&mt(' at ').$cudom.      $r->print('<h3><font color="red">'.&mt('Co-Author').': '.
     '</font></h3>');        $cuname.&mt(' at ').$cudom.'</font></h3>');
       }   }
   
       if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {   if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
           $r->print(<<ENDDIFF);      $r->print(<<ENDDIFF);
 <br />  <br />
 <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=/~$cuname/$thisdisfn&versiontwo=priv","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>
 ENDDIFF  ENDDIFF
           $r->print(&mt('Diffs with Current Version').'</a><br />');              $r->print(&mt('Diffs with Current Version').'</a><br />');
       }   }
       
 # ------------------ 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);      my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle);
    $r->print('<hr />'.$outstring);      $r->print('<hr />'.$outstring);
        } else {   } else {
            $r->print('<hr />');      $r->print('<hr />'.
            &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget);       &phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget)); 
        }   }
   }      }
   $r->print('</body></html>');      $r->print('</body></html>');
   
   return OK;      return OK;
 }  }
   
 1;  1;
Removed from v.1.138  
changed lines
  Added in v.1.184

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