version 1.158, 2003/12/29 21:17:00
|
version 1.165, 2004/03/31 05:24:00
|
Line 127 use Apache::lonmysql;
|
Line 127 use Apache::lonmysql;
|
use Apache::lonlocal; |
use Apache::lonlocal; |
use Apache::loncfile; |
use Apache::loncfile; |
use Apache::lonmeta; |
use Apache::lonmeta; |
|
use Apache::lonmsg; |
use vars qw(%metadatafields %metadatakeys); |
use vars qw(%metadatafields %metadatakeys); |
|
|
my %addid; |
my %addid; |
Line 203 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 915 sub publish {
|
Line 920 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 940 sub publish {
|
Line 945 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 1029 sub publish {
|
Line 1029 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 1413 sub phasetwo {
|
Line 1414 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 1434 sub phasetwo {
|
Line 1435 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 1693 sub publishdirectory {
|
Line 1697 sub publishdirectory {
|
} |
} |
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 1751 sub handler {
|
Line 1812 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 1758 sub handler {
|
Line 1827 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 1768 sub handler {
|
Line 1835 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; |
} |
} |