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

Diff for /loncom/publisher/lonpublisher.pm between versions 1.153 and 1.167

version 1.153, 2003/12/26 21:17:37 version 1.167, 2004/05/21 19:27:02
Line 126  use Apache::loncommon(); Line 126  use Apache::loncommon();
 use Apache::lonmysql;  use Apache::lonmysql;
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::loncfile;  use Apache::loncfile;
   use LONCAPA::lonmetadata;
   use Apache::lonmsg;
 use vars qw(%metadatafields %metadatakeys);  use vars qw(%metadatafields %metadatakeys);
   
 my %addid;  my %addid;
Line 202  sub metaeval { Line 204  sub metaeval {
  if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; }   if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; }
     }      }
 # actually store  # actually store
     $metadatafields{$unikey}=$newentry;      if ( $entry eq 'rule' && exists($metadatafields{$unikey})) {
    $metadatafields{$unikey}.=','.$newentry;
       } else {
    $metadatafields{$unikey}=$newentry;
       }
  }   }
     }      }
 }  }
Line 316  sub textfield { Line 322  sub textfield {
     $value=~s/\s+$//gs;      $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 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 344  sub selectbox { Line 355  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 791  sub store_metadata { Line 808  sub store_metadata {
     ('metadata','url',$metadata{'url'});      ('metadata','url',$metadata{'url'});
     } else {      } else {
 # store new data  # store new data
   # adjust some values to metadatadatabase (e.g., "usage" is a reserved word)
  $metadata{'creationdate'}=   $metadata{'creationdate'}=
     &Apache::lonmysql::sqltime($metadata{'creationdate'});       &Apache::lonmysql::sqltime($metadata{'creationdate'}); 
  $metadata{'lastrevisiondate'}=   $metadata{'lastrevisiondate'}=
     &Apache::lonmysql::sqltime($metadata{'lastrevisiondate'});       &Apache::lonmysql::sqltime($metadata{'lastrevisiondate'});
  $status = &Apache::lonmysql::store_row('metadata',\%metadata);   $metadata{'sequsage'}=$metadata{'usage'};
    $metadata{'sequsage_list'}=$metadata{'usage_list'};
    my %newmetadata=();
   # see if we have old entries
    my @oldmeta=&Apache::lonmysql::get_rows('metadata',
    "url LIKE BINARY '".
    $metadata{'url'}."'");
    if ($#oldmeta==0) {
   # yes, there is one old entry, transfer to newmetadata
       %newmetadata=&LONCAPA::lonmetadata::metadata_col_to_hash(@{$oldmeta[0]});
   # remove old entry
       $status=&Apache::lonmysql::remove_from_table
    ('metadata','url',$metadata{'url'});
    } elsif ($#oldmeta>0) {
   # more than one entry fit - how did that happen?
       $error='<font color="red">Error occured retrieving old values in '.
         'metadata table in LON-CAPA database: '.$#oldmeta.
         ' matches</font>';
       &Apache::lonnet::logthis($error);
       return ($error,undef);
    }
   # store new data on top of it
    foreach (keys %metadata) {
       $newmetadata{$_}=$metadata{$_};
    }
    $status = &Apache::lonmysql::store_row('metadata',\%newmetadata);
     }      }
     if (! defined($status)) {      if (! defined($status)) {
         $error='<font color="red">Error occured storing new values in '.          $error='<font color="red">Error occured storing new values in '.
Line 890  sub publish { Line 933  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'}.'/'.
Line 915  sub publish { Line 958  sub publish {
         }          }
         $outstring=~s/\n*(\<\/[^\>]+\>)\s*$/$allowstr\n$1\n/s;          $outstring=~s/\n*(\<\/[^\>]+\>)\s*$/$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 960  sub publish { Line 998  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 1007  sub publish { Line 1042  sub publish {
 # ------------------------------------------ See if anything new in file itself  # ------------------------------------------ See if anything new in file itself
     
  $allmeta=&parseformeta($source,$style);   $allmeta=&parseformeta($source,$style);
   
    }     }
   
                 
Line 1071  sub publish { Line 1107  sub publish {
     }      }
 # --------------------------------------------------- Now we also have keywords  # --------------------------------------------------- Now we also have keywords
 # =============================================================================  # =============================================================================
 # INTERACTIVE MODE  # interactive mode html goes into $intr_scrout
 #  # batch mode throws away this HTML
     unless ($batch) {  # additionally all of the field functions have a by product of setting
         $scrout.=  #   $ENV{'from.'..} so that it can be used by the phase two handler in
     '<form name="pubform" action="/adm/publish" method="post">'.  #    batch mode
             '<p><input type="submit" value="'.&mt('Finalize Publication').'" /></p>'.  
             &hiddenfield('phase','two').      my $intr_scrout.=
             &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 $KEYWORDS=&mt('KEYWORDS');      my $KEYWORDS=&mt('Keywords');
  my $CheckAll=&mt('check all');      my $CheckAll=&mt('check all');
  my $UncheckAll=&mt('uncheck all');      my $UncheckAll=&mt('uncheck all');
  my $keywordout=<<"END";      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 1110  function uncheckAll(field) { Line 1149  function uncheckAll(field) {
 </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><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.=' />'.$_.'</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>".&mt('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.=      $intr_scrout.=
     "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".   "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
     uc(&mt('Lowest Grade Level:')).   &mt('Lowest Grade Level').':'.
            "</b></font></p><br />".   "</b></font></p><br />".
    &Apache::loncommon::select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel').   &select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel').
     "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".   "\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
     uc(&mt('Highest Grade Level:')).   &mt('Highest Grade Level').':'.
            "</b></font></p><br />".   "</b></font></p><br />".
    &Apache::loncommon::select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel').   &select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel').
            &textfield('Standards','standards',$metadatafields{'standards'});   &textfield('Standards','standards',$metadatafields{'standards'});
   
   
   
   
  $scrout.=&hiddenfield('mime',$1);      $intr_scrout.=&hiddenfield('mime',$1);
   
  my $defaultlanguage=$metadatafields{'language'};      my $defaultlanguage=$metadatafields{'language'};
  $defaultlanguage =~ s/\s*notset\s*//g;      $defaultlanguage =~ s/\s*notset\s*//g;
  $defaultlanguage =~ s/^,\s*//g;      $defaultlanguage =~ s/^,\s*//g;
  $defaultlanguage =~ s/,\s*$//g;      $defaultlanguage =~ s/,\s*$//g;
   
  $scrout.=&selectbox('Language','language',      $intr_scrout.=&selectbox('Language','language',
     $defaultlanguage,       $defaultlanguage,
     \&Apache::loncommon::languagedescription,       \&Apache::loncommon::languagedescription,
     (&Apache::loncommon::languageids),       (&Apache::loncommon::languageids),
    );       );
   
  unless ($metadatafields{'creationdate'}) {      unless ($metadatafields{'creationdate'}) {
     $metadatafields{'creationdate'}=time;   $metadatafields{'creationdate'}=time;
  }      }
  $scrout.=&hiddenfield('creationdate',      $intr_scrout.=&hiddenfield('creationdate',
       &Apache::lonmysql::unsqltime($metadatafields{'creationdate'}));         &Apache::lonmysql::unsqltime($metadatafields{'creationdate'}));
   
  $scrout.=&hiddenfield('lastrevisiondate',time);      $intr_scrout.=&hiddenfield('lastrevisiondate',time);
   
   
  $scrout.=&textfield('Publisher/Owner','owner',      $intr_scrout.=&textfield('Publisher/Owner','owner',
     $metadatafields{'owner'});       $metadatafields{'owner'});
   
 # -------------------------------------------------- Correct copyright for rat.  # -------------------------------------------------- Correct copyright for rat.
         my $defaultoption=$metadatafields{'copyright'};      my $defaultoption=$metadatafields{'copyright'};
         unless ($defaultoption) { $defaultoption='default'; }      unless ($defaultoption) { $defaultoption='default'; }
  unless ($style eq 'prv') {      unless ($style eq 'prv') {
     if ($style eq 'rat') {   if ($style eq 'rat') {
  if ($metadatafields{'copyright'} eq 'public') {       if ($metadatafields{'copyright'} eq 'public') { 
     delete $metadatafields{'copyright'};   delete $metadatafields{'copyright'};
                     $defaultoption='default';   $defaultoption='default';
  }      }
  $scrout.=&selectbox('Copyright/Distribution','copyright',      $intr_scrout.=&selectbox('Copyright/Distribution','copyright',
     $defaultoption,       $defaultoption,
     \&Apache::loncommon::copyrightdescription,       \&Apache::loncommon::copyrightdescription,
     (grep !/^public$/,(&Apache::loncommon::copyrightids)));      (grep !/^public$/,(&Apache::loncommon::copyrightids)));
     } else {      } else {
  $scrout.=&selectbox('Copyright/Distribution','copyright',   $intr_scrout.=&selectbox('Copyright/Distribution','copyright',
     $defaultoption,      $defaultoption,
     \&Apache::loncommon::copyrightdescription,      \&Apache::loncommon::copyrightdescription,
     (&Apache::loncommon::copyrightids));      (&Apache::loncommon::copyrightids));
Line 1208  END Line 1250  END
           
     my $copyright_help =      my $copyright_help =
  Apache::loncommon::help_open_topic('Publishing_Copyright');   Apache::loncommon::help_open_topic('Publishing_Copyright');
     $scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;      $intr_scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;
     $scrout.=&textfield('Custom Distribution File','customdistributionfile',      $intr_scrout.=&textfield('Custom Distribution File','customdistributionfile',
  $metadatafields{'customdistributionfile'}).   $metadatafields{'customdistributionfile'}).
     $copyright_help;      $copyright_help;
     my $uctitle=uc(&mt('Obsolete'));      my $uctitle=&mt('Obsolete');
             $scrout.=              $intr_scrout.=
  "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".   "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
  '</b></font> <input type="checkbox" name="obsolete" ';   '</b></font> <input type="checkbox" name="obsolete" ';
     if ($metadatafields{'obsolete'}) {      if ($metadatafields{'obsolete'}) {
  $scrout.=' checked="1" ';   $intr_scrout.=' checked="1" ';
     }      }
     $scrout.='/ ></p>'.      $intr_scrout.='/ ></p>'.
  &textfield('Suggested Replacement for Obsolete File',   &textfield('Suggested Replacement for Obsolete File',
     'obsoletereplacement',      'obsoletereplacement',
     $metadatafields{'obsoletereplacement'});      $metadatafields{'obsoletereplacement'});
  } else {   } else {
     $scrout.=&hiddenfield('copyright','private');      $intr_scrout.=&hiddenfield('copyright','private');
  }  
  return ($scrout.'<p><input type="submit" value="'.  
  &mt('Finalize Publication').'" /></p></form>',0);  
 # =============================================================================  
 # 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/\,$//;  
  unless ($ENV{'form.creationdate'}) { $ENV{'form.creationdate'}=time; }  
  $ENV{'form.lastrevisiondate'}=time;  
  if ((($style eq 'rat') && ($ENV{'form.copyright'} eq 'public')) ||  
     (!$ENV{'form.copyright'})) {   
     $ENV{'form.copyright'}='default';  
  }   }
  $ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta);      if (!$batch) {
  return ($scrout,0);   $scrout.=$intr_scrout.'<p><input type="submit" value="'.
       &mt('Finalize Publication').'" /></p></form>';
     }      }
       return($scrout,0);
 }  }
   
 #########################################  #########################################
Line 1322  sub phasetwo { Line 1338  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 1345  sub phasetwo { Line 1361  sub phasetwo {
     $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 1388  sub phasetwo { Line 1407  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 1409  sub phasetwo { Line 1428  sub phasetwo {
  $r->print($error);   $r->print($error);
  print $logfile "\n".$error;   print $logfile "\n".$error;
     }      }
   # --------------------------------------------- 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 1622  sub publishdirectory { Line 1644  sub publishdirectory {
     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.
   
Line 1661  sub publishdirectory { Line 1683  sub publishdirectory {
     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;
   }
 #########################################  #########################################
   
 =pod  =pod
Line 1726  sub handler { Line 1805  sub handler {
   
     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.
Line 1733  sub handler { Line 1820  sub handler {
  return HTTP_NOT_FOUND;   return HTTP_NOT_FOUND;
     }       } 
   
     ($cuname,$cudom)=  
  &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));  
     unless (($cuname) && ($cudom)) {      unless (($cuname) && ($cudom)) {
  $r->log_reason($cuname.' at '.$cudom.   $r->log_reason($cuname.' at '.$cudom.
        ' trying to publish file '.$ENV{'form.filename'}.         ' trying to publish file '.$ENV{'form.filename'}.
Line 1743  sub handler { Line 1828  sub handler {
  return HTTP_NOT_ACCEPTABLE;   return HTTP_NOT_ACCEPTABLE;
     }      }
   
     unless (&Apache::lonnet::homeserver($cuname,$cudom)       my $home=&Apache::lonnet::homeserver($cuname,$cudom);
     eq $r->dir_config('lonHostID')) {      my $allowed=0;
       my @ids=&Apache::lonnet::current_machine_ids();
       foreach my $id (@ids) { if ($id eq $home) { $allowed = 1; }  }
       unless ($allowed) {
  $r->log_reason($cuname.' at '.$cudom.   $r->log_reason($cuname.' at '.$cudom.
        ' trying to publish file '.$ENV{'form.filename'}.         ' trying to publish file '.$ENV{'form.filename'}.
        ' ('.$fn.') - not homeserver ('.         ' ('.$fn.') - not homeserver ('.$home.')', 
        &Apache::lonnet::homeserver($cuname,$cudom).')',   
        $r->filename);          $r->filename); 
  return HTTP_NOT_ACCEPTABLE;   return HTTP_NOT_ACCEPTABLE;
     }      }
Removed from v.1.153  
changed lines
  Added in v.1.167

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