Return to lonpublisher.pm CVS log

Up to [LON-CAPA] / loncom / publisher

Diff for /loncom/publisher/lonpublisher.pm between versions 1.164 and 1.261

version 1.164, 2004/02/27 17:27:51	version 1.261, 2009/07/25 06:55:31
Line 118 use Apache::File;	Line 118 use Apache::File;
use File::Copy;	use File::Copy;
use Apache::Constants qw(:common :http :methods);	use Apache::Constants qw(:common :http :methods);
use HTML::LCParser;	use HTML::LCParser;
	use HTML::Entities;
	use Encode::Encoder;
use Apache::lonxml;	use Apache::lonxml;
use Apache::loncacc;	use Apache::loncacc;
use DBI;	use DBI;
use Apache::lonnet();	use Apache::lonnet;
use Apache::loncommon();	use Apache::loncommon();
	use Apache::lonhtmlcommon;
use Apache::lonmysql;	use Apache::lonmysql;
use Apache::lonlocal;	use Apache::lonlocal;
use Apache::loncfile;	use Apache::loncfile;
use Apache::lonmeta;	use LONCAPA::lonmetadata;
use Apache::lonmsg;	use Apache::lonmsg;
use vars qw(%metadatafields %metadatakeys);	use vars qw(%metadatafields %metadatakeys);
	use LONCAPA qw(:DEFAULT :match);


my %addid;	my %addid;
my %nokey;	my %nokey;
Line 138 my $docroot;	Line 143 my $docroot;
my $cuname;	my $cuname;
my $cudom;	my $cudom;

	my $registered_cleanup;
	my $modified_urls;

	my $lock;

=pod	=pod

=item B<metaeval>	=item B<metaeval>
Line 178 sub metaeval {	Line 188 sub metaeval {
if ($token->[0] eq 'S') {	if ($token->[0] eq 'S') {
my $entry=$token->[1];	my $entry=$token->[1];
my $unikey=$entry;	my $unikey=$entry;
	next if ($entry =~ m/^(?:parameter\|stores)_/);
if (defined($token->[2]->{'package'})) {	if (defined($token->[2]->{'package'})) {
$unikey.='_package_'.$token->[2]->{'package'};	$unikey.="\0package\0".$token->[2]->{'package'};
}	}
if (defined($token->[2]->{'part'})) {	if (defined($token->[2]->{'part'})) {
$unikey.='_'.$token->[2]->{'part'};	$unikey.="\0".$token->[2]->{'part'};
}	}
if (defined($token->[2]->{'id'})) {	if (defined($token->[2]->{'id'})) {
$unikey.='_'.$token->[2]->{'id'};	$unikey.="\0".$token->[2]->{'id'};
}	}
if (defined($token->[2]->{'name'})) {	if (defined($token->[2]->{'name'})) {
$unikey.='_'.$token->[2]->{'name'};	$unikey.="\0".$token->[2]->{'name'};
}	}
foreach (@{$token->[3]}) {	foreach (@{$token->[3]}) {
$metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};	$metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
Line 199 sub metaeval {	Line 210 sub metaeval {
}	}
}	}
my $newentry=$parser->get_text('/'.$entry);	my $newentry=$parser->get_text('/'.$entry);
if ($entry eq 'customdistributionfile') {	if (($entry eq 'customdistributionfile') \|\|
	($entry eq 'sourcerights')) {
$newentry=~s/^\s*//;	$newentry=~s/^\s*//;
if ($newentry !~m\|^/res\|) { $newentry=$prefix.$newentry; }	if ($newentry !~m\|^/res\|) { $newentry=$prefix.$newentry; }
}	}
Line 254 sub metaread {	Line 266 sub metaread {
my ($logfile,$fn,$prefix)=@_;	my ($logfile,$fn,$prefix)=@_;
unless (-e $fn) {	unless (-e $fn) {
print($logfile 'No file '.$fn."\n");	print($logfile 'No file '.$fn."\n");
return '<br /><b>'.&mt('No file').':</b> <tt>'.	return '<div><b>'
&Apache::loncfile::display($fn).'</tt>';	.&mt('No file: [_1]'
	,'</b> <tt>'.&Apache::loncfile::display($fn).'</tt></div>');
}	}
print($logfile 'Processing '.$fn."\n");	print($logfile 'Processing '.$fn."\n");
my $metastring;	my $metastring;
Line 264 sub metaread {	Line 277 sub metaread {
$metastring=join('',<$metafh>);	$metastring=join('',<$metafh>);
}	}
&metaeval($metastring,$prefix);	&metaeval($metastring,$prefix);
return '<br /><b>'.&mt('Processed file').':</b> <tt>'.	return '<div><b>'
&Apache::loncfile::display($fn).'</tt>';	.&mt('Processed file: [_1]'
	,'</b> <tt>'.&Apache::loncfile::display($fn).'</tt></div>');
}	}

#########################################	#########################################
Line 274 sub metaread {	Line 288 sub metaread {
sub coursedependencies {	sub coursedependencies {
my $url=&Apache::lonnet::declutter(shift);	my $url=&Apache::lonnet::declutter(shift);
$url=~s/\.meta$//;	$url=~s/\.meta$//;
my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);	my ($adomain,$aauthor)=($url=~ m{^($match_domain)/($match_username)/});
my $regexp=$url;	my $regexp=quotemeta($url);
$regexp=~s/(\W)/\\$1/g;
$regexp='___'.$regexp.'___course';	$regexp='___'.$regexp.'___course';
my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,	my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
$aauthor,$regexp);	$aauthor,$regexp);
Line 317 string which presents the form field (fo	Line 330 string which presents the form field (fo
#########################################	#########################################
#########################################	#########################################
sub textfield {	sub textfield {
my ($title,$name,$value)=@_;	my ($title,$name,$value,$noline)=@_;
$value=~s/^\s+//gs;	$value=~s/^\s+//gs;
$value=~s/\s+$//gs;	$value=~s/\s+$//gs;
$value=~s/\s+/ /gs;	$value=~s/\s+/ /gs;
$title=&mt($title);	$title=&mt($title);
return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".	$env{'form.'.$name}=$value;
"</b></font></p><br />".	return "\n".&Apache::lonhtmlcommon::row_title($title)
'<input type="text" name="'.$name.'" size=80 value="'.$value.'" />';	.'<input type="text" name="'.$name.'" size="80" value="'.$value.'" />'
	.&Apache::lonhtmlcommon::row_closure($noline);
	}

	sub text_with_browse_field {
	my ($title,$name,$value,$restriction,$noline)=@_;
	$value=~s/^\s+//gs;
	$value=~s/\s+$//gs;
	$value=~s/\s+/ /gs;
	$title=&mt($title);
	$env{'form.'.$name}=$value;
	return "\n".&Apache::lonhtmlcommon::row_title($title)
	.'<input type="text" name="'.$name.'" size="80" value="'.$value.'" />'
	.'<br />'
	.'<a href="javascript:openbrowser(\'pubform\',\''.$name.'\',\''.$restriction.'\');">'
	.&mt('Select')
	.'</a> '
	.'<a href="javascript:opensearcher(\'pubform\',\''.$name.'\');">'
	.&mt('Search')
	.'</a>'
	.&Apache::lonhtmlcommon::row_closure($noline);
}	}

sub hiddenfield {	sub hiddenfield {
my ($name,$value)=@_;	my ($name,$value)=@_;
	$env{'form.'.$name}=$value;
return "\n".'<input type="hidden" name="'.$name.'" value="'.$value.'" />';	return "\n".'<input type="hidden" name="'.$name.'" value="'.$value.'" />';
}	}

	sub checkbox {
	my ($name,$text)=@_;
	return "\n<br /><label><input type='checkbox' name='$name' /> ".
	&mt($text)."</label>";
	}

sub selectbox {	sub selectbox {
my ($title,$name,$value,$functionref,@idlist)=@_;	my ($title,$name,$value,$functionref,@idlist)=@_;
$title=&mt($title);	$title=&mt($title);
$value=(split(/\s,\s/,$value))[-1];	$value=(split(/\s,\s/,$value))[-1];
my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".	if (defined($value)) {
'</b></font></p><br /><select name="'.$name.'">';	$env{'form.'.$name}=$value;
	} else {
	$env{'form.'.$name}=$idlist[0];
	}
	my $selout="\n".&Apache::lonhtmlcommon::row_title($title)
	.'<select name="'.$name.'">';
foreach (@idlist) {	foreach (@idlist) {
$selout.='<option value=\''.$_.'\'';	$selout.='<option value="'.$_.'"';
if ($_ eq $value) {	if ($_ eq $value) {
$selout.=' selected>'.&{$functionref}($_).'</option>';	$selout.=' selected="selected"';
}	}
else {$selout.='>'.&{$functionref}($_).'</option>';}	$selout.='>'.&{$functionref}($_).'</option>';
}	}
return $selout.'</select>';	$selout.='</select>'.&Apache::lonhtmlcommon::row_closure();
	return $selout;
}	}

	sub select_level_form {
	my ($value,$name)=@_;
	$env{'form.'.$name}=$value;
	if (!defined($value)) { $env{'form.'.$name}=0; }
	return &Apache::loncommon::select_level_form($value,$name);
	}
#########################################	#########################################
#########################################	#########################################

Line 369 sub urlfixup {	Line 421 sub urlfixup {
if ($url =~ /^mailto:/i) { return $url; }	if ($url =~ /^mailto:/i) { return $url; }
#internal document links need no fixing	#internal document links need no fixing
if ($url =~ /^\#/) { return $url; }	if ($url =~ /^\#/) { return $url; }
my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);	my ($host)=($url=~m{(?:(?:http\|https\|ftp)://)*([^/]+)});
foreach (values %Apache::lonnet::hostname) {	my @lonids = &Apache::lonnet::machine_ids($host);
if ($_ eq $host) {	if (@lonids) {
$url=~s/^http\:\/\///;	$url=~s{^(?:http\|https\|ftp)://}{};
$url=~s/^$host//;	$url=~s/^\Q$host\E//;
}
}	}
if ($url=~/^http\:\/\//) { return $url; }	if ($url=~m{^(?:http\|https\|ftp)://}) { return $url; }
$url=~s/\~$cuname/res\/$cudom\/$cuname/;	$url=~s{\Q~$cuname\E}{res/$cudom/$cuname};
return $url;	return $url;
}	}

Line 428 sub set_allow {	Line 479 sub set_allow {
}	}
if (($newurl !~ /^javascript:/i) &&	if (($newurl !~ /^javascript:/i) &&
($newurl !~ /^mailto:/i) &&	($newurl !~ /^mailto:/i) &&
($newurl !~ /^http:/i) &&	($newurl !~ /^(?:http\|https\|ftp):/i) &&
($newurl !~ /^\#/)) {	($newurl !~ /^\#/)) {
$$allow{&absoluteurl($newurl,$target)}=1;	$$allow{&absoluteurl($newurl,$target)}=1;
}	}
return $return_url	return $return_url;
}	}

#########################################	#########################################
Line 455 sub get_subscribed_hosts {	Line 506 sub get_subscribed_hosts {
$target=~/(.*)\/([^\/]+)$/;	$target=~/(.*)\/([^\/]+)$/;
my $srcf=$2;	my $srcf=$2;
opendir(DIR,$1);	opendir(DIR,$1);
	# cycle through listed files, subscriptions used to exist
	# as "filename.lonid"
while ($filename=readdir(DIR)) {	while ($filename=readdir(DIR)) {
if ($filename=~/\Q$srcf\E\.(\w+)$/) {	if ($filename=~/\Q$srcf\E\.($match_lonid)$/) {
my $subhost=$1;	my $subhost=$1;
if (($subhost ne 'meta' && $subhost ne 'subscription') &&	if (($subhost ne 'meta'
	&& $subhost ne 'subscription'
	&& $subhost ne 'meta.subscription'
	&& $subhost ne 'tmp') &&
($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) {	($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) {
push(@subscribed,$subhost);	push(@subscribed,$subhost);
}	}
Line 467 sub get_subscribed_hosts {	Line 523 sub get_subscribed_hosts {
closedir(DIR);	closedir(DIR);
my $sh;	my $sh;
if ( $sh=Apache::File->new("$target.subscription") ) {	if ( $sh=Apache::File->new("$target.subscription") ) {
&Apache::lonnet::logthis("opened $target.subscription");
while (my $subline=<$sh>) {	while (my $subline=<$sh>) {
&Apache::lonnet::logthis("Trying $subline");	if ($subline =~ /^($match_lonid):/) {
if ($subline =~ /(^\w+):/) {
if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) {	if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) {
push(@subscribed,$1);	push(@subscribed,$1);
}	}
} else {
&Apache::lonnet::logthis("No Match for $subline");
}	}
}	}
} else {
&Apache::lonnet::logthis("Unable to open $target.subscription");
}	}
return @subscribed;	return @subscribed;
}	}
Line 509 sub get_max_ids_indices {	Line 559 sub get_max_ids_indices {
my %duplicatedids;	my %duplicatedids;

my $parser=HTML::LCParser->new($content);	my $parser=HTML::LCParser->new($content);
	$parser->xml_mode(1);
my $token;	my $token;
while ($token=$parser->get_token) {	while ($token=$parser->get_token) {
if ($token->[0] eq 'S') {	if ($token->[0] eq 'S') {
my $counter;	my $counter;
if ($counter=$addid{$token->[1]}) {	if ($counter=$addid{$token->[1]}) {
if ($counter eq 'id') {	if ($counter eq 'id') {
if (defined($token->[2]->{'id'})) {	if (defined($token->[2]->{'id'}) &&
	$token->[2]->{'id'} !~ /^\s*$/) {
$maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;	$maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
if (exists($allids{$token->[2]->{'id'}})) {	if (exists($allids{$token->[2]->{'id'}})) {
$duplicateids=1;	$duplicateids=1;
Line 527 sub get_max_ids_indices {	Line 579 sub get_max_ids_indices {
$needsfixup=1;	$needsfixup=1;
}	}
} else {	} else {
if (defined($token->[2]->{'index'})) {	if (defined($token->[2]->{'index'}) &&
	$token->[2]->{'index'} !~ /^\s*$/) {
$maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;	$maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
} else {	} else {
$needsfixup=1;	$needsfixup=1;
Line 569 sub get_all_text_unbalanced {	Line 622 sub get_all_text_unbalanced {
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
$result.=$token->[2];	$result.=$token->[2];
}	}
if ($result =~ /(.)\Q$tag\E(.)/s) {	if ($result =~ /\Q$tag\E/s) {
	($result,my $redo)=$result =~ /(.)\Q$tag\E(.)/is;
#&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2);	#&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2);
#&Apache::lonnet::logthis('Result is :'.$1);	#&Apache::lonnet::logthis('Result is :'.$1);
$result=$1;	$redo=$tag.$redo;
my $redo=$tag.$2;
push (@$pars,HTML::LCParser->new(\$redo));	push (@$pars,HTML::LCParser->new(\$redo));
$$pars[-1]->xml_mode('1');	$$pars[-1]->xml_mode('1');
last;	last;
Line 613 sub fix_ids_and_indices {	Line 666 sub fix_ids_and_indices {
join(', ',@duplicatedids));	join(', ',@duplicatedids));
if ($duplicateids) {	if ($duplicateids) {
print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n";	print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n";
my $outstring='<font color="red">'.&mt('Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are').': '.join(', ',@duplicatedids).'</font>';	my $outstring='<span class="LC_error">'.&mt('Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are').': '.join(', ',@duplicatedids).'</span>';
return ($outstring,1);	return ($outstring,1);
}	}
if ($needsfixup) {	if ($needsfixup) {
Line 622 sub fix_ids_and_indices {	Line 675 sub fix_ids_and_indices {
"Max Index: $maxindex (min 10)\n";	"Max Index: $maxindex (min 10)\n";
}	}
my $outstring='';	my $outstring='';
	my $responsecounter=1;
my @parser;	my @parser;
$parser[0]=HTML::LCParser->new(\$content);	$parser[0]=HTML::LCParser->new(\$content);
$parser[-1]->xml_mode(1);	$parser[-1]->xml_mode(1);
Line 636 sub fix_ids_and_indices {	Line 690 sub fix_ids_and_indices {
$allow{$token->[2]->{'src'}}=1;	$allow{$token->[2]->{'src'}}=1;
next;	next;
}	}
	if ($lctag eq 'base') { next; }
	if (($lctag eq 'part') \|\| ($lctag eq 'problem')) {
	$responsecounter=0;
	}
	if ($lctag=~/response$/) { $responsecounter++; }
	if ($lctag eq 'import') { $responsecounter++; }
my %parms=%{$token->[2]};	my %parms=%{$token->[2]};
$counter=$addid{$tag};	$counter=$addid{$tag};
if (!$counter) { $counter=$addid{$lctag}; }	if (!$counter) { $counter=$addid{$lctag}; }
if ($counter) {	if ($counter) {
if ($counter eq 'id') {	if ($counter eq 'id') {
unless (defined($parms{'id'})) {	unless (defined($parms{'id'}) &&
	$parms{'id'}!~/^\s*$/) {
$maxid++;	$maxid++;
$parms{'id'}=$maxid;	$parms{'id'}=$maxid;
print $logfile 'ID: '.$tag.':'.$maxid."\n";	print $logfile 'ID(new) : '.$tag.':'.$maxid."\n";
	} else {
	print $logfile 'ID(kept): '.$tag.':'.$parms{'id'}."\n";
}	}
} elsif ($counter eq 'index') {	} elsif ($counter eq 'index') {
unless (defined($parms{'index'})) {	unless (defined($parms{'index'}) &&
	$parms{'index'}!~/^\s*$/) {
$maxindex++;	$maxindex++;
$parms{'index'}=$maxindex;	$parms{'index'}=$maxindex;
print $logfile 'Index: '.$tag.':'.$maxindex."\n";	print $logfile 'Index: '.$tag.':'.$maxindex."\n";
}	}
}	}
}	}
foreach my $type ('src','href','background','bgimg') {	unless ($parms{'type'} eq 'zombie') {
foreach my $key (keys(%parms)) {	foreach my $type ('src','href','background','bgimg') {
if ($key =~ /^$type$/i) {	foreach my $key (keys(%parms)) {
$parms{$key}=&set_allow(\%allow,$logfile,	if ($key =~ /^$type$/i) {
$target,$tag,	$parms{$key}=&set_allow(\%allow,$logfile,
$parms{$key});	$target,$tag,
	$parms{$key});
	}
}	}
}	}
}	}
Line 670 sub fix_ids_and_indices {	Line 736 sub fix_ids_and_indices {
($lctag eq 'image')) {	($lctag eq 'image')) {
my $next_token=$parser[-1]->get_token();	my $next_token=$parser[-1]->get_token();
if ($next_token->[0] eq 'T') {	if ($next_token->[0] eq 'T') {
	$next_token->[1] =~ s/[\n\r\f]+//g;
$next_token->[1]=&set_allow(\%allow,$logfile,	$next_token->[1]=&set_allow(\%allow,$logfile,
$target,$tag,	$target,$tag,
$next_token->[1]);	$next_token->[1]);
Line 724 sub fix_ids_and_indices {	Line 791 sub fix_ids_and_indices {
}	}
if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }	if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
$outstring.='<'.$tag.$newparmstring.$endtag.'>';	$outstring.='<'.$tag.$newparmstring.$endtag.'>';
if ($lctag eq 'm' \|\| $lctag eq 'script'	if ($lctag eq 'm' \|\| $lctag eq 'script' \|\| $lctag eq 'answer'
\|\| $lctag eq 'display' \|\| $lctag eq 'tex') {	\|\| $lctag eq 'display' \|\| $lctag eq 'tex') {
$outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);	$outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);
}	}
Line 733 sub fix_ids_and_indices {	Line 800 sub fix_ids_and_indices {
unless ($token->[1] eq 'allow') {	unless ($token->[1] eq 'allow') {
$outstring.='</'.$token->[1].'>';	$outstring.='</'.$token->[1].'>';
}	}
}	}
	if ((($token->[1] eq 'part') \|\| ($token->[1] eq 'problem'))
	&& (!$responsecounter)) {
	my $outstring='<span class="LC_error">'.&mt('Found [_1] without responses. This resource cannot be published.',$token->[1]).'</span>';
	return ($outstring,1);
	}
} else {	} else {
$outstring.=$token->[1];	$outstring.=$token->[1];
}	}
Line 776 sub store_metadata {	Line 848 sub store_metadata {
# Determine if the table exists	# Determine if the table exists
my $status = &Apache::lonmysql::check_table('metadata');	my $status = &Apache::lonmysql::check_table('metadata');
if (! defined($status)) {	if (! defined($status)) {
$error='<font color="red">WARNING: Cannot connect to '.	$error='<span class="LC_error">'
'database!</font>';	.&mt('WARNING: Cannot connect to database!')
	.'</span>';
&Apache::lonnet::logthis($error);	&Apache::lonnet::logthis($error);
return ($error,undef);	return ($error,undef);
}	}
if ($status == 0) {	if ($status == 0) {
# It would be nice to actually create the table....	# It would be nice to actually create the table....
$error ='<font color="red">WARNING: The metadata table does not '.	$error ='<span class="LC_error">'
'exist in the LON-CAPA database.</font>';	.&mt('WARNING: The metadata table does not exist in the LON-CAPA database!')
	.'</span>';
&Apache::lonnet::logthis($error);	&Apache::lonnet::logthis($error);
return ($error,undef);	return ($error,undef);
}	}
if (($metadata{'obsolete'}) \|\| ($metadata{'copyright'} eq 'priv') \|\|	my $dbh = &Apache::lonmysql::get_dbh();
($metadata{'copyright'} eq 'custom')) {	if (($metadata{'obsolete'}) \|\| ($metadata{'copyright'} eq 'priv')) {
# remove this entry	# remove this entry
$status=&Apache::lonmysql::remove_from_table	my $delitem = 'url = '.$dbh->quote($metadata{'url'});
('metadata','url',$metadata{'url'});	$status = &LONCAPA::lonmetadata::delete_metadata($dbh,undef,$delitem);

} else {	} else {
# store new data	$status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,undef,
# adjust some values to metadatadatabase (e.g., "usage" is a reserved word)	\%metadata);
$metadata{'creationdate'}=
&Apache::lonmysql::sqltime($metadata{'creationdate'});
$metadata{'lastrevisiondate'}=
&Apache::lonmysql::sqltime($metadata{'lastrevisiondate'});
$metadata{'sequsage'}=$metadata{'usage'};
$metadata{'sequsage_list'}=$metadata{'usage_list'};
my %newmetadata=();
# see if we have old entries
my @oldmeta=&Apache::lonmysql::get_rows('metadata',
"url LIKE BINARY '".
$metadata{'url'}."'");
if ($#oldmeta==0) {
# yes, there is one old entry, transfer to newmetadata
%newmetadata=&Apache::lonmeta::metadata_col_to_hash(@{$oldmeta[0]});
# remove old entry
$status=&Apache::lonmysql::remove_from_table
('metadata','url',$metadata{'url'});
} elsif ($#oldmeta>0) {
# more than one entry fit - how did that happen?
$error='<font color="red">Error occured retrieving old values in '.
'metadata table in LON-CAPA database: '.$#oldmeta.
' matches</font>';
&Apache::lonnet::logthis($error);
return ($error,undef);
}
# store new data on top of it
foreach (keys %metadata) {
$newmetadata{$_}=$metadata{$_};
}
$status = &Apache::lonmysql::store_row('metadata',\%newmetadata);
}	}
if (! defined($status)) {	if (defined($status) && $status ne '') {
$error='<font color="red">Error occured storing new values in '.	$error='<span class="LC_error">'
'metadata table in LON-CAPA database</font>';	.&mt('Error occurred saving new values in metadata table in LON-CAPA database!')
	.'</span>';
&Apache::lonnet::logthis($error);	&Apache::lonnet::logthis($error);
	&Apache::lonnet::logthis($status);
return ($error,undef);	return ($error,undef);
}	}
return (undef,$status);	return (undef,'success');
}	}


	# ========================================== Parse file for errors and warnings

	sub checkonthis {
	my ($r,$source)=@_;
	my $uri=&Apache::lonnet::hreflocation($source);
	$uri=~s/\/$//;
	my $result=&Apache::lonnet::ssi_body($uri,
	('grade_target'=>'web',
	'return_only_error_and_warning_counts' => 1));
	my ($errorcount,$warningcount)=split(':',$result);
	if (($errorcount) \|\| ($warningcount)) {
	$r->print('<h3>'.&mt('Warnings and Errors').'</h3>');
	$r->print('<tt>'.$uri.'</tt>:');
	$r->print('<ul>');
	if ($warningcount) {
	$r->print('<li><div class="LC_warning">'
	.&mt('[quant,_1,warning]',$warningcount)
	.'</div></li>');
	}
	if ($errorcount) {
	$r->print('<li><div class="LC_error">'
	.&mt('[quant,_1,error]',$errorcount)
	.' <img src="/adm/lonMisc/bomb.gif" />'
	.'</div></li>');
	}
	$r->print('</ul>');
	} else {
	#$r->print('<font color="green">'.&mt('ok').'</font>');
	}
	$r->rflush();
	return ($warningcount,$errorcount);
	}

# ============================================== Parse file itself for metadata	# ============================================== Parse file itself for metadata
#	#
# parses a file with target meta, sets global %metadatafields %metadatakeys	# parses a file with target meta, sets global %metadatafields %metadatakeys
Line 868 backup copies, performs any automatic pr	Line 948 backup copies, performs any automatic pr
especially for rat and ssi files),	especially for rat and ssi files),

Returns a 2 element array, the first is the string to be shown to the	Returns a 2 element array, the first is the string to be shown to the
user, the second is an error code, either 1 (an error occured) or 0	user, the second is an error code, either 1 (an error occurred) or 0
(no error occurred)	(no error occurred)

I<Additional documentation needed.>	I<Additional documentation needed.>
Line 887 sub publish {	Line 967 sub publish {
my %allow=();	my %allow=();

unless ($logfile=Apache::File->new('>>'.$source.'.log')) {	unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
return ('<font color="red">'.&mt('No write permission to user directory, FAIL').'</font>',1);	return ('<span class="LC_error">'.&mt('No write permission to user directory, FAIL').'</span>',1);
}	}
print $logfile	print $logfile
"\n\n================= Publish ".localtime()." Phase One ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n";	"\n\n================= Publish ".localtime()." Phase One ================\n".$env{'user.name'}.':'.$env{'user.domain'}."\n";

if (($style eq 'ssi') \|\| ($style eq 'rat') \|\| ($style eq 'prv')) {	if (($style eq 'ssi') \|\| ($style eq 'rat') \|\| ($style eq 'prv')) {
# ------------------------------------------------------- This needs processing	# ------------------------------------------------------- This needs processing
Line 901 sub publish {	Line 981 sub publish {
print $logfile "Copied original file to ".$copyfile."\n";	print $logfile "Copied original file to ".$copyfile."\n";
} else {	} else {
print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";	print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";
return ("<font color=\"red\">Failed to write backup copy, $!,FAIL</font>",1);	return ("<span class=\"LC_error\">".&mt("Failed to write backup copy, [_1], FAIL",$1)."</span>",1);
}	}
# ------------------------------------------------------------- IDs and indices	# ------------------------------------------------------------- IDs and indices

Line 911 sub publish {	Line 991 sub publish {
if ($error) { return ($outstring,$error); }	if ($error) { return ($outstring,$error); }
# ------------------------------------------------------------ Construct Allows	# ------------------------------------------------------------ Construct Allows

$scrout.='<h3>'.&mt('Dependencies').'</h3>';	my $outdep=''; # Collect dependencies output data
my $allowstr='';	my $allowstr='';
foreach (sort(keys(%allow))) {	foreach my $thisdep (sort(keys(%allow))) {
my $thisdep=$_;
if ($thisdep !~ /[^\s]/) { next; }	if ($thisdep !~ /[^\s]/) { next; }
	if ($thisdep =~/\$/) {
	$outdep.='<div class="LC_warning">'
	.&mt('The resource depends on another resource with variable filename, i.e., [_1].','<tt>'.$thisdep.'</tt>').'<br />'
	.&mt('You likely need to explicitly allow access to all possible dependencies using the [_1]-tag.','<tt><allow></tt>')
	."</div>\n";
	}
unless ($style eq 'rat') {	unless ($style eq 'rat') {
$allowstr.="\n".'<allow src="'.$thisdep.'" />';	$allowstr.="\n".'<allow src="'.$thisdep.'" />';
}	}
$scrout.='<br />';	$outdep.='<div>';
if ($thisdep!~/\*/ && $thisdep!~m\|^/adm/\|) {	if ($thisdep!~/[\*\$]/ && $thisdep!~m\|^/adm/\|) {
$scrout.='<a href="'.$thisdep.'">';	$outdep.='<a href="'.$thisdep.'">';
}	}
$scrout.='<tt>'.$thisdep.'</tt>';	$outdep.='<tt>'.$thisdep.'</tt>';
if ($thisdep!~/\*/ && $thisdep!~m\|^/adm/\|) {	if ($thisdep!~/[\*\$]/ && $thisdep!~m\|^/adm/\|) {
$scrout.='</a>';	$outdep.='</a>';
if (	if (
&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.	&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
$thisdep.'.meta') eq '-1') {	$thisdep.'.meta') eq '-1') {
$scrout.= ' - <font color="red">'.&mt('Currently not available').	$outdep.= ' - <span class="LC_error">'.&mt('Currently not available').
'</font>';	'</span>';
} else {	} else {
my %temphash=(&Apache::lonnet::declutter($target).'___'.	my %temphash=(&Apache::lonnet::declutter($target).'___'.
&Apache::lonnet::declutter($thisdep).'___usage'	&Apache::lonnet::declutter($thisdep).'___usage'
=> time);	=> time);
$thisdep=~/^\/res\/(\w+)\/(\w+)\//;	$thisdep=~m{^/res/($match_domain)/($match_username)/};
if ((defined($1)) && (defined($2))) {	if ((defined($1)) && (defined($2))) {
&Apache::lonnet::put('nohist_resevaldata',\%temphash,	&Apache::lonnet::put('nohist_resevaldata',\%temphash,
$1,$2);	$1,$2);
}	}
}	}
}	}
	$outdep.='</div><br />';
	}

	if ($outdep) {
	$scrout.='<h3>'.&mt('Dependencies').'</h3>'
	.$outdep
}	}
$outstring=~s/\n(\<\/[^\>]+\>)\s$/$allowstr\n$1\n/s;	$outstring=~s/\n(\<\/[^\>]+\>[^<])$/$allowstr\n$1\n/s;

### FIXME: is this really what we want?
# I dont' think so, to will corrupt any UTF-8 resources at least,
# and any encoding other than ISO-8859-1 will probably break
#Encode any High ASCII characters
#$outstring=&HTML::Entities::encode($outstring,"\200-\377");
# ------------------------------------------------------------- Write modified.	# ------------------------------------------------------------- Write modified.

{	{
my $org;	my $org;
unless ($org=Apache::File->new('>'.$source)) {	unless ($org=Apache::File->new('>'.$source)) {
print $logfile "No write permit to $source\n";	print $logfile "No write permit to $source\n";
return ('<font color="red">'.&mt('No write permission to').	return ('<span class="LC_error">'.&mt('No write permission to').
' '.$source.	' '.$source.
', '.&mt('FAIL').'</font>',1);	', '.&mt('FAIL').'</span>',1);
}	}
print($org $outstring);	print($org $outstring);
}	}
Line 976 sub publish {	Line 1062 sub publish {
my %oldparmstores=();	my %oldparmstores=();

unless ($batch) {	unless ($batch) {
$scrout.='<h3>'.&mt('Metadata Information').' ' .	$scrout.='<h3>'.&mt('Metadata').' ' .
Apache::loncommon::help_open_topic("Metadata_Description")	&Apache::loncommon::help_open_topic("Metadata_Description")
. '</h3>';	. '</h3>';
}	}

# ------------------------------------------------ First, check out environment	# ------------------------------------------------ First, check out environment
unless (-e $source.'.meta') {	if ((!(-e $source.'.meta')) \|\| ($env{'form.forceoverride'})) {
$metadatafields{'author'}=$ENV{'environment.firstname'}.' '.	$metadatafields{'author'}=$env{'environment.firstname'}.' '.
$ENV{'environment.middlename'}.' '.	$env{'environment.middlename'}.' '.
$ENV{'environment.lastname'}.' '.	$env{'environment.lastname'}.' '.
$ENV{'environment.generation'};	$env{'environment.generation'};
$metadatafields{'author'}=~s/\s+/ /g;	$metadatafields{'author'}=~s/\s+/ /g;
$metadatafields{'author'}=~s/\s+$//;	$metadatafields{'author'}=~s/\s+$//;
$metadatafields{'owner'}=$cuname.'@'.$cudom;	$metadatafields{'owner'}=$cuname.':'.$cudom;

# ------------------------------------------------ Check out directory hierachy	# ------------------------------------------------ Check out directory hierachy

Line 1007 sub publish {	Line 1093 sub publish {
$scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);	$scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);
$prefix=~s\|^\.\./\|\|;	$prefix=~s\|^\.\./\|\|;
}	}

# ----------------------------------------------------------- Parse file itself	# ----------------------------------------------------------- Parse file itself
# read %metadatafields from file itself	# read %metadatafields from file itself

Line 1031 sub publish {	Line 1118 sub publish {
delete $metadatafields{$_};	delete $metadatafields{$_};
}	}
}	}
	# ------------------------------------------------------------- Save some stuff
	my %savemeta=();
	foreach ('title') {
	$savemeta{$_}=$metadatafields{$_};
	}
# ------------------------------------------ See if anything new in file itself	# ------------------------------------------ See if anything new in file itself

$allmeta=&parseformeta($source,$style);	$allmeta=&parseformeta($source,$style);
	# ----------------------------------------------------------- Restore the stuff
	foreach (keys %savemeta) {
	$metadatafields{$_}=$savemeta{$_};
	}
}	}


Line 1045 sub publish {	Line 1140 sub publish {
if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {	if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {
unless ($_=~/\.\w+$/) {	unless ($_=~/\.\w+$/) {
unless ($oldparmstores{$_}) {	unless ($oldparmstores{$_}) {
print $logfile 'New: '.$_."\n";	my $disp_key = $_;
$chparms.=$_.' ';	$disp_key =~ tr/\0/_/;
	print $logfile ('New: '.$disp_key."\n");
	$chparms .= $disp_key.' ';
}	}
}	}
}	}
}	}
if ($chparms) {	if ($chparms) {
$scrout.='<p><b>'.&mt('New parameters or stored values').	$scrout.='<p><b>'.&mt('New parameters or saved values').
':</b> '.$chparms.'</p>';	':</b> '.$chparms.'</p>';
}	}

Line 1061 sub publish {	Line 1158 sub publish {
if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {	if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {
unless (($metadatafields{$_.'.name'}) \|\|	unless (($metadatafields{$_.'.name'}) \|\|
($metadatafields{$_.'.package'}) \|\| ($_=~/\.\w+$/)) {	($metadatafields{$_.'.package'}) \|\| ($_=~/\.\w+$/)) {
print $logfile 'Obsolete: '.$_."\n";	my $disp_key = $_;
$chparms.=$_.' ';	$disp_key =~ tr/\0/_/;
	print $logfile ('Obsolete: '.$disp_key."\n");
	$chparms.=$disp_key.' ';
}	}
}	}
}	}
if ($chparms) {	if ($chparms) {
$scrout.='<p><b>'.&mt('Obsolete parameters or stored values').':</b> '.	$scrout.='<p><b>'.&mt('Obsolete parameters or saved values').':</b> '
$chparms.'</p><h1><font color="red">'.&mt('Warning!').	.$chparms.'</p>'
'</font></h1><p><font color="red" size="+1">'.	.'<p class="LC_warning"><b>'.&mt('Warning!').'</b><br />'
&mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'</font></p><hr />';	.&mt('If this resource is in active use, student performance data from the previous version may become inaccessible.')
	.'</p><hr />';
	}
	if ($metadatafields{'copyright'} eq 'priv') {
	$scrout.='<p class="LC_warning"><b>'.&mt('Warning!').'</b><br />'
	.&mt('Copyright/distribution option "Private" is no longer supported. Select another option from below. Consider "Custom Rights" for maximum control over the usage of your resource.')
	.'</p><hr />';
}	}

# ------------------------------------------------------- Now have all metadata	# ------------------------------------------------------- Now have all metadata
Line 1082 sub publish {	Line 1187 sub publish {
$textonly=~s/\<script[^\<]+\<\/script\>//g;	$textonly=~s/\<script[^\<]+\<\/script\>//g;
$textonly=~s/\<m\>[^\<]+\<\/m\>//g;	$textonly=~s/\<m\>[^\<]+\<\/m\>//g;
$textonly=~s/\<[^\>]*\>//g;	$textonly=~s/\<[^\>]*\>//g;
$textonly=~tr/A-Z/a-z/;
$textonly=~s/[\$\&][a-z]\w*//g;
$textonly=~s/[^a-z\s]//g;

foreach ($textonly=~m/(\w+)/g) {
unless ($nokey{$_}) {
$keywords{$_}=1;
}
}
}

	#this is a work simplification for german authors for present
	$textonly=HTML::Entities::decode($textonly); #decode HTML-character
	$textonly=Encode::Encoder::encode('utf8', $textonly); #encode to perl internal unicode
	$textonly=~tr/A-ZÜÄÖ/a-züäö/; #add lowercase rule for german "Umlaute"
	$textonly=~s/[\$\&][a-z]\w*//g;
	$textonly=~s/[^a-z^ü^ä^ö^ß\s]//g; #dont delete german "Umlaute"

	foreach ($textonly=~m/[^\s]+/g) { #match all but whitespaces
	unless ($nokey{$_}) {
	$keywords{$_}=1;
	}
	}


	}

foreach (split(/\W+/,$metadatafields{'keywords'})) {	foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {
$keywords{$_}=1;	$addkey=~s/\s+/ /g;
	$addkey=~s/^\s//;
	$addkey=~s/\s$//;
	if ($addkey=~/\w/) {
	$keywords{$addkey}=1;
	}
}	}
# --------------------------------------------------- Now we also have keywords	# --------------------------------------------------- Now we also have keywords
# =============================================================================	# =============================================================================
# INTERACTIVE MODE	# interactive mode html goes into $intr_scrout
#	# batch mode throws away this HTML
unless ($batch) {	# additionally all of the field functions have a by product of setting
$scrout.=	# $env{'from.'..} so that it can be used by the phase two handler in
'<form name="pubform" action="/adm/publish" method="post">'.	# batch mode
'<p><input type="submit" value="'.&mt('Finalize Publication').'" /></p>'.
&hiddenfield('phase','two').	my $intr_scrout.='<br />'
&hiddenfield('filename',$ENV{'form.filename'}).	.'<form name="pubform" action="/adm/publish" method="post">';
&hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).	unless ($env{'form.makeobsolete'}) {
&hiddenfield('dependencies',join(',',keys %allow)).	$intr_scrout.='<p class="LC_warning">'
&textfield('Title','title',$metadatafields{'title'}).	.&mt('Searching for your resource will be based on the following metadata. Please provide as much data as possible.')
&textfield('Author(s)','author',$metadatafields{'author'}).	.'</p>'
&textfield('Subject','subject',$metadatafields{'subject'});	.'<p><input type="submit" value="'
	.&mt('Finalize Publication')
# --------------------------------------------------- Scan content for keywords	.'" /></p>';
	}
my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");	$intr_scrout.=&Apache::lonhtmlcommon::start_pick_box();
my $KEYWORDS=&mt('Keywords');	$intr_scrout.=
my $CheckAll=&mt('check all');	&hiddenfield('phase','two').
my $UncheckAll=&mt('uncheck all');	&hiddenfield('filename',$env{'form.filename'}).
my $keywordout=<<"END";	&hiddenfield('allmeta',&escape($allmeta)).
	&hiddenfield('dependencies',join(',',keys %allow));
	unless ($env{'form.makeobsolete'}) {
	$intr_scrout.=
	&textfield('Title','title',$metadatafields{'title'}).
	&textfield('Author(s)','author',$metadatafields{'author'}).
	&textfield('Subject','subject',$metadatafields{'subject'});
	# --------------------------------------------------- Scan content for keywords

	my $keywords_help = &Apache::loncommon::help_open_topic("Publishing_Keywords");
	my $keywordout=<<"END";
<script>	<script>
function checkAll(field) {	function checkAll(field) {
for (i = 0; i < field.length; i++)	for (i = 0; i < field.length; i++)
Line 1131 function uncheckAll(field) {	Line 1256 function uncheckAll(field) {
field[i].checked = false ;	field[i].checked = false ;
}	}
</script>	</script>
<p><font color="#800000" face="helvetica"><b>$KEYWORDS:</b></font>
$keywords_help</b>
<input type="button" value="$CheckAll" onclick="javascript:checkAll(document.pubform.keywords)" />
<input type="button" value="$UncheckAll" onclick="javascript:uncheckAll(document.pubform.keywords)" />
</p>
<br />
END	END
$keywordout.='<table border="2"><tr>';	$keywordout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Keywords'))
my $colcount=0;	.$keywords_help
	.'<input type="button" value="'.&mt('check all').'" onclick="javascript:checkAll(document.pubform.keywords)" />'
foreach (sort keys %keywords) {	.'<input type="button" value="'.&mt('uncheck all').'" onclick="javascript:uncheckAll(document.pubform.keywords)" />'
$keywordout.='<td><input type="checkbox" name="keywords" value="'.$_.'"';	.'</p><br />'
if ($metadatafields{'keywords'}) {	.&Apache::loncommon::start_data_table();
if ($metadatafields{'keywords'}=~/\Q$_\E/) {	my $cols_per_row = 10;
$keywordout.=' checked="on"';	my $colcount=0;
}	my $wordcount=0;
} elsif (&Apache::loncommon::keyword($_)) {	my $numkeywords = scalar(keys(%keywords));
$keywordout.=' checked="on"';
}	foreach my $word (sort(keys(%keywords))) {
$keywordout.=' />'.$_.'</td>';	if ($colcount == 0) {
if ($colcount>10) {	$keywordout .= &Apache::loncommon::start_data_table_row();
$keywordout.="</tr><tr>\n";	}
$colcount=0;	$colcount++;
}	$wordcount++;
$colcount++;	if (($wordcount == $numkeywords) && ($colcount < $cols_per_row)) {
}	my $colspan = 1+$cols_per_row-$colcount;
	$keywordout .= '<td colspan="'.$colspan.'">';
$keywordout.='</tr></table>';	} else {
	$keywordout .= '<td>';
$scrout.=$keywordout;	}
	$keywordout.='<label><input type="checkbox" name="keywords" value="'.$word.'"';
$scrout.=&textfield('Additional Keywords','addkey','');	if ($metadatafields{'keywords'}) {
	if ($metadatafields{'keywords'}=~/\Q$word\E/) {
	$keywordout.=' checked="checked"';
	$env{'form.keywords'}.=$word.',';
	}
	} elsif (&Apache::loncommon::keyword($word)) {
	$keywordout.=' checked="checked"';
	$env{'form.keywords'}.=$word.',';
	}
	$keywordout.=' />'.$word.'</label></td>';
	if ($colcount == $cols_per_row) {
	$keywordout.=&Apache::loncommon::end_data_table_row();
	$colcount=0;
	}
	}
	if ($colcount > 0) {
	$keywordout .= &Apache::loncommon::end_data_table_row();
	}

$scrout.=&textfield('Notes','notes',$metadatafields{'notes'});	$env{'form.keywords'}=~s/\,$//;

$scrout.=	$keywordout.=&Apache::loncommon::end_data_table_row()
"\n<p><font color=\"#800000\" face=\"helvetica\"><b>".&mt('Abstract').":".	.&Apache::loncommon::end_data_table()
"</b></font></p><br />".	.&Apache::lonhtmlcommon::row_closure();
'<textarea cols="80" rows="5" name="abstract">'.
$metadatafields{'abstract'}.'</textarea></p>';

$source=~/\.(\w+)$/;	$intr_scrout.=$keywordout;

	$intr_scrout.=&textfield('Additional Keywords','addkey','');

$scrout.=	$intr_scrout.=&textfield('Notes','notes',$metadatafields{'notes'});
"\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
&mt('Lowest Grade Level').':'.
"</b></font></p><br />".
&Apache::loncommon::select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel').
"\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
&mt('Highest Grade Level').':'.
"</b></font></p><br />".
&Apache::loncommon::select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel').
&textfield('Standards','standards',$metadatafields{'standards'});

	$intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Abstract'))
	.'<textarea cols="80" rows="5" name="abstract">'
	.$metadatafields{'abstract'}
	.'</textarea>'
	.&Apache::lonhtmlcommon::row_closure();

	$source=~/\.(\w+)$/;

	$intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Grade Levels'))
	.&mt('Lowest Grade Level:').' '
	.&select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel')
	# .&Apache::lonhtmlcommon::row_closure();
	# $intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Highest Grade Level'))
	.' '.&mt('Highest Grade Level:').' '
	.&select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel')
	.&Apache::lonhtmlcommon::row_closure();

$scrout.=&hiddenfield('mime',$1);	$intr_scrout.=&textfield('Standards','standards',$metadatafields{'standards'});

my $defaultlanguage=$metadatafields{'language'};	$intr_scrout.=&hiddenfield('mime',$1);
$defaultlanguage =~ s/\snotset\s//g;
$defaultlanguage =~ s/^,\s*//g;
$defaultlanguage =~ s/,\s*$//g;

$scrout.=&selectbox('Language','language',	my $defaultlanguage=$metadatafields{'language'};
$defaultlanguage,	$defaultlanguage =~ s/\snotset\s//g;
\&Apache::loncommon::languagedescription,	$defaultlanguage =~ s/^,\s*//g;
(&Apache::loncommon::languageids),	$defaultlanguage =~ s/,\s*$//g;
);

unless ($metadatafields{'creationdate'}) {	$intr_scrout.=&selectbox('Language','language',
$metadatafields{'creationdate'}=time;	$defaultlanguage,
}	\&Apache::loncommon::languagedescription,
$scrout.=&hiddenfield('creationdate',	(&Apache::loncommon::languageids),
&Apache::lonmysql::unsqltime($metadatafields{'creationdate'}));	);

$scrout.=&hiddenfield('lastrevisiondate',time);	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',	my $pubowner_last;
$metadatafields{'owner'});	if ($style eq 'prv') {
	$pubowner_last = 1;
	}
	$intr_scrout.=&textfield('Publisher/Owner','owner',
	$metadatafields{'owner'},$pubowner_last);

	# ---------------------------------------------- Retrofix for unused copyright
	if ($metadatafields{'copyright'} eq 'free') {
	$metadatafields{'copyright'}='default';
	$metadatafields{'sourceavail'}='open';
	}
	if ($metadatafields{'copyright'} eq 'priv') {
	$metadatafields{'copyright'}='domain';
	}
	# ------------------------------------------------ Dial in reasonable defaults
	my $defaultoption=$metadatafields{'copyright'};
	unless ($defaultoption) { $defaultoption='default'; }
	my $defaultsourceoption=$metadatafields{'sourceavail'};
	unless ($defaultsourceoption) { $defaultsourceoption='closed'; }
	unless ($style eq 'prv') {
# -------------------------------------------------- Correct copyright for rat.	# -------------------------------------------------- Correct copyright for rat.
my $defaultoption=$metadatafields{'copyright'};	if ($style eq 'rat') {
unless ($defaultoption) { $defaultoption='default'; }	# -------------------------------------- Retrofix for non-applicable copyright
unless ($style eq 'prv') {	if ($metadatafields{'copyright'} eq 'public') {
if ($style eq 'rat') {	delete $metadatafields{'copyright'};
if ($metadatafields{'copyright'} eq 'public') {	$defaultoption='default';
delete $metadatafields{'copyright'};	}
$defaultoption='default';	$intr_scrout.=&selectbox('Copyright/Distribution','copyright',
}	$defaultoption,
$scrout.=&selectbox('Copyright/Distribution','copyright',	\&Apache::loncommon::copyrightdescription,
$defaultoption,	(grep !/^(public\|priv)$/,(&Apache::loncommon::copyrightids)));
\&Apache::loncommon::copyrightdescription,
(grep !/^public$/,(&Apache::loncommon::copyrightids)));
} else {
$scrout.=&selectbox('Copyright/Distribution','copyright',
$defaultoption,
\&Apache::loncommon::copyrightdescription,
(&Apache::loncommon::copyrightids));
}

my $copyright_help =
Apache::loncommon::help_open_topic('Publishing_Copyright');
$scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;
$scrout.=&textfield('Custom Distribution File','customdistributionfile',
$metadatafields{'customdistributionfile'}).
$copyright_help;
my $uctitle=&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);	(grep !/^priv$/,(&Apache::loncommon::copyrightids)));
# =============================================================================	}
# BATCH MODE	my $copyright_help =
#	&Apache::loncommon::help_open_topic('Publishing_Copyright');
	my $replace=&mt('Copyright/Distribution:');
	$intr_scrout =~ s/$replace/$replace.' '.$copyright_help/ge;

	$intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights');
	$intr_scrout.=&selectbox('Source Distribution','sourceavail',
	$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');
	my $obsolete_checked=($metadatafields{'obsolete'})?' checked="checked"':'';
	$intr_scrout.="\n".&Apache::lonhtmlcommon::row_title($uctitle)
	.'<input type="checkbox" name="obsolete"'.$obsolete_checked.' />'
	.&Apache::lonhtmlcommon::row_closure(1);
	$intr_scrout.=&text_with_browse_field('Suggested Replacement for Obsolete File',
	'obsoletereplacement',
	$metadatafields{'obsoletereplacement'},'',1);
} else {	} else {
# Transfer metadata directly to environment for stage 2	$intr_scrout.=&hiddenfield('copyright','private');
foreach (keys %metadatafields) {	}
$ENV{'form.'.$_}=$metadatafields{$_};	} else {
}	$intr_scrout.=
$ENV{'form.addkey'}='';	&hiddenfield('title',$metadatafields{'title'}).
$ENV{'form.keywords'}='';	&hiddenfield('author',$metadatafields{'author'}).
foreach (keys %keywords) {	&hiddenfield('subject',$metadatafields{'subject'}).
if ($metadatafields{'keywords'}) {	&hiddenfield('keywords',$metadatafields{'keywords'}).
if ($metadatafields{'keywords'}=~/\Q$_\E/) {	&hiddenfield('abstract',$metadatafields{'abstract'}).
$ENV{'form.keywords'}.=$_.',';	&hiddenfield('notes',$metadatafields{'notes'}).
}	&hiddenfield('mime',$metadatafields{'mime'}).
} elsif (&Apache::loncommon::keyword($_)) {	&hiddenfield('creationdate',$metadatafields{'creationdate'}).
$ENV{'form.keywords'}.=$_.',';	&hiddenfield('lastrevisiondate',time).
}	&hiddenfield('owner',$metadatafields{'owner'}).
}	&hiddenfield('lowestgradelevel',$metadatafields{'lowestgradelevel'}).
$ENV{'form.keywords'}=~s/\,$//;	&hiddenfield('standards',$metadatafields{'standards'}).
unless ($ENV{'form.creationdate'}) { $ENV{'form.creationdate'}=time; }	&hiddenfield('highestgradelevel',$metadatafields{'highestgradelevel'}).
$ENV{'form.lastrevisiondate'}=time;	&hiddenfield('language',$metadatafields{'language'}).
if ((($style eq 'rat') && ($ENV{'form.copyright'} eq 'public')) \|\|	&hiddenfield('copyright',$metadatafields{'copyright'}).
(!$ENV{'form.copyright'})) {	&hiddenfield('sourceavail',$metadatafields{'sourceavail'}).
$ENV{'form.copyright'}='default';	&hiddenfield('customdistributionfile',$metadatafields{'customdistributionfile'}).
}	&hiddenfield('obsolete',1).
$ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta);	&text_with_browse_field('Suggested Replacement for Obsolete File',
return ($scrout,0);	'obsoletereplacement',
	$metadatafields{'obsoletereplacement'},'',1);
	}
	if (!$batch) {
	$scrout.=$intr_scrout
	.&Apache::lonhtmlcommon::end_pick_box()
	.'<p><input type="submit" value="'
	.&mt($env{'form.makeobsolete'}?'Make Obsolete':'Finalize Publication')
	.'" /></p>'
	.'</form>';
}	}
	return($scrout,0);
}	}

#########################################	#########################################
Line 1315 Returns:	Line 1475 Returns:

=over 4	=over 4

=item Scalar string	=item integer

String contains status (errors and warnings) and information associated with	0: fail
the server's attempts at publication.	1: success

=cut	=cut

Line 1330 sub phasetwo {	Line 1490 sub phasetwo {
my ($r,$source,$target,$style,$distarget,$batch)=@_;	my ($r,$source,$target,$style,$distarget,$batch)=@_;
$source=~s/\/+/\//g;	$source=~s/\/+/\//g;
$target=~s/\/+/\//g;	$target=~s/\/+/\//g;
	#
if ($target=~/\_\_\_/) {	# Unless trying to get rid of something, check name validity
$r->print(	#
'<font color="red">'.&mt('Unsupported character combination').	unless ($env{'form.obsolete'}) {
' "<tt>___</tt>" '.&mt('in filename, FAIL').'</font>');	if ($target=~/(\_\_\_\|\&\&\&\|\:\:\:)/) {
return 0;	$r->print('<span class="LC_error">'.
	&mt('Unsupported character combination [_1] in filename, FAIL.',"<tt>'.$1.'</tt>").
	'</span>');
	return 0;
	}
	unless ($target=~/\.(\w+)$/) {
	$r->print('<span class="LC_error">'.&mt('No valid extension found in filename, FAIL').'</span>');
	return 0;
	}
	if ($target=~/\.(\d+)\.(\w+)$/) {
	$r->print('<span class="LC_error">'.&mt('Filename of resource contains internal version number. Cannot publish such resources, FAIL').'</span>');
	return 0;
	}
}	}

	#
	# End name check
	#
$distarget=~s/\/+/\//g;	$distarget=~s/\/+/\//g;
my $logfile;	my $logfile;
unless ($logfile=Apache::File->new('>>'.$source.'.log')) {	unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
$r->print(	$r->print(
'<font color="red">'.	'<span class="LC_error">'.
&mt('No write permission to user directory, FAIL').'</font>');	&mt('No write permission to user directory, FAIL').'</span>');
return 0;	return 0;
}	}

	if ($source =~ /\.rights$/) {
	$r->print('<p><span class="LC_warning">'.&mt('Warning: It can take up to 1 hour for rights changes to fully propagate.').'</span></p>');
	}

print $logfile	print $logfile
"\n================= Publish ".localtime()." Phase Two ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n";	"\n================= Publish ".localtime()." Phase Two ================\n".$env{'user.name'}.':'.$env{'user.domain'}."\n";

%metadatafields=();	%metadatafields=();
%metadatakeys=();	%metadatakeys=();

	&metaeval(&unescape($env{'form.allmeta'}));

&metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));	$metadatafields{'title'}=$env{'form.title'};
	$metadatafields{'author'}=$env{'form.author'};
$metadatafields{'title'}=$ENV{'form.title'};	$metadatafields{'subject'}=$env{'form.subject'};
$metadatafields{'author'}=$ENV{'form.author'};	$metadatafields{'notes'}=$env{'form.notes'};
$metadatafields{'subject'}=$ENV{'form.subject'};	$metadatafields{'abstract'}=$env{'form.abstract'};
$metadatafields{'notes'}=$ENV{'form.notes'};	$metadatafields{'mime'}=$env{'form.mime'};
$metadatafields{'abstract'}=$ENV{'form.abstract'};	$metadatafields{'language'}=$env{'form.language'};
$metadatafields{'mime'}=$ENV{'form.mime'};	$metadatafields{'creationdate'}=$env{'form.creationdate'};
$metadatafields{'language'}=$ENV{'form.language'};	$metadatafields{'lastrevisiondate'}=$env{'form.lastrevisiondate'};
$metadatafields{'creationdate'}=$ENV{'form.creationdate'};	$metadatafields{'owner'}=$env{'form.owner'};
$metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};	$metadatafields{'copyright'}=$env{'form.copyright'};
$metadatafields{'owner'}=$ENV{'form.owner'};	$metadatafields{'standards'}=$env{'form.standards'};
$metadatafields{'copyright'}=$ENV{'form.copyright'};	$metadatafields{'lowestgradelevel'}=$env{'form.lowestgradelevel'};
$metadatafields{'standards'}=$ENV{'form.standards'};	$metadatafields{'highestgradelevel'}=$env{'form.highestgradelevel'};
$metadatafields{'lowestgradelevel'}=$ENV{'form.lowestgradelevel'};
$metadatafields{'highestgradelevel'}=$ENV{'form.highestgradelevel'};
$metadatafields{'customdistributionfile'}=	$metadatafields{'customdistributionfile'}=
$ENV{'form.customdistributionfile'};	$env{'form.customdistributionfile'};
$metadatafields{'obsolete'}=$ENV{'form.obsolete'};	$metadatafields{'sourceavail'}=$env{'form.sourceavail'};
	$metadatafields{'obsolete'}=$env{'form.obsolete'};
$metadatafields{'obsoletereplacement'}=	$metadatafields{'obsoletereplacement'}=
$ENV{'form.obsoletereplacement'};	$env{'form.obsoletereplacement'};
$metadatafields{'dependencies'}=$ENV{'form.dependencies'};	$metadatafields{'dependencies'}=$env{'form.dependencies'};
$metadatafields{'modifyinguser'}=$ENV{'user.name'}.'@'.	$metadatafields{'modifyinguser'}=$env{'user.name'}.':'.
$ENV{'user.domain'};	$env{'user.domain'};
$metadatafields{'authorspace'}=$cuname.'@'.$cudom;	$metadatafields{'authorspace'}=$cuname.':'.$cudom;
	$metadatafields{'domain'}=$cudom;

my $allkeywords=$ENV{'form.addkey'};	my $allkeywords=$env{'form.addkey'};
if (exists($ENV{'form.keywords'})) {	if (exists($env{'form.keywords'})) {
if (ref($ENV{'form.keywords'})) {	if (ref($env{'form.keywords'})) {
$allkeywords .= ','.join(',',@{$ENV{'form.keywords'}});	$allkeywords .= ','.join(',',@{$env{'form.keywords'}});
} else {	} else {
$allkeywords .= ','.$ENV{'form.keywords'};	$allkeywords .= ','.$env{'form.keywords'};
}	}
}	}
$allkeywords=~s/\W+/\,/;	$allkeywords=~s/[\"\']//g;
$allkeywords=~s/^\,//;	$allkeywords=~s/\s[\;\,]\s/\,/g;
	$allkeywords=~s/\s+/ /g;
	$allkeywords=~s/^[ \,]//;
	$allkeywords=~s/[ \,]$//;
$metadatafields{'keywords'}=$allkeywords;	$metadatafields{'keywords'}=$allkeywords;

# check if custom distribution file is specified	# check if custom distribution file is specified
if ($metadatafields{'copyright'} eq 'custom') {	if ($metadatafields{'copyright'} eq 'custom') {
my $file=$metadatafields{'customdistributionfile'};	my $file=$metadatafields{'customdistributionfile'};
unless ($file=~/\.rights$/) {	unless ($file=~/\.rights$/) {
return	$r->print(
'<font color="red">'.&mt('No valid custom distribution rights file specified, FAIL').	'<span class="LC_error">'.&mt('No valid custom distribution rights file specified, FAIL').
'</font>';	'</span>');
	return 0;
}	}
}	}
{	{
print $logfile "\nWrite metadata file for ".$source;	print $logfile "\nWrite metadata file for ".$source;
my $mfh;	my $mfh;
unless ($mfh=Apache::File->new('>'.$source.'.meta')) {	unless ($mfh=Apache::File->new('>'.$source.'.meta')) {
return	$r->print(
'<font color="red">'.&mt('Could not write metadata, FAIL').	'<span class="LC_error">'.&mt('Could not write metadata, FAIL').
'</font>';	'</span>');
	return 0;
}	}
foreach (sort keys %metadatafields) {	foreach (sort keys %metadatafields) {
unless ($_=~/\./) {	unless ($_=~/\./) {
Line 1419 sub phasetwo {	Line 1607 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 1453 sub phasetwo {	Line 1641 sub phasetwo {
my $srcf=$2;	my $srcf=$2;
my $srct=$3;	my $srct=$3;
my $srcd=$1;	my $srcd=$1;
unless ($srcd=~/^\/home\/httpd\/html\/res/) {	my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'};
	unless ($srcd=~/^\Q$docroot\E\/res/) {
print $logfile "\nPANIC: Target dir is ".$srcd;	print $logfile "\nPANIC: Target dir is ".$srcd;
return "<font color=\"red\">Invalid target directory, FAIL</font>";	$r->print(
	"<span class=\"LC_error\">".&mt('Invalid target directory, FAIL')."</span>");
	return 0;
}	}
opendir(DIR,$srcd);	opendir(DIR,$srcd);
while ($filename=readdir(DIR)) {	while ($filename=readdir(DIR)) {
Line 1463 sub phasetwo {	Line 1654 sub phasetwo {
unlink($srcd.'/'.$filename);	unlink($srcd.'/'.$filename);
unlink($srcd.'/'.$filename.'.meta');	unlink($srcd.'/'.$filename.'.meta');
} else {	} else {
if ($filename=~/\Q$srcf\E\.(\d+)\.\Q$srct\E$/) {	if ($filename=~/^\Q$srcf\E\.(\d+)\.\Q$srct\E$/) {
$maxversion=($1>$maxversion)?$1:$maxversion;	$maxversion=($1>$maxversion)?$1:$maxversion;
}	}
}	}
}	}
closedir(DIR);	closedir(DIR);
$maxversion++;	$maxversion++;
$r->print('<p>Creating old version '.$maxversion.'</p>');	$r->print('<p>'.&mt('Creating old version [_1]',$maxversion).'</p>');
print $logfile "\nCreating old version ".$maxversion."\n";	print $logfile "\nCreating old version ".$maxversion."\n";

my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;	my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;
Line 1480 sub phasetwo {	Line 1671 sub phasetwo {
$r->print('<p>'.&mt('Copied old target file').'</p>');	$r->print('<p>'.&mt('Copied old target file').'</p>');
} else {	} else {
print $logfile "Unable to write ".$copyfile.':'.$!."\n";	print $logfile "Unable to write ".$copyfile.':'.$!."\n";
return "<font color=\"red\">".&mt('Failed to copy old target').	$r->print("<span class=\"LC_error\">".&mt('Failed to copy old target').
", $!, ".&mt('FAIL')."</font>";	", $!, ".&mt('FAIL')."</span>");
	return 0;
}	}

# --------------------------------------------------------------- Copy Metadata	# --------------------------------------------------------------- Copy Metadata
Line 1494 sub phasetwo {	Line 1686 sub phasetwo {
} else {	} else {
print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";	print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
if (-e $target.'.meta') {	if (-e $target.'.meta') {
return	$r->print(
"<font color=\"red\">".	"<span class=\"LC_error\">".
&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')."</font>";	&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')."</span>");
	return 0;
}	}
}	}

Line 1517 sub phasetwo {	Line 1710 sub phasetwo {
$path.="/$parts[$count]";	$path.="/$parts[$count]";
if ((-e $path)!=1) {	if ((-e $path)!=1) {
print $logfile "\nCreating directory ".$path;	print $logfile "\nCreating directory ".$path;
$r->print('<p>'.&mt('Created directory').' '.$parts[$count].'</p>');
mkdir($path,0777);	mkdir($path,0777);
	$r->print('<p>'
	.&mt('Created directory [_1]'
	,'<span class="LC_filename">'.$parts[$count].'</span>')
	.'</p>'
	);
}	}
}	}

Line 1527 sub phasetwo {	Line 1724 sub phasetwo {
$r->print('<p>'.&mt('Copied source file').'</p>');	$r->print('<p>'.&mt('Copied source file').'</p>');
} else {	} else {
print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";	print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
return "<font color=\"red\">".	$r->print("<span class=\"LC_error\">".
&mt('Failed to copy source').", $!, ".&mt('FAIL')."</font>";	&mt('Failed to copy source').", $!, ".&mt('FAIL')."</span>");
	return 0;
}	}

# --------------------------------------------------------------- Copy Metadata	# --------------------------------------------------------------- Copy Metadata
Line 1540 sub phasetwo {	Line 1738 sub phasetwo {
$r->print('<p>'.&mt('Copied metadata').'</p>');	$r->print('<p>'.&mt('Copied metadata').'</p>');
} else {	} else {
print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";	print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
return	$r->print(
"<font color=\"red\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</font>";	"<span class=\"LC_error\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</span>");
	return 0;
}	}
$r->rflush;	$r->rflush;
# --------------------------------------------------- Send update notifications

my @subscribed=&get_subscribed_hosts($target);	# ------------------------------------------------------------- Trigger updates
foreach my $subhost (@subscribed) {	push(@{$modified_urls},[$target,$source]);
$r->print('<p>'.&mt('Notifying host').' '.$subhost.':');$r->rflush;	unless ($registered_cleanup) {
print $logfile "\nNotifying host ".$subhost.':';	$r->register_cleanup(\&notify);
my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);	$registered_cleanup=1;
$r->print($reply.'</p><br />');$r->rflush;
print $logfile $reply;
}	}

# ---------------------------------------- Send update notifications, meta only

my @subscribedmeta=&get_subscribed_hosts("$target.meta");	# ---------------------------------------------------------- Clear local caches
foreach my $subhost (@subscribedmeta) {	my $thisdistarget=$target;
$r->print('<p>'.	$thisdistarget=~s/^\Q$docroot\E//;
&mt('Notifying host for metadata only').' '.$subhost.':');$r->rflush;	&Apache::lonnet::devalidate_cache_new('resversion',$target);
print $logfile "\nNotifying host for metadata only ".$subhost.':';	&Apache::lonnet::devalidate_cache_new('meta',
my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',	&Apache::lonnet::declutter($thisdistarget));
$subhost);
$r->print($reply.'</p><br />');$r->rflush;	# ------------------------------------------------------------- Everything done
print $logfile $reply;	$logfile->close();
}	$r->print('<p class="LC_success">'.&mt('Done').'</p>');

# --------------------------------------------------- Notify subscribed courses
my %courses=&coursedependencies($target);
my $now=time;
foreach (keys %courses) {
$r->print('<p>'.&mt('Notifying course').' '.$_.':');$r->rflush;
print $logfile "\nNotifying host ".$_.':';
my ($cdom,$cname)=split(/\_/,$_);
my $reply=&Apache::lonnet::cput
('versionupdate',{$target => $now},$cdom,$cname);
$r->print($reply.'</p><br />');$r->rflush;
print $logfile $reply;
}
# ------------------------------------------------ Provide link to new resource	# ------------------------------------------------ Provide link to new resource
unless ($batch) {	unless ($batch) {
my $thisdistarget=$target;
$thisdistarget=~s/^\Q$docroot\E//;

my $thissrc=$source;	my $thissrc=$source;
$thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/;	$thissrc=~s{^/home/($match_username)/public_html}{/priv/$1};

my $thissrcdir=$thissrc;	my $thissrcdir=$thissrc;
$thissrcdir=~s/\/[^\/]+$/\//;	$thissrcdir=~s/\/[^\/]+$/\//;
Line 1595 sub phasetwo {	Line 1774 sub phasetwo {
$r->print(	$r->print(
'<hr /><a href="'.$thisdistarget.'"><font size="+2">'.	'<hr /><a href="'.$thisdistarget.'"><font size="+2">'.
&mt('View Published Version').'</font></a>'.	&mt('View Published Version').'</font></a>'.
'<p><a href="'.$thissrc.'"><font size=+2>'.	'<p><a href="'.$thissrc.'"><font size="+2">'.
&mt('Back to Source').'</font></a></p>'.	&mt('Back to Source').'</font></a></p>'.
'<p><a href="'.$thissrcdir.	'<p><a href="'.$thissrcdir.
'"><font size="+2">'.	'"><font size="+2">'.
&mt('Back to Source Directory').'</font></a></p>');	&mt('Back to Source Directory').'</font></a></p>');
}	}
return '<p><font color="green">'.&mt('Done').'</font></p>';	return 1;
	}

	# =============================================================== Notifications
	sub notify {
	# --------------------------------------------------- Send update notifications
	foreach my $targetsource (@{$modified_urls}){
	my ($target,$source)=@{$targetsource};
	my $logfile=Apache::File->new('>>'.$source.'.log');
	print $logfile "\nCleanup phase: Notifications\n";
	my @subscribed=&get_subscribed_hosts($target);
	foreach my $subhost (@subscribed) {
	print $logfile "\nNotifying host ".$subhost.':';
	my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
	print $logfile $reply;
	}
	# ---------------------------------------- Send update notifications, meta only
	my @subscribedmeta=&get_subscribed_hosts("$target.meta");
	foreach my $subhost (@subscribedmeta) {
	print $logfile "\nNotifying host for metadata only ".$subhost.':';
	my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
	$subhost);
	print $logfile $reply;
	}
	# --------------------------------------------------- Notify subscribed courses
	my %courses=&coursedependencies($target);
	my $now=time;
	foreach (keys %courses) {
	print $logfile "\nNotifying course ".$_.':';
	my ($cdom,$cname)=split(/\_/,$_);
	my $reply=&Apache::lonnet::cput
	('versionupdate',{$target => $now},$cdom,$cname);
	print $logfile $reply;
	}
	print $logfile "\n============ Done ============\n";
	$logfile->close();
	}
	if ($lock) { &Apache::lonnet::remove_lock($lock); }
	return OK;
}	}

#########################################	#########################################

sub batchpublish {	sub batchpublish {
my ($r,$srcfile,$targetfile)=@_;	my ($r,$srcfile,$targetfile)=@_;
#publication pollutes %ENV with form.* values	#publication pollutes %env with form.* values
my %oldENV=%ENV;	my %oldenv=%env;
$srcfile=~s/\/+/\//g;	$srcfile=~s/\/+/\//g;
$targetfile=~s/\/+/\//g;	$targetfile=~s/\/+/\//g;
my $thisdisfn=$srcfile;	my $thisdisfn=$srcfile;
Line 1629 sub batchpublish {	Line 1846 sub batchpublish {

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 [_1]'
	,'<span class="LC_filename">'.$thisdisfn.'</span>')
	.'</h2>'
	);

# phase one takes	# phase one takes
# my ($source,$target,$style,$batch)=@_;	# my ($source,$target,$style,$batch)=@_;
Line 1637 sub batchpublish {	Line 1858 sub batchpublish {
$r->print('<p>'.$outstring.'</p>');	$r->print('<p>'.$outstring.'</p>');
# phase two takes	# phase two takes
# my ($source,$target,$style,$distarget,batch)=@_;	# my ($source,$target,$style,$distarget,batch)=@_;
# $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},...	# $env{'form.allmeta'},$env{'form.title'},$env{'form.author'},...
if (!$error) {	if (!$error) {
$r->print('<p>');	$r->print('<p>');
&phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);	&phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
$r->print('</p>');	$r->print('</p>');
}	}
%ENV=%oldENV;	%env=%oldenv;
return '';	return '';
}	}

Line 1656 sub publishdirectory {	Line 1877 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>'.&mt('Directory').' <tt>'.$thisdisfn.'</tt></h1>'.	$r->print(&Apache::lonhtmlcommon::start_pick_box()
&mt('Target').': <tt>'.$resdir.'</tt><br />');	.&Apache::lonhtmlcommon::row_title(&mt('Directory'))
	.'<span class="LC_filename">'.$thisdisfn.'</span>'
	.&Apache::lonhtmlcommon::row_closure()
	.&Apache::lonhtmlcommon::row_title(&mt('Target'))
	.'<span class="LC_filename">'.$resdir.'</span>'
	);

my $dirptr=16384; # Mask indicating a directory in stat.cmode.	my $dirptr=16384; # Mask indicating a directory in stat.cmode.
	unless ($env{'form.phase'} eq 'two') {
opendir(DIR,$fn);	# ask user what they want
my @files=sort(readdir(DIR));	$r->print(&Apache::lonhtmlcommon::row_closure()
foreach my $filename (@files) {	.&Apache::lonhtmlcommon::row_title(&mt('Options'))
my ($cdev,$cino,$cmode,$cnlink,	);
$cuid,$cgid,$crdev,$csize,	$r->print('<form name="pubdirpref" method="post">'.
$catime,$cmtime,$cctime,	&hiddenfield('phase','two').
$cblksize,$cblocks)=stat($fn.'/'.$filename);	&hiddenfield('filename',$env{'form.filename'}).
	&checkbox('pubrec','include subdirectories').
my $extension='';	&checkbox('forcerepub','force republication of previously published files').
if ($filename=~/\.(\w+)$/) { $extension=$1; }	&checkbox('obsolete','make file(s) obsolete').
if ($cmode&$dirptr) {	&checkbox('forceoverride','force directory level metadata over existing').
if (($filename!~/^\./) && ($ENV{'form.pubrec'})) {	'<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');
&publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);	$r->print(&Apache::lonhtmlcommon::row_closure(1)
}	.&Apache::lonhtmlcommon::end_pick_box()
} elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&	);
($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {	$lock=0;
	} else {
	$r->print(&Apache::lonhtmlcommon::row_closure(1)
	.&Apache::lonhtmlcommon::end_pick_box()
	);
	unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); }
	# actually publish things
	opendir(DIR,$fn);
	my @files=sort(readdir(DIR));
	foreach my $filename (@files) {
	my ($cdev,$cino,$cmode,$cnlink,
	$cuid,$cgid,$crdev,$csize,
	$catime,$cmtime,$cctime,
	$cblksize,$cblocks)=stat($fn.'/'.$filename);

	my $extension='';
	if ($filename=~/\.(\w+)$/) { $extension=$1; }
	if ($cmode&$dirptr) {
	if (($filename!~/^\./) && ($env{'form.pubrec'})) {
	&publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);
	}
	} elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
	($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
# find out publication status and/or exiting metadata	# find out publication status and/or exiting metadata
my $publishthis=0;	my $publishthis=0;
if (-e $resdir.'/'.$filename) {	if (-e $resdir.'/'.$filename) {
my ($rdev,$rino,$rmode,$rnlink,	my ($rdev,$rino,$rmode,$rnlink,
$ruid,$rgid,$rrdev,$rsize,	$ruid,$rgid,$rrdev,$rsize,
$ratime,$rmtime,$rctime,	$ratime,$rmtime,$rctime,
$rblksize,$rblocks)=stat($resdir.'/'.$filename);	$rblksize,$rblocks)=stat($resdir.'/'.$filename);
if (($rmtime<$cmtime) \|\| ($ENV{'form.forcerepub'})) {	if (($rmtime<$cmtime) \|\| ($env{'form.forcerepub'})) {
# previously published, modified now	# previously published, modified now
$publishthis=1;	$publishthis=1;
}	}
} else {	my $meta_cmtime = (stat($fn.'/'.$filename.'.meta'))[9];
	my $meta_rmtime = (stat($resdir.'/'.$filename.'.meta'))[9];
	if ( $meta_rmtime<$meta_cmtime ) {
	$publishthis=1;
	}
	} else {
# never published	# never published
$publishthis=1;	$publishthis=1;
}	}
if ($publishthis) {
&batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);	if ($publishthis) {
} else {	&batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);
$r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');	} else {
	$r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');
	}
	$r->rflush();
}	}
$r->rflush();
}	}
	closedir(DIR);
}	}
closedir(DIR);
}	}

#########################################	#########################################
Line 1719 sub defaultmetapublish {	Line 1974 sub defaultmetapublish {
&Apache::loncommon::content_type($r,'text/html');	&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;	$r->send_http_header;

$r->print('<html><head><title>LON-CAPA Publishing</title></head>');	$r->print(&Apache::loncommon::start_page('Metadata Publication'));
$r->print(&Apache::loncommon::bodytag('Catalog Information Publication'));

# ---------------------------------------------------------------- Write Source	# ---------------------------------------------------------------- Write Source
my $copyfile=$target;	my $copyfile=$target;
Line 1732 sub defaultmetapublish {	Line 1986 sub defaultmetapublish {
for ($count=5;$count<$#parts;$count++) {	for ($count=5;$count<$#parts;$count++) {
$path.="/$parts[$count]";	$path.="/$parts[$count]";
if ((-e $path)!=1) {	if ((-e $path)!=1) {
$r->print('<p>'.&mt('Created directory').' '.$parts[$count].'</p>');
mkdir($path,0777);	mkdir($path,0777);
	$r->print('<p>'
	.&mt('Created directory [_1]'
	,'<span class="LC_filename">'.$parts[$count].'</span>')
	.'</p>'
	);
}	}
}	}

if (copy($fn,$copyfile)) {	if (copy($fn,$copyfile)) {
$r->print('<p>'.&mt('Copied source file').'</p>');	$r->print('<p>'.&mt('Copied source file').'</p>');
} else {	} else {
return "<font color=\"red\">".	return "<span class=\"LC_error\">".
&mt('Failed to copy source').", $!, ".&mt('FAIL')."</font>";	&mt('Failed to copy source').", $!, ".&mt('FAIL')."</span>";
}	}

# --------------------------------------------------- Send update notifications	# --------------------------------------------------- Send update notifications
Line 1755 sub defaultmetapublish {	Line 2013 sub defaultmetapublish {
# ------------------------------------------------------------------- Link back	# ------------------------------------------------------------------- Link back
my $link=$fn;	my $link=$fn;
$link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//;	$link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//;
$r->print("<a href='$link'>".&mt('Back to Catalog Information').'</a>');	$r->print("<a href='$link'>".&mt('Back to Metadata').'</a>');
$r->print('</body></html>');	$r->print(&Apache::loncommon::end_page());
return OK;	return OK;
}	}
#########################################	#########################################
Line 1813 sub handler {	Line 2071 sub handler {
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},	&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['filename']);	['filename']);

	# -------------------------------------- Flag and buffer for registered cleanup
	$registered_cleanup=0;
	@{$modified_urls}=();
# -------------------------------------------------------------- Check filename	# -------------------------------------------------------------- Check filename

my $fn=&Apache::lonnet::unescape($ENV{'form.filename'});	my $fn=&unescape($env{'form.filename'});

($cuname,$cudom)=	($cuname,$cudom)=
&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));	&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
Line 1834 sub handler {	Line 2095 sub handler {

unless (($cuname) && ($cudom)) {	unless (($cuname) && ($cudom)) {
$r->log_reason($cuname.' at '.$cudom.	$r->log_reason($cuname.' at '.$cudom.
' trying to publish file '.$ENV{'form.filename'}.	' trying to publish file '.$env{'form.filename'}.
' ('.$fn.') - not authorized',	' ('.$fn.') - not authorized',
$r->filename);	$r->filename);
return HTTP_NOT_ACCEPTABLE;	return HTTP_NOT_ACCEPTABLE;
Line 1846 sub handler {	Line 2107 sub handler {
foreach my $id (@ids) { if ($id eq $home) { $allowed = 1; } }	foreach my $id (@ids) { if ($id eq $home) { $allowed = 1; } }
unless ($allowed) {	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 ('.$home.')',	' ('.$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{^/~($match_username)}{/home/$1/public_html};

my $targetdir='';	my $targetdir='';
$docroot=$r->dir_config('lonDocRoot');	$docroot=$r->dir_config('lonDocRoot');
if ($1 ne $cuname) {	if ($1 ne $cuname) {
$r->log_reason($cuname.' at '.$cudom.	$r->log_reason($cuname.' at '.$cudom.
' trying to publish unowned file '.	' trying to publish unowned file '.
$ENV{'form.filename'}.' ('.$fn.')',	$env{'form.filename'}.' ('.$fn.')',
$r->filename);	$r->filename);
return HTTP_NOT_ACCEPTABLE;	return HTTP_NOT_ACCEPTABLE;
} else {	} else {
Line 1871 sub handler {	Line 2132 sub handler {
unless (-e $fn) {	unless (-e $fn) {
$r->log_reason($cuname.' at '.$cudom.	$r->log_reason($cuname.' at '.$cudom.
' trying to publish non-existing file '.	' trying to publish non-existing file '.
$ENV{'form.filename'}.' ('.$fn.')',	$env{'form.filename'}.' ('.$fn.')',
$r->filename);	$r->filename);
return HTTP_NOT_FOUND;	return HTTP_NOT_FOUND;
}	}

unless ($ENV{'form.phase'} eq 'two') {

# -------------------------------- File is there and owned, init lookup tables.	# -------------------------------- File is there and owned, init lookup tables.

%addid=();	%addid=();

{	{
my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');	my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab');
while (<$fh>=~/(\w+)\s+(\w+)/) {	while (<$fh>=~/(\w+)\s+(\w+)/) {
$addid{$1}=$2;	$addid{$1}=$2;
}
}	}
	}

%nokey=();	%nokey=();

{	{
my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');	my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
while (<$fh>) {	while (<$fh>) {
my $word=$_;	my $word=$_;
chomp($word);	chomp($word);
$nokey{$word}=1;	$nokey{$word}=1;
}
}	}

}	}

# ---------------------------------------------------------- Start page output.	# ---------------------------------------------------------- Start page output.

&Apache::loncommon::content_type($r,'text/html');	&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;	$r->send_http_header;

$r->print('<html><head><title>LON-CAPA Publishing</title></head>');	# Breadcrumbs
$r->print(&Apache::loncommon::bodytag('Resource Publication'));	&Apache::lonhtmlcommon::clear_breadcrumbs();
	&Apache::lonhtmlcommon::add_breadcrumb({
	'text' => 'Construction Space',
	'href' => &Apache::loncommon::authorspace(),
	});
	&Apache::lonhtmlcommon::add_breadcrumb({
	'text' => 'Resource Publication',
	'href' => '',
	});

	my $js='<script type="text/javascript">'.
	&Apache::loncommon::browser_and_searcher_javascript().
	'</script>';
	$r->print(&Apache::loncommon::start_page('Resource Publication',$js)
	.&Apache::lonhtmlcommon::breadcrumbs()
	.&Apache::loncommon::head_subbox(
	&Apache::loncommon::CSTR_pageheader()) # FIXME crumbs broken?
	);


my $thisfn=$fn;	my $thisfn=$fn;
Line 1927 sub handler {	Line 2201 sub handler {
if ($fn=~/\/$/) {	if ($fn=~/\/$/) {
# -------------------------------------------------------- This is a directory	# -------------------------------------------------------- This is a directory
&publishdirectory($r,$fn,$thisdisfn);	&publishdirectory($r,$fn,$thisdisfn);
$r->print('<hr><font size="+2">'.&mt('Done').'</font><br><a href="/priv/'	$r->print('<hr /><a href="/priv/'
.$cuname.'/'.$thisdisfn	.$cuname.'/'.$thisdisfn
.'">'.&mt('Return to Directory').'</a>');	.'">'.&mt('Return to Directory').'</a>');

Line 1937 sub handler {	Line 2211 sub handler {
$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').' '.	if ($thistype eq 'page') { $thisembstyle = 'rat'; }
&Apache::loncommon::filedescription($thistype).' <tt>');

	$r->print('<h2>'
	.&mt('Publishing [_1]'
	,'<span class="LC_filename">'.$thisdisfn.'</span>')
	.'</h2>'
	);

	$r->print('<h3>'.&mt('Resource Details').'</h3>');

	$r->print(&Apache::lonhtmlcommon::start_pick_box());

	$r->print(&Apache::lonhtmlcommon::row_title(&mt('Type'))
	.&Apache::loncommon::filedescription($thistype)
	.&Apache::lonhtmlcommon::row_closure()
	);

	$r->print(&Apache::lonhtmlcommon::row_title(&mt('Link to Resource'))
	.'<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('</tt></h2><b>'.&mt('Target').':</b> <tt>'.	$r->print('</tt>'
$thisdistarget.'</tt><br />');	.&Apache::lonhtmlcommon::row_closure()
	);
if (($cuname ne $ENV{'user.name'})\|\|($cudom ne $ENV{'user.domain'})) {
$r->print('<h3><font color="red">'.&mt('Co-Author').': '.	$r->print(&Apache::lonhtmlcommon::row_title(&mt('Target'))
$cuname.&mt(' at ').$cudom.'</font></h3>');	.'<tt>'.$thisdistarget.'</tt>'
	);
	if (($cuname ne $env{'user.name'})\|\|($cudom ne $env{'user.domain'})) {
	$r->print(&Apache::lonhtmlcommon::row_closure()
	.&Apache::lonhtmlcommon::row_title(&mt('Co-Author'))
	.'<span class="LC_warning">'
	.&Apache::loncommon::plainname($cuname,$cudom) .' ('.$cuname.':'.$cudom.')'
	.'</span>'
	);
}	}

if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {	if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
	$r->print(&Apache::lonhtmlcommon::row_closure()
	.&Apache::lonhtmlcommon::row_title(&mt('Diffs')));
$r->print(<<ENDDIFF);	$r->print(<<ENDDIFF);
<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>');
}	}

	$r->print(&Apache::lonhtmlcommon::row_closure(1)
	.&Apache::lonhtmlcommon::end_pick_box()
	);

# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.	# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.

unless ($ENV{'form.phase'} eq 'two') {	unless ($env{'form.phase'} eq 'two') {
my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle);	# ---------------------------------------------------------- Parse for problems
$r->print('<hr />'.$outstring);	my ($warningcount,$errorcount);
	if ($thisembstyle eq 'ssi') {
	($warningcount,$errorcount)=&checkonthis($r,$thisfn);
	}
	unless ($errorcount) {
	my ($outstring,$error)=
	&publish($thisfn,$thistarget,$thisembstyle);
	$r->print($outstring);
	} else {
	$r->print('<h3 class="LC_error">'.
	&mt('The document contains errors and cannot be published.').
	'</h3>');
	}
} else {	} else {
$r->print('<hr />'.	&phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget);
&phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget));	$r->print('<hr />');
}	}
}	}
$r->print('</body></html>');	$r->print(&Apache::loncommon::end_page());

return OK;	return OK;
}	}

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

500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.

Removed from v.1.164
changed lines
	Added in v.1.261