loncom/publisher/lonpublisher.pm - diff

Return to lonpublisher.pm CVS log

Up to [LON-CAPA] / loncom / publisher

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

version 1.164, 2004/02/27 17:27:51	version 1.243, 2008/08/01 18:09:38
Line 121 use HTML::LCParser;	Line 121 use HTML::LCParser;
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 141 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 186 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 208 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 265 sub metaread {	Line 275 sub metaread {
}	}
&metaeval($metastring,$prefix);	&metaeval($metastring,$prefix);
return '<br /><b>'.&mt('Processed file').':</b> <tt>'.	return '<br /><b>'.&mt('Processed file').':</b> <tt>'.
&Apache::loncfile::display($fn).'</tt>';	&Apache::loncfile::display($fn).'</tt><br />';
}	}

#########################################	#########################################
Line 274 sub metaread {	Line 284 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 326 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;
	$title=&mt($title);
	$env{'form.'.$name}=$value;
	return "\n".&Apache::lonhtmlcommon::row_title($title)
	.'<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;	$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.'" />'
	.'<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) {
Line 345 sub selectbox {	Line 386 sub selectbox {
}	}
else {$selout.='>'.&{$functionref}($_).'</option>';}	else {$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 417 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 475 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 502 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 519 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 555 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 575 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 618 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 662 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 671 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 686 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++; }
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 731 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 786 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 795 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 843 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">WARNING: Cannot connect to '.
'database!</font>';	'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">WARNING: The metadata table does not '.
'exist in the LON-CAPA database.</font>';	'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">Error occured saving new values in '.
'metadata table in LON-CAPA database</font>';	'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 887 sub publish {	Line 959 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 973 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 913 sub publish {	Line 985 sub publish {

$scrout.='<h3>'.&mt('Dependencies').'</h3>';	$scrout.='<h3>'.&mt('Dependencies').'</h3>';
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 =~/\$/) {
	$scrout.='<br /><span 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>')
	.'</span><br />';
	}
unless ($style eq 'rat') {	unless ($style eq 'rat') {
$allowstr.="\n".'<allow src="'.$thisdep.'" />';	$allowstr.="\n".'<allow src="'.$thisdep.'" />';
}	}
$scrout.='<br />';	$scrout.='<br />';
if ($thisdep!~/\*/ && $thisdep!~m\|^/adm/\|) {	if ($thisdep!~/[\*\$]/ && $thisdep!~m\|^/adm/\|) {
$scrout.='<a href="'.$thisdep.'">';	$scrout.='<a href="'.$thisdep.'">';
}	}
$scrout.='<tt>'.$thisdep.'</tt>';	$scrout.='<tt>'.$thisdep.'</tt>';
if ($thisdep!~/\*/ && $thisdep!~m\|^/adm/\|) {	if ($thisdep!~/[\*\$]/ && $thisdep!~m\|^/adm/\|) {
$scrout.='</a>';	$scrout.='</a>';
if (	if (
&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.	&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
$thisdep.'.meta') eq '-1') {	$thisdep.'.meta') eq '-1') {
$scrout.= ' - <font color="red">'.&mt('Currently not available').	$scrout.= ' - <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);
Line 943 sub publish {	Line 1020 sub publish {
}	}
}	}
}	}
$outstring=~s/\n(\<\/[^\>]+\>)\s$/$allowstr\n$1\n/s;	$outstring=~s/\n(\<\/[^\>]+\>[^<])$/$allowstr\n$1\n/s;

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

{	{
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 977 sub publish {	Line 1049 sub publish {

unless ($batch) {	unless ($batch) {
$scrout.='<h3>'.&mt('Metadata Information').' ' .	$scrout.='<h3>'.&mt('Metadata Information').' ' .
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 1079 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 1104 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 1126 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 1144 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><h1><span class="LC_warning">'.&mt('Warning!').
'</font></h1><p><font color="red" size="+1">'.	'</span></h1><p><span class="LC_warning">'.
&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.').'</span></p><hr />';
	}
	if ($metadatafields{'copyright'} eq 'priv') {
	$scrout.='</p><h1><span class="LC_warning">'.&mt('Warning!').
	'</span></h1><p><span class="LC_warning">'.
	&mt('Copyright/distribution option "Private" is no longer supported. Select another option from below. Consider "Custom Rights" for maximum control over the usage of your resource.').'</span></p><hr />';
}	}

# ------------------------------------------------------- Now have all metadata	# ------------------------------------------------------- Now have all metadata
Line 1094 sub publish {	Line 1184 sub publish {
}	}


foreach (split(/\W+/,$metadatafields{'keywords'})) {	foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {
$keywords{$_}=1;	$addkey=~s/\s+/ /g;
	$addkey=~s/^\s//;
	$addkey=~s/\s$//;
	if ($addkey=~/\w/) {
	$keywords{$addkey}=1;
	}
}	}
# --------------------------------------------------- Now we also have keywords	# --------------------------------------------------- Now we also have keywords
# =============================================================================	# =============================================================================
# INTERACTIVE MODE	# interactive mode html goes into $intr_scrout
#	# batch mode throws away this HTML
unless ($batch) {	# additionally all of the field functions have a by product of setting
$scrout.=	# $env{'from.'..} so that it can be used by the phase two handler in
'<form name="pubform" action="/adm/publish" method="post">'.	# batch mode
'<p><input type="submit" value="'.&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>'
&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 1236 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/) {	.&Apache::loncommon::start_data_table_row();
$keywordout.=' checked="on"';
}	my $colcount=0;
} elsif (&Apache::loncommon::keyword($_)) {
	foreach (sort keys %keywords) {
	$colcount++;
	$keywordout.='<td><label>'.$colcount.'<input type="checkbox" name="keywords" value="'.$_.'"';
	if ($metadatafields{'keywords'}) {
	if ($metadatafields{'keywords'}=~/\Q$_\E/) {
$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;	}
}	$keywordout.=' />'.$_.'</label></td>';
$colcount++;	if ($colcount>=10) {
}	$keywordout.=&Apache::loncommon::end_data_table_row()
	.&Apache::loncommon::start_data_table_row();
$keywordout.='</tr></table>';	$colcount=0;
	}
$scrout.=$keywordout;	}
	# Proper end of started table row:
	if ($colcount != 0) { # has still to be improved: if amount of keywords mod 10 == 0, then do not start another table row
	while ($colcount<10) {
	$keywordout.='<td> </td>';
	$colcount++;
	}
	}

$scrout.=&textfield('Additional Keywords','addkey','');	$env{'form.keywords'}=~s/\,$//;

$scrout.=&textfield('Notes','notes',$metadatafields{'notes'});	$keywordout.=&Apache::loncommon::end_data_table_row()
	.&Apache::loncommon::end_data_table()
	.&Apache::lonhtmlcommon::row_closure();

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

$source=~/\.(\w+)$/;	$intr_scrout.=&textfield('Additional Keywords','addkey','');

	$intr_scrout.=&textfield('Notes','notes',$metadatafields{'notes'});

$scrout.=	$intr_scrout.="\n".&Apache::lonhtmlcommon::row_title(&mt('Abstract'))
"\n<p><font color=\"#800000\" face=\"helvetica\"><b>".	.'<textarea cols="80" rows="5" name="abstract">'
&mt('Lowest Grade Level').':'.	.$metadatafields{'abstract'}
"</b></font></p><br />".	.'</textarea>'
&Apache::loncommon::select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel').	.&Apache::lonhtmlcommon::row_closure();
"\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'});

	$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();

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

$scrout.=&hiddenfield('mime',$1);	$intr_scrout.=&hiddenfield('mime',$1);

my $defaultlanguage=$metadatafields{'language'};	my $defaultlanguage=$metadatafields{'language'};
$defaultlanguage =~ s/\snotset\s//g;	$defaultlanguage =~ s/\snotset\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',	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="1" ':'';
	$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{$_};
}
$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);
return ($scrout,0);
}	}
	} else {
	$intr_scrout.=
	&hiddenfield('title',$metadatafields{'title'}).
	&hiddenfield('author',$metadatafields{'author'}).
	&hiddenfield('subject',$metadatafields{'subject'}).
	&hiddenfield('keywords',$metadatafields{'keywords'}).
	&hiddenfield('abstract',$metadatafields{'abstract'}).
	&hiddenfield('notes',$metadatafields{'notes'}).
	&hiddenfield('mime',$metadatafields{'mime'}).
	&hiddenfield('creationdate',$metadatafields{'creationdate'}).
	&hiddenfield('lastrevisiondate',time).
	&hiddenfield('owner',$metadatafields{'owner'}).
	&hiddenfield('lowestgradelevel',$metadatafields{'lowestgradelevel'}).
	&hiddenfield('standards',$metadatafields{'standards'}).
	&hiddenfield('highestgradelevel',$metadatafields{'highestgradelevel'}).
	&hiddenfield('language',$metadatafields{'language'}).
	&hiddenfield('copyright',$metadatafields{'copyright'}).
	&hiddenfield('sourceavail',$metadatafields{'sourceavail'}).
	&hiddenfield('customdistributionfile',$metadatafields{'customdistributionfile'}).
	&hiddenfield('obsolete',1).
	&text_with_browse_field('Suggested Replacement for Obsolete File',
	'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 1449 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 1464 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('Cannot publish versioned resource, 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 1581 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 1455 sub phasetwo {	Line 1617 sub phasetwo {
my $srcd=$1;	my $srcd=$1;
unless ($srcd=~/^\/home\/httpd\/html\/res/) {	unless ($srcd=~/^\/home\/httpd\/html\/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 1480 sub phasetwo {	Line 1644 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 1659 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 1527 sub phasetwo {	Line 1693 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 1707 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;
print $logfile $reply;
}

# --------------------------------------------------- Notify subscribed courses
my %courses=&coursedependencies($target);
my $now=time;
foreach (keys %courses) {
$r->print('<p>'.&mt('Notifying course').' '.$_.':');$r->rflush;
print $logfile "\nNotifying host ".$_.':';
my ($cdom,$cname)=split(/\_/,$_);
my $reply=&Apache::lonnet::cput
('versionupdate',{$target => $now},$cdom,$cname);
$r->print($reply.'</p><br />');$r->rflush;
print $logfile $reply;
}
# ------------------------------------------------ Provide link to new resource	# ------------------------------------------------ Provide link to new resource
unless ($batch) {	unless ($batch) {
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 1740 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>';	$logfile->close();
	$r->print('<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 1637 sub batchpublish {	Line 1822 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 1660 sub publishdirectory {	Line 1845 sub publishdirectory {
&mt('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.
	unless ($env{'form.phase'} eq 'two') {
opendir(DIR,$fn);	# ask user what they want
my @files=sort(readdir(DIR));	$r->print('<form name="pubdirpref" method="post">'.
foreach my $filename (@files) {	&hiddenfield('phase','two').
my ($cdev,$cino,$cmode,$cnlink,	&hiddenfield('filename',$env{'form.filename'}).
$cuid,$cgid,$crdev,$csize,	&checkbox('pubrec','include subdirectories').
$catime,$cmtime,$cctime,	&checkbox('forcerepub','force republication of previously published files').
$cblksize,$cblocks)=stat($fn.'/'.$filename);	&checkbox('obsolete','make file(s) obsolete').
	&checkbox('forceoverride','force directory level catalog information over existing').
my $extension='';	'<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');
if ($filename=~/\.(\w+)$/) { $extension=$1; }	$lock=0;
if ($cmode&$dirptr) {	} else {
if (($filename!~/^\./) && ($ENV{'form.pubrec'})) {	unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); }
&publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);	# actually publish things
}	opendir(DIR,$fn);
} elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&	my @files=sort(readdir(DIR));
($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {	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 1924 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('Catalog Information Publication'));
$r->print(&Apache::loncommon::bodytag('Catalog Information Publication'));

# ---------------------------------------------------------------- Write Source	# ---------------------------------------------------------------- Write Source
my $copyfile=$target;	my $copyfile=$target;
Line 1740 sub defaultmetapublish {	Line 1944 sub defaultmetapublish {
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 1756 sub defaultmetapublish {	Line 1960 sub defaultmetapublish {
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 Catalog Information').'</a>');
$r->print('</body></html>');	$r->print(&Apache::loncommon::end_page());
return OK;	return OK;
}	}
#########################################	#########################################
Line 1813 sub handler {	Line 2017 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 2041 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 2053 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 2078 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>');	my $js='<script type="text/javascript">'.
$r->print(&Apache::loncommon::bodytag('Resource Publication'));	&Apache::loncommon::browser_and_searcher_javascript().
	'</script>';
	$r->print(&Apache::loncommon::start_page('Resource Publication',$js));


my $thisfn=$fn;	my $thisfn=$fn;
Line 1927 sub handler {	Line 2132 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 2142 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]','<tt>'.$thisdisfn.'</tt>').'</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>'
	);
	# SB - ToDo:
	if (($cuname ne $env{'user.name'})\|\|($cudom ne $env{'user.domain'})) {
	# $r->print(&Apache::lonhtmlcommon::row_title('<span class="LC_warning">'.&mt('Co-Author').'</span>')
	$r->print(&Apache::lonhtmlcommon::row_closure()
	.&Apache::lonhtmlcommon::row_title(&mt('Co-Author'))
	.'<span class="LC_warning">'
	.&mt('[_1] at [_2]',$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('<hr />'.$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>

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