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.201 and 1.299

version 1.201, 2005/08/09 20:00:06	version 1.299, 2021/06/04 03:06:15
Line 66 invocation by F<loncapa_apache.conf>:	Line 66 invocation by F<loncapa_apache.conf>:

=head1 OVERVIEW	=head1 OVERVIEW

Authors can only write-access the C</~authorname/> space. They can	Authors can only write-access the C</priv/domain/authorname/> space.
copy resources into the resource area through the publication step,	They can copy resources into the resource area through the
and move them back through a recover step. Authors do not have direct	publication step, and move them back through a recover step.
write-access to their resource space.	Authors do not have direct write-access to their resource space.

During the publication step, several events will be	During the publication step, several events will be
triggered. Metadata is gathered, where a wizard manages default	triggered. Metadata is gathered, where a wizard manages default
Line 102 to publication space.	Line 102 to publication space.
Many of the undocumented subroutines implement various magical	Many of the undocumented subroutines implement various magical
parsing shortcuts.	parsing shortcuts.

=over 4

=cut	=cut

######################################################################	######################################################################
Line 118 use Apache::File;	Line 116 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 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 LONCAPA::lonmetadata;	use LONCAPA::lonmetadata;
use Apache::lonmsg;	use Apache::lonmsg;
use vars qw(%metadatafields %metadatakeys);	use vars qw(%metadatafields %metadatakeys %addid $readit);
	use LONCAPA qw(:DEFAULT :match);
my %addid;
my %nokey;

my $docroot;	my $docroot;

my $cuname;	my $cuname;
Line 141 my $cudom;	Line 139 my $cudom;
my $registered_cleanup;	my $registered_cleanup;
my $modified_urls;	my $modified_urls;

	my $lock;

=pod	=pod

	=over 4

=item B<metaeval>	=item B<metaeval>

Evaluates a string that contains metadata. This subroutine	Evaluates a string that contains metadata. This subroutine
Line 181 sub metaeval {	Line 183 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 my $item (@{$token->[3]}) {
$metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};	$metadatafields{$unikey.'.'.$item}=$token->[2]->{$item};
if ($metadatakeys{$unikey}) {	if ($metadatakeys{$unikey}) {
$metadatakeys{$unikey}.=','.$_;	$metadatakeys{$unikey}.=','.$item;
} else {	} else {
$metadatakeys{$unikey}=$_;	$metadatakeys{$unikey}=$item;
}	}
}	}
my $newentry=$parser->get_text('/'.$entry);	my $newentry=$parser->get_text('/'.$entry);
Line 258 sub metaread {	Line 261 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 '<p class="LC_warning">'
&Apache::loncfile::display($fn).'</tt>';	.&mt('No file: [_1]',&Apache::loncfile::display($fn))
	.'</p>';
}	}
print($logfile 'Processing '.$fn."\n");	print($logfile 'Processing '.$fn."\n");
my $metastring;	my $metastring;
Line 268 sub metaread {	Line 272 sub metaread {
$metastring=join('',<$metafh>);	$metastring=join('',<$metafh>);
}	}
&metaeval($metastring,$prefix);	&metaeval($metastring,$prefix);
return '<br /><b>'.&mt('Processed file').':</b> <tt>'.	return '<p class="LC_info">'
&Apache::loncfile::display($fn).'</tt>';	.&mt('Processed file: [_1]',&Apache::loncfile::display($fn))
	.'</p>';
}	}

#########################################	#########################################
Line 278 sub metaread {	Line 283 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);
my %courses=();	my %courses=();
foreach (keys %evaldata) {	foreach my $item (keys(%evaldata)) {
if ($_=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) {	if ($item=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) {
$courses{$1}=1;	$courses{$1}=1;
}	}
}	}
Line 310 string which presents the form field (fo	Line 314 string which presents the form field (fo

=item B<textfield>	=item B<textfield>

	=item B<text_with_browse_field>

=item B<hiddenfield>	=item B<hiddenfield>

	=item B<checkbox>

=item B<selectbox>	=item B<selectbox>

=back	=back
Line 321 string which presents the form field (fo	Line 329 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);
$env{'form.'.$name}=$value;	$env{'form.'.$name}=$value;
return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".	return "\n".&Apache::lonhtmlcommon::row_title($title)
"</b></font></p><br />".	.'<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 {	sub text_with_browse_field {
my ($title,$name,$value,$restriction)=@_;	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);
$env{'form.'.$name}=$value;	$env{'form.'.$name}=$value;
return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".	return "\n".&Apache::lonhtmlcommon::row_title($title)
"</b></font></p><br />".	.'<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.'\');">Select</a> '.	.'<a href="javascript:openbrowser(\'pubform\',\''.$name.'\',\''.$restriction.'\');">'
'<a href="javascript:opensearcher(\'pubform\',\''.$name.'\');">Search</a>';	.&mt('Select')
	.'</a> '
	.'<a href="javascript:opensearcher(\'pubform\',\''.$name.'\');">'
	.&mt('Search')
	.'</a>'
	.&Apache::lonhtmlcommon::row_closure($noline);
}	}

sub hiddenfield {	sub hiddenfield {
Line 355 sub hiddenfield {	Line 367 sub hiddenfield {

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

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

sub select_level_form {	sub select_level_form {
Line 386 sub select_level_form {	Line 399 sub select_level_form {
if (!defined($value)) { $env{'form.'.$name}=0; }	if (!defined($value)) { $env{'form.'.$name}=0; }
return &Apache::loncommon::select_level_form($value,$name);	return &Apache::loncommon::select_level_form($value,$name);
}	}

	sub common_access {
	my ($name,$text,$options)=@_;
	return unless (ref($options) eq 'ARRAY');
	my $formname = 'pubdirpref';
	my $chkname = 'common'.$name;
	my $chkid = 'LC_'.$chkname;
	my $divid = $chkid.'div';
	my $customdivid = 'LC_customfile';
	my $selname = $chkname.'select';
	my $selid = $chkid.'select';
	my $selonchange;
	if ($name eq 'dist') {
	$selonchange = ' onchange="showHideCustom(this,'."'$customdivid'".');"';
	}
	my %lt = &Apache::lonlocal::texthash(
	'default' => 'System wide - can be used for any courses system wide',
	'domain' => 'Domain only - use limited to courses in the domai',
	'custom' => 'Customized right of use ...',
	'public' => 'Public - no authentication or authorization required for use',
	'closed' => 'Closed - XML source is closed to everyone',
	'open' => 'Open - XML source is open to people who want to use it',
	'sel' => 'Select',
	);
	my $output = <<"END";
	<span class="LC_nobreak">
	<label>
	<input type="checkbox" name="commonaccess" value="$name" id="$chkid"
	onclick="showHideAccess(this,'$divid');" />
	$text</label></span>
	<div id="$divid" style="padding:0;clear:both;margin:0;border:0;display:none">
	<select name="$selname" id="$selid" $selonchange>
	<option value="" selected="selected">$lt{'sel'}</option>
	END
	foreach my $val (@{$options}) {
	$output .= '<option value="'.$val.'">'.$lt{$val}.'</option>'."\n";
	}
	$output .= '
	</select>';
	if ($name eq 'dist') {
	$output .= <<"END";
	<div id="$customdivid" style="padding:0;clear:both;margin:0;border:0;display:none">
	<input type="text" name="commoncustomrights" size="60" value="" />
	<a href="javascript:openbrowser('$formname','commoncustomrights','rights');">
	$lt{'sel'}</a></div>
	END
	}
	$output .= '
	</div>
	';
	}

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

Line 407 sub urlfixup {	Line 472 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 456 Currently undocumented	Line 520 Currently undocumented
#########################################	#########################################
#########################################	#########################################
sub set_allow {	sub set_allow {
my ($allow,$logfile,$target,$tag,$oldurl)=@_;	my ($allow,$logfile,$target,$tag,$oldurl,$type)=@_;
my $newurl=&urlfixup($oldurl,$target);	my $newurl=&urlfixup($oldurl,$target);
my $return_url=$oldurl;	my $return_url=$oldurl;
print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n";	print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n";
Line 466 sub set_allow {	Line 530 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 !~ /^\#/)) {
	if (($type eq 'src') \|\| ($type eq 'href')) {
	if ($newurl =~ /^([^?]+)\?[^?]*$/) {
	$newurl = $1;
	}
	}
$$allow{&absoluteurl($newurl,$target)}=1;	$$allow{&absoluteurl($newurl,$target)}=1;
}	}
return $return_url	return $return_url;
}	}

#########################################	#########################################
Line 493 sub get_subscribed_hosts {	Line 562 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 'tmp') &&	&& $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 506 sub get_subscribed_hosts {	Line 579 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 548 sub get_max_ids_indices {	Line 615 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') {
Line 654 sub fix_ids_and_indices {	Line 722 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 663 sub fix_ids_and_indices {	Line 731 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 677 sub fix_ids_and_indices {	Line 746 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}; }
Line 686 sub fix_ids_and_indices {	Line 761 sub fix_ids_and_indices {
$parms{'id'}!~/^\s*$/) {	$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'}) &&
Line 697 sub fix_ids_and_indices {	Line 774 sub fix_ids_and_indices {
}	}
}	}
}	}
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,	next if (($lctag eq 'img') && ($type eq 'src') &&
$parms{$key});	($parms{$key} =~ m{^data\:image/gif;base64,}));
	$parms{$key}=&set_allow(\%allow,$logfile,
	$target,$tag,
	$parms{$key},$type);
	}
}	}
}	}
}	}
Line 713 sub fix_ids_and_indices {	Line 794 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 757 sub fix_ids_and_indices {	Line 839 sub fix_ids_and_indices {
}	}
my $newparmstring='';	my $newparmstring='';
my $endtag='';	my $endtag='';
foreach (keys %parms) {	foreach my $parkey (keys(%parms)) {
if ($_ eq '/') {	if ($parkey eq '/') {
$endtag=' /';	$endtag=' /';
} else {	} else {
my $quote=($parms{$_}=~/\"/?"'":'"');	my $quote=($parms{$parkey}=~/\"/?"'":'"');
$newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote;	$newparmstring.=' '.$parkey.'='.$quote.$parms{$parkey}.$quote;
}	}
}	}
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 'answer' \|\| $lctag eq 'display' \|\|
\|\| $lctag eq 'display' \|\| $lctag eq 'tex') {	$lctag eq 'tex') {
$outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);	$outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);
}	} elsif ($lctag eq 'script') {
	if ($parms{'type'} eq 'loncapa/perl') {
	$outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);
	} else {
	my $script = &get_all_text_unbalanced('/'.$lctag,\@parser);
	if ($script =~ m{\.set\w+(Src\|Swf)\(["']}i) {
	my @srcs = split(/\.set/i,$script);
	if (scalar(@srcs) > 1) {
	foreach my $item (@srcs) {
	if ($item =~ m{^(FlashPlayerSwf\|MediaSrc\|XMPSrc\|ConfigurationSrc\|PosterImageSrc)$(['"])(?:(?!\2).)+\2$}is) {
	my $srctype = $1;
	my $quote = $2;
	my ($url) = ($item =~ m{^\Q$srctype($quote\E([^$quote]+)\Q$quote)\E});
	$url = &urlfixup($url);
	unless ($url=~m{^(?:http\|https\|ftp)://}) {
	$allow{&absoluteurl($url,$target)}=1;
	if ($srctype eq 'ConfigurationSrc') {
	if ($url =~ m{^(.+/)configuration_express\.xml$}) {
	#
	# Camtasia 8.1: express_show/spritesheet.png needed, and included in zip archive.
	# Not referenced directly in <main>.html or <main>_player.html files,
	# so add this file to %allow (where <main> is name user gave to file/archive).
	#
	my $spritesheet = $1.'express_show/spritesheet.png';
	$allow{&absoluteurl($spritesheet,$target)}=1;

	#
	# Camtasia 8.4: skins/express_show/spritesheet.min.css needed, and included in zip archive.
	# Not referenced directly in <main>.html or <main>_player.html files,
	# so add this file to %allow (where <main> is name user gave to file/archive).
	#
	my $spritecss = $1.'express_show/spritesheet.min.css';
	$allow{&absoluteurl($spritecss,$target)}=1;
	}
	} elsif ($srctype eq 'PosterImageSrc') {
	if ($url =~ m{^(.+)_First_Frame\.png$}) {
	my $prefix = $1;
	#
	# Camtasia 8.1: <main>_Thumbnails.png needed, and included in zip archive.
	# Not referenced directly in <main>.html or <main>_player.html files,
	# so add this file to %allow (where <main> is name user gave to file/archive).
	#
	my $thumbnail = $prefix.'_Thumbnails.png';
	$allow{&absoluteurl($thumbnail,$target)}=1;
	}
	}
	}
	}
	}
	}
	}
	if ($script =~ m{\.addMediaSrc$(["'])((?!\1).+)\1$;}) {
	my $src = $2;
	if ($src) {
	my $url = &urlfixup($src);
	unless ($url=~m{^(?:http\|https\|ftp)://}) {
	$allow{&absoluteurl($url,$target)}=1;
	}
	}
	}
	if ($script =~ /$document,\s(['"])script\1,\s\[([^\]]+)\]$;/s) {
	my $scriptslist = $2;
	my @srcs = split(/\s,\s/,$scriptslist);
	foreach my $src (@srcs) {
	if ($src =~ /(["'])(?:(?!\1).)+\.js\1/) {
	my $quote = $1;
	my ($url) = ($src =~ m/\Q$quote\E([^$quote]+)\Q$quote\E/);
	$url = &urlfixup($url);
	unless ($url=~m{^(?:http\|https\|ftp)://}) {
	$allow{&absoluteurl($url,$target)}=1;
	}
	}
	}
	}
	if ($script =~ m{loadScript\(\s(['"])((?:(?!\1).)+\.js)\1,\sfunction}is) {
	my $src = $2;
	if ($src) {
	my $url = &urlfixup($src);
	unless ($url=~m{^(?:http\|https\|ftp)://}) {
	$allow{&absoluteurl($url,$target)}=1;
	}
	}
	}
	$outstring .= $script;
	}
	}
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
if ($token->[2]) {	if ($token->[2]) {
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 819 sub store_metadata {	Line 991 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);
}	}
my $dbh = &Apache::lonmysql::get_dbh();	my $dbh = &Apache::lonmysql::get_dbh();
if (($metadata{'obsolete'}) \|\| ($metadata{'copyright'} eq 'priv') \|\|	if (($metadata{'obsolete'}) \|\| ($metadata{'copyright'} eq 'priv')) {
($metadata{'copyright'} eq 'custom')) {
# remove this entry	# remove this entry
$status=&LONCAPA::lonmetadata::delete_metadata($dbh,undef,	my $delitem = 'url = '.$dbh->quote($metadata{'url'});
$metadata{'url'});	$status = &LONCAPA::lonmetadata::delete_metadata($dbh,undef,$delitem);

} else {	} else {
$status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,	$status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,undef,
\%metadata);	\%metadata);
}	}
if (defined($status) && $status ne '') {	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);	&Apache::lonnet::logthis($status);
return ($error,undef);	return ($error,undef);
}	}
return (undef,$status);	return (undef,'success');
}	}


Line 863 sub checkonthis {	Line 1038 sub checkonthis {
'return_only_error_and_warning_counts' => 1));	'return_only_error_and_warning_counts' => 1));
my ($errorcount,$warningcount)=split(':',$result);	my ($errorcount,$warningcount)=split(':',$result);
if (($errorcount) \|\| ($warningcount)) {	if (($errorcount) \|\| ($warningcount)) {
$r->print('<br /><tt>'.$uri.'</tt>: ');	$r->print('<h3>'.&mt('Warnings and Errors').'</h3>');
if ($errorcount) {	$r->print('<tt>'.$uri.'</tt>:');
$r->print('<img src="/adm/lonMisc/bomb.gif" /><font color="red"><b>'.	$r->print('<ul>');
$errorcount.' '.	if ($warningcount) {
&mt('error(s)').'</b></font> ');	$r->print('<li><div class="LC_warning">'
}	.&mt('[quant,_1,warning]',$warningcount)
if ($warningcount) {	.'</div></li>');
$r->print('<font color="blue">'.	}
$warningcount.' '.	if ($errorcount) {
&mt('warning(s)').'</font>');	$r->print('<li><div class="LC_error">'
}	.&mt('[quant,_1,error]',$errorcount)
	.' <img src="/adm/lonMisc/bomb.gif" />'
	.'</div></li>');
	}
	$r->print('</ul>');
} else {	} else {
#$r->print('<font color="green">'.&mt('ok').'</font>');	#$r->print('<font color="green">'.&mt('ok').'</font>');
}	}
Line 912 backup copies, performs any automatic pr	Line 1091 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 923 I<Additional documentation needed.>	Line 1102 I<Additional documentation needed.>
#########################################	#########################################
sub publish {	sub publish {

my ($source,$target,$style,$batch)=@_;	my ($source,$target,$style,$batch,$nokeyref)=@_;
my $logfile;	my $logfile;
my $scrout='';	my $scrout='';
my $allmeta='';	my $allmeta='';
Line 931 sub publish {	Line 1110 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 945 sub publish {	Line 1124 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 955 sub publish {	Line 1134 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 {
	#
	# Store the fact that the dependency has been used by the target file
	# Unfortunately, usage is erroneously named sequsage in lonmeta.pm
	# The translation happens in lonmetadata.pm
	#
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(\<\/[^\>]+\>[^<])$/$allowstr\n$1\n/s;	$outstring=~s/\n(\<\/[^\>]+\>[^<])$/$allowstr\n$1\n/s;

Line 995 sub publish {	Line 1190 sub publish {
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 1015 sub publish {	Line 1210 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>';
}	}

Line 1028 sub publish {	Line 1223 sub publish {
$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

my $thisdisfn=$source;	my $thisdisfn=$source;
$thisdisfn=~s/^\/home\/\Q$cuname\E\///;

my @urlparts=split(/\//,$thisdisfn);	$thisdisfn=~s/^\Q$docroot\E\/priv\/\Q$cudom\E\/\Q$cuname\E\///;
	my @urlparts=('.',split(/\//,$thisdisfn));
$#urlparts--;	$#urlparts--;

my $currentpath='/home/'.$cuname.'/';	my $currentpath=$docroot.'/priv/'.$cudom.'/'.$cuname.'/';

my $prefix='../'x($#urlparts);	my $prefix='../'x($#urlparts);
foreach (@urlparts) {	foreach my $subdir (@urlparts) {
$currentpath.=$_.'/';	$currentpath.=$subdir.'/';
$scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);	$scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);
$prefix=~s\|^\.\./\|\|;	$prefix=~s\|^\.\./\|\|;
}	}
Line 1054 sub publish {	Line 1249 sub publish {

# ------------------- Clear out parameters and stores (there should not be any)	# ------------------- Clear out parameters and stores (there should not be any)

foreach (keys %metadatafields) {	foreach my $field (keys(%metadatafields)) {
if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {	if (($field=~/^parameter/) \|\| ($field=~/^stores/)) {
delete $metadatafields{$_};	delete $metadatafields{$field};
}	}
}	}

Line 1065 sub publish {	Line 1260 sub publish {

$scrout.=&metaread($logfile,$source.'.meta');	$scrout.=&metaread($logfile,$source.'.meta');

foreach (keys %metadatafields) {	foreach my $field (keys(%metadatafields)) {
if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {	if (($field=~/^parameter/) \|\| ($field=~/^stores/)) {
$oldparmstores{$_}=1;	$oldparmstores{$field}=1;
delete $metadatafields{$_};	delete $metadatafields{$field};
}	}
}	}
# ------------------------------------------------------------- Save some stuff	# ------------------------------------------------------------- Save some stuff
my %savemeta=();	my %savemeta=();
foreach ('title') {	if ($metadatafields{'title'}) { $savemeta{'title'}=$metadatafields{'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	# ----------------------------------------------------------- Restore the stuff
foreach (keys %savemeta) {	foreach my $item (keys(%savemeta)) {
$metadatafields{$_}=$savemeta{$_};	$metadatafields{$item}=$savemeta{$item};
}	}
}	}

Line 1089 sub publish {	Line 1282 sub publish {
# ---------------- Find and document discrepancies in the parameters and stores	# ---------------- Find and document discrepancies in the parameters and stores

my $chparms='';	my $chparms='';
foreach (sort keys %metadatafields) {	foreach my $field (sort(keys(%metadatafields))) {
if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {	if (($field=~/^parameter/) \|\| ($field=~/^stores/)) {
unless ($_=~/\.\w+$/) {	unless ($field=~/\.\w+$/) {
unless ($oldparmstores{$_}) {	unless ($oldparmstores{$field}) {
print $logfile 'New: '.$_."\n";	my $disp_key = $field;
$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>';
}	}

$chparms='';	$chparms='';
foreach (sort keys %oldparmstores) {	foreach my $olditem (sort(keys(%oldparmstores))) {
if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {	if (($olditem=~/^parameter/) \|\| ($olditem=~/^stores/)) {
unless (($metadatafields{$_.'.name'}) \|\|	unless (($metadatafields{$olditem.'.name'}) \|\|
($metadatafields{$_.'.package'}) \|\| ($_=~/\.\w+$/)) {	($metadatafields{$olditem.'.package'}) \|\| ($olditem=~/\.\w+$/)) {
print $logfile 'Obsolete: '.$_."\n";	my $disp_key = $olditem;
$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 1130 sub publish {	Line 1333 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 ($nokeyref->{$_}) {
	$keywords{$_}=1;
	}
	}


	}

foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {	foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {
$addkey=~s/\s+/ /g;	$addkey=~s/\s+/ /g;
Line 1158 sub publish {	Line 1366 sub publish {
# $env{'from.'..} so that it can be used by the phase two handler in	# $env{'from.'..} so that it can be used by the phase two handler in
# batch mode	# batch mode

my $intr_scrout.=	my $intr_scrout.='<br />'
'<form name="pubform" action="/adm/publish" method="post">'.	.'<form name="pubform" action="/adm/publish" method="post">';
'<p>'.($env{'form.makeobsolete'}?'':'<input type="submit" value="'.&mt('Finalize Publication').'" />').'</p>'.	unless ($env{'form.makeobsolete'}) {
	$intr_scrout.='<p class="LC_warning">'
	.&mt('Searching for your resource will be based on the following metadata. Please provide as much data as possible.')
	.'</p>'
	.'<p><input type="submit" value="'
	.&mt('Finalize Publication')
	.'" /> <a href="'.&Apache::loncfile::url($source).'">'.&mt('Cancel').'</a></p>';
	}
	$intr_scrout.=&Apache::lonhtmlcommon::start_pick_box();
	$intr_scrout.=
&hiddenfield('phase','two').	&hiddenfield('phase','two').
&hiddenfield('filename',$env{'form.filename'}).	&hiddenfield('filename',$env{'form.filename'}).
&hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).	&hiddenfield('allmeta',&escape($allmeta)).
&hiddenfield('dependencies',join(',',keys %allow));	&hiddenfield('dependencies',join(',',keys(%allow)));
unless ($env{'form.makeobsolete'}) {	unless ($env{'form.makeobsolete'}) {
$intr_scrout.=	$intr_scrout.=
&textfield('Title','title',$metadatafields{'title'}).	&textfield('Title','title',$metadatafields{'title'}).
Line 1172 sub publish {	Line 1389 sub publish {
&textfield('Subject','subject',$metadatafields{'subject'});	&textfield('Subject','subject',$metadatafields{'subject'});
# --------------------------------------------------- Scan content for keywords	# --------------------------------------------------- Scan content for keywords

my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");	my $keywords_help = &Apache::loncommon::help_open_topic("Publishing_Keywords");
my $KEYWORDS=&mt('Keywords');
my $CheckAll=&mt('check all');
my $UncheckAll=&mt('uncheck all');
my $keywordout=<<"END";	my $keywordout=<<"END";
<script>	<script>
function checkAll(field) {	function checkAll(field) {
Line 1188 function uncheckAll(field) {	Line 1402 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'))
	.$keywords_help
	.'<input type="button" value="'.&mt('check all').'" onclick="javascript:checkAll(document.pubform.keywords)" />'
	.'<input type="button" value="'.&mt('uncheck all').'" onclick="javascript:uncheckAll(document.pubform.keywords)" />'
	.'</p><br />'
	.&Apache::loncommon::start_data_table();
	my $cols_per_row = 10;
my $colcount=0;	my $colcount=0;
	my $wordcount=0;
	my $numkeywords = scalar(keys(%keywords));

foreach (sort keys %keywords) {	foreach my $word (sort(keys(%keywords))) {
$keywordout.='<td><label><input type="checkbox" name="keywords" value="'.$_.'"';	if ($colcount == 0) {
if ($metadatafields{'keywords'}) {	$keywordout .= &Apache::loncommon::start_data_table_row();
if ($metadatafields{'keywords'}=~/\Q$_\E/) {	}
$keywordout.=' checked="on"';	$colcount++;
$env{'form.keywords'}.=$_.',';	$wordcount++;
}	if (($wordcount == $numkeywords) && ($colcount < $cols_per_row)) {
} elsif (&Apache::loncommon::keyword($_)) {	my $colspan = 1+$cols_per_row-$colcount;
$keywordout.=' checked="on"';	$keywordout .= '<td colspan="'.$colspan.'">';
$env{'form.keywords'}.=$_.',';	} else {
}	$keywordout .= '<td>';
$keywordout.=' />'.$_.'</label></td>';	}
if ($colcount>10) {	$keywordout.='<label><input type="checkbox" name="keywords" value="'.$word.'"';
$keywordout.="</tr><tr>\n";	if ($metadatafields{'keywords'}) {
$colcount=0;	if ($metadatafields{'keywords'}=~/\Q$word\E/) {
}	$keywordout.=' checked="checked"';
$colcount++;	$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();
}	}

$env{'form.keywords'}=~s/\,$//;	$env{'form.keywords'}=~s/\,$//;

$keywordout.='</tr></table>';	$keywordout.=&Apache::loncommon::end_data_table_row()
	.&Apache::loncommon::end_data_table()
	.&Apache::lonhtmlcommon::row_closure();

$intr_scrout.=$keywordout;	$intr_scrout.=$keywordout;

Line 1226 END	Line 1458 END

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

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

$source=~/\.(\w+)$/;	$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.=	$intr_scrout.=&textfield('Standards','standards',$metadatafields{'standards'});
"\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
&mt('Lowest Grade Level').':'.
"</b></font></p><br />".
&select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel').
"\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
&mt('Highest Grade Level').':'.
"</b></font></p><br />".
&select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel').
&textfield('Standards','standards',$metadatafields{'standards'});




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

Line 1270 END	Line 1498 END

$intr_scrout.=&hiddenfield('lastrevisiondate',time);	$intr_scrout.=&hiddenfield('lastrevisiondate',time);

	my $pubowner_last;
	if ($style eq 'prv') {
	$pubowner_last = 1;
	}
$intr_scrout.=&textfield('Publisher/Owner','owner',	$intr_scrout.=&textfield('Publisher/Owner','owner',
$metadatafields{'owner'});	$metadatafields{'owner'},$pubowner_last);

# ---------------------------------------------- Retrofix for unused copyright	# ---------------------------------------------- Retrofix for unused copyright
if ($metadatafields{'copyright'} eq 'free') {	if ($metadatafields{'copyright'} eq 'free') {
$metadatafields{'copyright'}='default';	$metadatafields{'copyright'}='default';
$metadatafields{'sourceavail'}='open';	$metadatafields{'sourceavail'}='open';
}	}
	if ($metadatafields{'copyright'} eq 'priv') {
	$metadatafields{'copyright'}='domain';
	}
# ------------------------------------------------ Dial in reasonable defaults	# ------------------------------------------------ Dial in reasonable defaults
my $defaultoption=$metadatafields{'copyright'};	my $defaultoption=$metadatafields{'copyright'};
unless ($defaultoption) { $defaultoption='default'; }	unless ($defaultoption) { $defaultoption='default'; }
Line 1295 END	Line 1529 END
$intr_scrout.=&selectbox('Copyright/Distribution','copyright',	$intr_scrout.=&selectbox('Copyright/Distribution','copyright',
$defaultoption,	$defaultoption,
\&Apache::loncommon::copyrightdescription,	\&Apache::loncommon::copyrightdescription,
(grep !/^public$/,(&Apache::loncommon::copyrightids)));	(grep !/^(public\|priv)$/,(&Apache::loncommon::copyrightids)));
} else {	} else {
$intr_scrout.=&selectbox('Copyright/Distribution','copyright',	$intr_scrout.=&selectbox('Copyright/Distribution','copyright',
$defaultoption,	$defaultoption,
\&Apache::loncommon::copyrightdescription,	\&Apache::loncommon::copyrightdescription,
(&Apache::loncommon::copyrightids));	(grep !/^priv$/,(&Apache::loncommon::copyrightids)));
}	}
my $copyright_help =	my $copyright_help =
Apache::loncommon::help_open_topic('Publishing_Copyright');	&Apache::loncommon::help_open_topic('Publishing_Copyright');
$intr_scrout =~ s/Distribution:/'Distribution: ' . $copyright_help/ge;	my $replace=&mt('Copyright/Distribution:');
$intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights').$copyright_help;	$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',	$intr_scrout.=&selectbox('Source Distribution','sourceavail',
$defaultsourceoption,	$defaultsourceoption,
\&Apache::loncommon::source_copyrightdescription,	\&Apache::loncommon::source_copyrightdescription,
(&Apache::loncommon::source_copyrightids));	(&Apache::loncommon::source_copyrightids));
# $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights');	# $intr_scrout.=&text_with_browse_field('Source Custom Distribution File','sourcerights',$metadatafields{'sourcerights'},'rights');
my $uctitle=&mt('Obsolete');	my $uctitle=&mt('Obsolete');
$intr_scrout.=	my $obsolete_checked=($metadatafields{'obsolete'})?' checked="checked"':'';
"\n<p><label><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".	$intr_scrout.="\n".&Apache::lonhtmlcommon::row_title($uctitle)
'</b></font> <input type="checkbox" name="obsolete" ';	.'<input type="checkbox" name="obsolete"'.$obsolete_checked.' />'
if ($metadatafields{'obsolete'}) {	.&Apache::lonhtmlcommon::row_closure(1);
$intr_scrout.=' checked="1" ';	$intr_scrout.=&text_with_browse_field('Suggested Replacement for Obsolete File',
}
$intr_scrout.='/ ></label></p>'.
&text_with_browse_field('Suggested Replacement for Obsolete File',
'obsoletereplacement',	'obsoletereplacement',
$metadatafields{'obsoletereplacement'});	$metadatafields{'obsoletereplacement'},'',1);
} else {	} else {
$intr_scrout.=&hiddenfield('copyright','private');	$intr_scrout.=&hiddenfield('copyright','private');
}	}
Line 1347 END	Line 1580 END
&hiddenfield('obsolete',1).	&hiddenfield('obsolete',1).
&text_with_browse_field('Suggested Replacement for Obsolete File',	&text_with_browse_field('Suggested Replacement for Obsolete File',
'obsoletereplacement',	'obsoletereplacement',
$metadatafields{'obsoletereplacement'});	$metadatafields{'obsoletereplacement'},'',1);
}	}
if (!$batch) {	if (!$batch) {
$scrout.=$intr_scrout.'<p><input type="submit" value="'.	$scrout.=$intr_scrout
&mt($env{'form.makeobsolete'}?'Make Obsolete':'Finalize Publication').'" /></p></form>';	.&Apache::lonhtmlcommon::end_pick_box()
	.'<p><input type="submit" value="'
	.&mt($env{'form.makeobsolete'}?'Make Obsolete':'Finalize Publication')
	.'" /></p>'
	.'</form>';
}	}
return($scrout,0);	return($scrout,0);
}	}

	sub getnokey {
	my ($includedir) = @_;
	my $nokey={};
	my $fh=Apache::File->new($includedir.'/un_keyword.tab');
	while (<$fh>) {
	my $word=$_;
	chomp($word);
	$nokey->{$word}=1;
	}
	return $nokey;
	}

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

Line 1378 Parameters:	Line 1627 Parameters:

=item I<$distarget>	=item I<$distarget>

	=item I<$batch>

	=item I<$usebuffer>

=back	=back

Returns:	Returns:

=over 4	=over 4

=item integer	=item integer or array

	if $userbuffer arg is true, and if caller wants an array
	then the array ($output,$rtncode) will be returned, otherwise
	just the $rtncode will be returned. $rtncode is an integer:

0: fail	0: fail
1: success	1: success

	=back

=cut	=cut

#'stupid emacs	#'stupid emacs
Line 1396 Returns:	Line 1655 Returns:
#########################################	#########################################
sub phasetwo {	sub phasetwo {

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

Line 1425 sub phasetwo {	Line 1712 sub phasetwo {
$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(	$output = '<span class="LC_error">'.
'<font color="red">'.	&mt('No write permission to user directory, FAIL').'</span>';
&mt('No write permission to user directory, FAIL').'</font>');	if ($usebuffer) {
return 0;	if (wantarray) {
	return ($output,0);
	} else {
	return 0;
	}
	} else {
	return 0;
	}
	}

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

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(&Apache::lonnet::unescape($env{'form.allmeta'}));	&metaeval(&unescape($env{'form.allmeta'}));

	if ($batch) {
	my %commonaccess;
	map { $commonaccess{$_} = 1; } &Apache::loncommon::get_env_multiple('form.commonaccess');
	if ($commonaccess{'dist'}) {
	unless ($style eq 'prv') {
	if ($env{'form.commondistselect'} eq 'custom') {
	unless ($source =~ /\.rights$/) {
	if ($env{'form.commoncustomrights'} =~ m{^/res/.+\.rights$}) {
	$env{'form.customdistributionfile'} = $env{'form.commoncustomrights'};
	$env{'form.copyright'} = $env{'form.commondistselect'};
	}
	}
	} elsif ($env{'form.commondistselect'} =~ /^default\|domain\|public$/) {
	$env{'form.copyright'} = $env{'form.commondistselect'};
	}
	}
	}
	unless ($style eq 'prv') {
	if ($commonaccess{'source'}) {
	if (($env{'form.commonsourceselect'} eq 'open') \|\| ($env{'form.commonsourceselect'} eq 'closed')) {
	$env{'form.sourceavail'} = $env{'form.commonsourceselect'};
	}
	}
	}
	}

$metadatafields{'title'}=$env{'form.title'};	$metadatafields{'title'}=$env{'form.title'};
$metadatafields{'author'}=$env{'form.author'};	$metadatafields{'author'}=$env{'form.author'};
$metadatafields{'subject'}=$env{'form.subject'};	$metadatafields{'subject'}=$env{'form.subject'};
Line 1459 sub phasetwo {	Line 1788 sub phasetwo {
$metadatafields{'obsoletereplacement'}=	$metadatafields{'obsoletereplacement'}=
$env{'form.obsoletereplacement'};	$env{'form.obsoletereplacement'};
$metadatafields{'dependencies'}=$env{'form.dependencies'};	$metadatafields{'dependencies'}=$env{'form.dependencies'};
$metadatafields{'modifyinguser'}=$env{'user.name'}.'@'.	$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'})) {
Line 1482 sub phasetwo {	Line 1812 sub phasetwo {
if ($metadatafields{'copyright'} eq 'custom') {	if ($metadatafields{'copyright'} eq 'custom') {
my $file=$metadatafields{'customdistributionfile'};	my $file=$metadatafields{'customdistributionfile'};
unless ($file=~/\.rights$/) {	unless ($file=~/\.rights$/) {
$r->print(	$output .= '<span class="LC_error">'.&mt('No valid custom distribution rights file specified, FAIL').
'<font color="red">'.&mt('No valid custom distribution rights file specified, FAIL').	'</span>';
'</font>');	if ($usebuffer) {
return 0;	if (wantarray) {
	return ($output,0);
	} else {
	return 0;
	}
	} else {
	$r->print($output);
	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')) {
$r->print(	$output .= '<span class="LC_error">'.&mt('Could not write metadata, FAIL').
'<font color="red">'.&mt('Could not write metadata, FAIL').	'</span>';
'</font>');	if ($usebuffer) {
return 0;	if (wantarray) {
}	return ($output,0);
foreach (sort keys %metadatafields) {	} else {
unless ($_=~/\./) {	return 0;
my $unikey=$_;	}
	} else {
	$r->print($output);
	return 0;
	}
	}
	foreach my $field (sort(keys(%metadatafields))) {
	unless ($field=~/\./) {
	my $unikey=$field;
$unikey=~/^([A-Za-z]+)/;	$unikey=~/^([A-Za-z]+)/;
my $tag=$1;	my $tag=$1;
$tag=~tr/A-Z/a-z/;	$tag=~tr/A-Z/a-z/;
print $mfh "\n\<$tag";	print $mfh "\n\<$tag";
foreach (split(/\,/,$metadatakeys{$unikey})) {	foreach my $item (split(/\,/,$metadatakeys{$unikey})) {
my $value=$metadatafields{$unikey.'.'.$_};	my $value=$metadatafields{$unikey.'.'.$item};
$value=~s/\"/\'\'/g;	$value=~s/\"/\'\'/g;
print $mfh ' '.$_.'="'.$value.'"';	print $mfh ' '.$item.'="'.$value.'"';
}	}
print $mfh '>'.	print $mfh '>'.
&HTML::Entities::encode($metadatafields{$unikey},'<>&"')	&HTML::Entities::encode($metadatafields{$unikey},'<>&"')
.'</'.$tag.'>';	.'</'.$tag.'>';
}	}
}	}
$r->print('<p>'.&mt('Wrote Metadata').'</p>');
	$output .= '<p>'.&mt('Wrote Metadata').'</p>';
	unless ($usebuffer) {
	$r->print($output);
	$output = '';
	}
print $logfile "\nWrote metadata";	print $logfile "\nWrote metadata";
}	}

Line 1523 sub phasetwo {	Line 1874 sub phasetwo {
$metadatafields{'url'} = $distarget;	$metadatafields{'url'} = $distarget;
$metadatafields{'version'} = 'current';	$metadatafields{'version'} = 'current';

my ($error,$success) = &store_metadata(%metadatafields);	my $crsauthor;
if ($success) {	if ($env{'request.course.id'}) {
$r->print('<p>'.&mt('Synchronized SQL metadata database').'</p>');	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
print $logfile "\nSynchronized SQL metadata database";	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
} else {	if ($distarget =~ m{^/res/$cdom/$cnum}) {
$r->print($error);	$crsauthor = 1;
print $logfile "\n".$error;	}
	}
	unless ($crsauthor) {
	my ($error,$success) = &store_metadata(%metadatafields);
	if ($success) {
	$output .= '<p>'.&mt('Synchronized SQL metadata database').'</p>';
	print $logfile "\nSynchronized SQL metadata database";
	} else {
	$output .= $error;
	print $logfile "\n".$error;
	}
	unless ($usebuffer) {
	$r->print($output);
	$output = '';
	}
}	}
# --------------------------------------------- Delete author resource messages	# --------------------------------------------- Delete author resource messages
my $delresult=&Apache::lonmsg::del_url_author_res_msg($target);	my $delresult=&Apache::lonmsg::del_url_author_res_msg($target);
$r->print('<p>'.&mt('Removing error messages:').' '.$delresult.'</p>');	$output .= '<p>'.&mt('Removing error messages:').' '.$delresult.'</p>';
	unless ($usebuffer) {
	$r->print($output);
	$output = '';
	}
print $logfile "\nRemoving error messages: $delresult";	print $logfile "\nRemoving error messages: $delresult";
# ----------------------------------------------------------- Copy old versions	# ----------------------------------------------------------- Copy old versions

Line 1544 sub phasetwo {	Line 1913 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;
$r->print(	$output .=
"<font color=\"red\">Invalid target directory, FAIL</font>");	"<span class=\"LC_error\">".&mt('Invalid target directory, FAIL')."</span>";
return 0;	if ($usebuffer) {
	if (wantarray) {
	return ($output,0);
	} else {
	return 0;
	}
	} else {
	$r->print($output);
	return 0;
	}
}	}
opendir(DIR,$srcd);	opendir(DIR,$srcd);
while ($filename=readdir(DIR)) {	while ($filename=readdir(DIR)) {
Line 1556 sub phasetwo {	Line 1935 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>');	$output .= '<p>'.&mt('Creating old version [_1]',$maxversion).'</p>';
	unless ($usebuffer) {
	$r->print($output);
	$output = '';
	}
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;

if (copy($target,$copyfile)) {	if (copy($target,$copyfile)) {
print $logfile "Copied old target to ".$copyfile."\n";	print $logfile "Copied old target to ".$copyfile."\n";
$r->print('<p>'.&mt('Copied old target file').'</p>');	$output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied old target file'));
	unless ($usebuffer) {
	$r->print($output);
	$output = '';
	}
} else {	} else {
print $logfile "Unable to write ".$copyfile.':'.$!."\n";	print $logfile "Unable to write ".$copyfile.':'.$!."\n";
$r->print("<font color=\"red\">".&mt('Failed to copy old target').	$output .= &Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1);
", $!, ".&mt('FAIL')."</font>");	if ($usebuffer) {
return 0;	if (wantarray) {
	return ($output,0);
	} else {
	return 0;
	}
	} else {
	$r->print($output);
	return 0;
	}
}	}

# --------------------------------------------------------------- Copy Metadata	# --------------------------------------------------------------- Copy Metadata
Line 1584 sub phasetwo {	Line 1979 sub phasetwo {

if (copy($target.'.meta',$copyfile)) {	if (copy($target.'.meta',$copyfile)) {
print $logfile "Copied old target metadata to ".$copyfile."\n";	print $logfile "Copied old target metadata to ".$copyfile."\n";
$r->print('<p>'.&mt('Copied old metadata').'</p>')	$output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata'));
	unless ($usebuffer) {
	$r->print($output);
	$output = '';
	}
} 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') {
$r->print(	$output .= &Apache::lonhtmlcommon::confirm_success(
"<font color=\"red\">".	&mt('Failed to write old metadata copy').", $!",1);
&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')."</font>");	if ($usebuffer) {
return 0;	if (wantarray) {
	return ($output,0);
	} else {
	return 0;
	}
	} else {
	$r->print($output);
	return 0;
	}
}	}
}	}


} else {	} else {
$r->print('<p>'.&mt('Initial version').'</p>');	$output .= '<p>'.&mt('Initial version').'</p>';
	unless ($usebuffer) {
	$r->print($output);
	$output = '';
	}
print $logfile "\nInitial version";	print $logfile "\nInitial version";
}	}

Line 1612 sub phasetwo {	Line 2021 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);
	$output .= '<p>'
	.&mt('Created directory [_1]'
	,'<span class="LC_filename">'.$parts[$count].'</span>')
	.'</p>';
	unless ($usebuffer) {
	$r->print($output);
	$output = '';
	}
}	}
}	}

if (copy($source,$copyfile)) {	if (copy($source,$copyfile)) {
print $logfile "\nCopied original source to ".$copyfile."\n";	print $logfile "\nCopied original source to ".$copyfile."\n";
$r->print('<p>'.&mt('Copied source file').'</p>');	$output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied source file'));
	unless ($usebuffer) {
	$r->print($output);
	$output = '';
	}
} else {	} else {
print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";	print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
$r->print("<font color=\"red\">".	$output .= &Apache::lonhtmlcommon::confirm_success(
&mt('Failed to copy source').", $!, ".&mt('FAIL')."</font>");	&mt('Failed to copy source').", $!",1);
return 0;	if ($usebuffer) {
	if (wantarray) {
	return ($output,0);
	} else {
	return 0;
	}
	} else {
	$r->print($output);
	return 0;
	}
}	}

	# ---------------------------------------------- Delete local tmp-preview files
	unlink($copyfile.'.tmp');
# --------------------------------------------------------------- Copy Metadata	# --------------------------------------------------------------- Copy Metadata

$copyfile=$copyfile.'.meta';	$copyfile=$copyfile.'.meta';

if (copy($source.'.meta',$copyfile)) {	if (copy($source.'.meta',$copyfile)) {
print $logfile "\nCopied original metadata to ".$copyfile."\n";	print $logfile "\nCopied original metadata to ".$copyfile."\n";
$r->print('<p>'.&mt('Copied metadata').'</p>');	$output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied metadata'));
	unless ($usebuffer) {
	$r->print($output);
	$output = '';
	}
} else {	} else {
print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";	print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
$r->print(	$output .= &Apache::lonhtmlcommon::confirm_success(
"<font color=\"red\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</font>");	&mt('Failed to write metadata copy').", $!",1);
return 0;	if ($usebuffer) {
	if (wantarray) {
	return ($output,0);
	} else {
	return 0;
	}
	} else {
	$r->print($output);
	return 0;
	}
	}
	unless ($usebuffer) {
	$r->rflush;
}	}
$r->rflush;

# ------------------------------------------------------------- Trigger updates	# ------------------------------------------------------------- Trigger updates
push(@{$modified_urls},[$target,$source]);	push(@{$modified_urls},[$target,$source]);
unless ($registered_cleanup) {	unless ($registered_cleanup) {
$r->register_cleanup(\&notify);	my $handlers = $r->get_handlers('PerlCleanupHandler');
	$r->set_handlers('PerlCleanupHandler' => [\&notify,@{$handlers}]);
$registered_cleanup=1;	$registered_cleanup=1;
}	}

Line 1656 sub phasetwo {	Line 2103 sub phasetwo {
&Apache::lonnet::devalidate_cache_new('meta',	&Apache::lonnet::devalidate_cache_new('meta',
&Apache::lonnet::declutter($thisdistarget));	&Apache::lonnet::declutter($thisdistarget));

	# ------------------------------------------------------------- Everything done
	$logfile->close();
	$output .= '<p class="LC_success">'.&mt('Done').'</p>';
	unless ($usebuffer) {
	$r->print($output);
	$output = '';
	}

# ------------------------------------------------ Provide link to new resource	# ------------------------------------------------ Provide link to new resource
unless ($batch) {	unless ($batch) {

my $thissrc=$source;	my $thissrc=&Apache::loncfile::url($source);
$thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/;

my $thissrcdir=$thissrc;	my $thissrcdir=$thissrc;
$thissrcdir=~s/\/[^\/]+$/\//;	$thissrcdir=~s/\/[^\/]+$/\//;

	$output .=
$r->print(	&Apache::lonhtmlcommon::actionbox([
'<hr /><a href="'.$thisdistarget.'"><font size="+2">'.	'<a href="'.$thisdistarget.'">'.
&mt('View Published Version').'</font></a>'.	&mt('View Published Version').
'<p><a href="'.$thissrc.'"><font size=+2>'.	'</a>',
&mt('Back to Source').'</font></a></p>'.	'<a href="'.$thissrc.'">'.
'<p><a href="'.$thissrcdir.	&mt('Back to Source').
'"><font size="+2">'.	'</a>',
&mt('Back to Source Directory').'</font></a></p>');	'<a href="'.$thissrcdir.'">'.
	&mt('Back to Source Directory').
	'</a>']);
	unless ($usebuffer) {
	$r->print($output);
	$output = '';
	}
	}

	if ($usebuffer) {
	if (wantarray) {
	return ($output,1);
	} else {
	return 1;
	}
	} else {
	if (wantarray) {
	return ('',1);
	} else {
	return 1;
	}
}	}
$logfile->close();
$r->print('<p><font color="green">'.&mt('Done').'</font></p>');
return 1;
}	}

# =============================================================== Notifications	# =============================================================== Notifications
Line 1704 sub notify {	Line 2174 sub notify {
# --------------------------------------------------- Notify subscribed courses	# --------------------------------------------------- Notify subscribed courses
my %courses=&coursedependencies($target);	my %courses=&coursedependencies($target);
my $now=time;	my $now=time;
foreach (keys %courses) {	foreach my $course (keys(%courses)) {
print $logfile "\nNotifying course ".$_.':';	print $logfile "\nNotifying course ".$course.':';
my ($cdom,$cname)=split(/\_/,$_);	my ($cdom,$cname)=split(/\_/,$course);
my $reply=&Apache::lonnet::cput	my $reply=&Apache::lonnet::cput
('versionupdate',{$target => $now},$cdom,$cname);	('versionupdate',{$target => $now},$cdom,$cname);
print $logfile $reply;	print $logfile $reply;
Line 1714 sub notify {	Line 2184 sub notify {
print $logfile "\n============ Done ============\n";	print $logfile "\n============ Done ============\n";
$logfile->close();	$logfile->close();
}	}
	if ($lock) { &Apache::lonnet::remove_lock($lock); }
return OK;	return OK;
}	}

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

sub batchpublish {	sub batchpublish {
my ($r,$srcfile,$targetfile)=@_;	my ($r,$srcfile,$targetfile,$nokeyref,$usebuffer)=@_;
#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;
$thisdisfn=~s/\/home\/korte\/public_html\///;
$srcfile=~s/\/+/\//g;

my $docroot=$r->dir_config('lonDocRoot');	my $docroot=$r->dir_config('lonDocRoot');
my $thisdistarget=$targetfile;	my $thisdistarget=$targetfile;
Line 1742 sub batchpublish {	Line 2210 sub batchpublish {

my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);	my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);

$r->print('<h2>'.&mt('Publishing').' <tt>'.$thisdisfn.'</tt></h2>');	my $output = '<h2>'
	.&mt('Publishing [_1]',&Apache::loncfile::display($srcfile))
	.'</h2>';
	unless ($usebuffer) {
	$r->print($output);
	$output = '';
	}

# phase one takes	# phase one takes
# my ($source,$target,$style,$batch)=@_;	# my ($source,$target,$style,$batch)=@_;
my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1);	my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1,$nokeyref);
$r->print('<p>'.$outstring.'</p>');
	if ($usebuffer) {
	$output .= '<p>'.$outstring.'</p>';
	} else {
	$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>');	if ($usebuffer) {
&phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);	my ($result,$error) = &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1,$usebuffer);
$r->print('</p>');	$output .= '<p>'.$result.'</p>';
	} else {
	&phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
	}
}	}
%env=%oldenv;	%env=%oldenv;
return '';	if ($usebuffer) {
	return $output;
	} else {
	return '';
	}
}	}

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

sub publishdirectory {	sub publishdirectory {
my ($r,$fn,$thisdisfn)=@_;	my ($r,$fn,$thisdisfn,$nokeyref)=@_;
$fn=~s/\/+/\//g;	$fn=~s/\/+/\//g;
$thisdisfn=~s/\/+/\//g;	$thisdisfn=~s/\/+/\//g;
my $resdir=	my $thisdisresdir=$thisdisfn;
$Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'.	$thisdisresdir=~s/^\/priv\//\/res\//;
$thisdisfn;	my $resdir = $r->dir_config('lonDocRoot').$thisdisresdir;
$r->print('<h1>'.&mt('Directory').' <tt>'.$thisdisfn.'</tt></h1>'.	$r->print('<form name="pubdirpref" method="post" action="">'
&mt('Target').': <tt>'.$resdir.'</tt><br />');	.&Apache::lonhtmlcommon::start_pick_box()
	.&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">'.$thisdisresdir.'</span>'
	);
	my %reasons = &Apache::lonlocal::texthash(
	mod => 'Authoring Space file postdates published file',
	modmeta => 'Authoring Space metadata file postdates published file',
	unpub => 'Resource is unpublished',
	);

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') {	unless ($env{'form.phase'} eq 'two') {
# ask user what they want	# ask user what they want
$r->print('<form name="pubdirpref" method="post">'.	$r->print(&Apache::lonhtmlcommon::row_closure()
&hiddenfield('phase','two').	.&Apache::lonhtmlcommon::row_title(&mt('Options')
	.&Apache::loncommon::help_open_topic('Publishing_Directory_Options')));
	$r->print(&hiddenfield('phase','two').
&hiddenfield('filename',$env{'form.filename'}).	&hiddenfield('filename',$env{'form.filename'}).
&checkbox('pubrec','include subdirectories').	'<fieldset><legend>'.&mt('Recurse').'</legend>'.
&checkbox('forcerepub','force republication of previously published files').	&checkbox('pubrec','include subdirectories').
&checkbox('forceobsolete','make file(s) obsolete').	'</fieldset>'.
&checkbox('forceoverride','force directory level catalog information over existing').	'<fieldset><legend>'.&mt('Force').'</legend>'.
'<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');	&checkbox('forcerepub','force republication of previously published files').'<br />'.
	&checkbox('forceoverride','force directory level metadata over existing').
	'</fieldset>'.
	'<fieldset><legend>'.&mt('Exclude').'</legend>'.
	&checkbox('excludeunpub','exclude currently unpublished files').'<br />'.
	&checkbox('excludemod','exclude modified files').'<br />'.
	&checkbox('excludemodmeta','exclude files with modified metadata').
	'</fieldset>'.
	'<fieldset><legend>'.&mt('Actions').'</legend>'.
	&checkbox('obsolete','make file(s) obsolete').'<br />'.
	&common_access('dist',&mt('apply common copyright/distribution'),
	['default','domain','custom']).'<br />'.
	&common_access('source',&mt('apply common source availability'),
	['closed','open']).
	'</fieldset>'
	);
	$r->print(&Apache::lonhtmlcommon::row_closure(1)
	.&Apache::lonhtmlcommon::end_pick_box()
	.'<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>'
	);
	$lock=0;
} else {	} else {
	$r->print(&Apache::lonhtmlcommon::row_closure(1)
	.&Apache::lonhtmlcommon::end_pick_box()
	);
	my %commonaccess;
	map { $commonaccess{$_} = 1; } &Apache::loncommon::get_env_multiple('form.commonaccess');
	unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); }
# actually publish things	# actually publish things
opendir(DIR,$fn);	opendir(DIR,$fn);
my @files=sort(readdir(DIR));	my @files=sort(readdir(DIR));
Line 1797 sub publishdirectory {	Line 2322 sub publishdirectory {
if ($filename=~/\.(\w+)$/) { $extension=$1; }	if ($filename=~/\.(\w+)$/) { $extension=$1; }
if ($cmode&$dirptr) {	if ($cmode&$dirptr) {
if (($filename!~/^\./) && ($env{'form.pubrec'})) {	if (($filename!~/^\./) && ($env{'form.pubrec'})) {
&publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);	&publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename,$nokeyref);
}	}
} elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&	} elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {	($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
# find out publication status and/or exiting metadata	# find out publication status and/or existing metadata
my $publishthis=0;	my $publishthis=0;
	my $skipthis;
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,
Line 1810 sub publishdirectory {	Line 2336 sub publishdirectory {
$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;	if ($env{'form.excludemod'}) {
	$skipthis='mod';
	} else {
	$publishthis=1;
	}
}	}
	unless ($skipthis) {
	my $meta_cmtime = (stat($fn.'/'.$filename.'.meta'))[9];
	my $meta_rmtime = (stat($resdir.'/'.$filename.'.meta'))[9];
	if ( $meta_rmtime<$meta_cmtime ) {
	if ($env{'form.excludemodmeta'}) {
	$skipthis='modmeta';
	$publishthis=0;
	} else {
	$publishthis=1;
	}
	} else {
	unless (&Apache::loncommon::fileembstyle($extension) eq 'prv') {
	if ($commonaccess{'dist'}) {
	my ($currdist,$currdistfile,$currsourceavail);
	my $currdist = &Apache::lonnet::metadata($thisdisresdir.'/'.$filename,'copyright');
	if ($currdist eq 'custom') {
	$currdistfile = &Apache::lonnet::metadata($thisdisresdir.'/'.$filename,'customdistributionfile');
	}
	if ($env{'form.commondistselect'} eq 'custom') {
	if ($env{'form.commoncustomrights'} =~ m{^/res/.+\.rights$}) {
	if ($currdist eq 'custom') {
	unless ($env{'form.commoncustomrights'} eq $currdistfile) {
	$publishthis=1;
	}
	} else {
	$publishthis=1;
	}
	}
	} elsif ($env{'form.commondistselect'} =~ /^default\|domain\|public$/) {
	unless ($currdist eq $env{'form.commondistselect'}) {
	$publishthis=1;
	}
	}
	}
	}
	}
	}
} else {	} else {
# never published	# never published
$publishthis=1;	if ($env{'form.excludeunpub'}) {
	$skipthis='unpub';
	} else {
	$publishthis=1;
	}
}	}

if ($publishthis) {	if ($publishthis) {
&batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);	&batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename,$nokeyref);
} else {	} else {
$r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');	my $reason;
	if ($skipthis) {
	$reason = $reasons{$skipthis};
	} else {
	$reason = &mt('No changes needed to published resource or metadata');
	}
	$r->print('<br />'.&mt('Skipping').' '.$filename);
	if ($reason) {
	$r->print(' ('.$reason.')');
	}
	$r->print('<br />');
}	}
$r->rflush();	$r->rflush();
}	}
Line 1833 sub publishdirectory {	Line 2415 sub publishdirectory {

sub defaultmetapublish {	sub defaultmetapublish {
my ($r,$fn,$cuname,$cudom)=@_;	my ($r,$fn,$cuname,$cudom)=@_;
$fn=~s/^\/\~$cuname\//\/home\/$cuname\/public_html\//;
unless (-e $fn) {	unless (-e $fn) {
return HTTP_NOT_FOUND;	return HTTP_NOT_FOUND;
}	}
my $target=$fn;	my $target=$fn;
$target=~s/^\/home\/$cuname\/public_html\//$Apache::lonnet::perlvar{'lonDocRoot'}\/res\/$cudom\/$cuname\//;	$target=~s/^\Q$Apache::lonnet::perlvar{'lonDocRoot'}\E\/priv\//\Q$Apache::lonnet::perlvar{'lonDocRoot'}\E\/res\//;


&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 1857 sub defaultmetapublish {	Line 2437 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 1878 sub defaultmetapublish {	Line 2462 sub defaultmetapublish {
$r->print($reply.'</p><br />');$r->rflush;	$r->print($reply.'</p><br />');$r->rflush;
}	}
# ------------------------------------------------------------------- Link back	# ------------------------------------------------------------------- Link back
my $link=$fn;	$r->print("<a href='".&Apache::loncfile::display($fn)."'>".&mt('Back to Metadata').'</a>');
$link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//;	$r->print(&Apache::loncommon::end_page());
$r->print("<a href='$link'>".&mt('Back to Catalog Information').'</a>');
$r->print('</body></html>');
return OK;	return OK;
}	}
#########################################	#########################################
Line 1943 sub handler {	Line 2525 sub handler {
@{$modified_urls}=();	@{$modified_urls}=();
# -------------------------------------------------------------- Check filename	# -------------------------------------------------------------- Check filename

my $fn=&Apache::lonnet::unescape($env{'form.filename'});	my $fn=&unescape($env{'form.filename'});
	($cuname,$cudom)=&Apache::lonnet::constructaccess($fn);
	# ----------------------------------------------------- Do we have permissions?
	unless (($cuname) && ($cudom)) {
	$r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
	' trying to publish file '.$env{'form.filename'}.
	' - not authorized',
	$r->filename);
	return HTTP_NOT_ACCEPTABLE;
	}
	# ----------------------------------------------------------------- Get docroot
	$docroot=$r->dir_config('lonDocRoot');

($cuname,$cudom)=
&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));

# special publication: default.meta file	# special publication: default.meta file
if ($fn=~/\/default.meta$/) {	if ($fn=~/\/default.meta$/) {
return &defaultmetapublish($r,$fn,$cuname,$cudom);	return &defaultmetapublish($r,$fn,$cuname,$cudom);
}	}
$fn=~s/\.meta$//;	$fn=~s/\.meta$//;

	# sanity test on the filename

unless ($fn) {	unless ($fn) {
$r->log_reason($cuname.' at '.$cudom.	$r->log_reason($cuname.' at '.$cudom.
' trying to publish empty filename', $r->filename);	' trying to publish empty filename', $r->filename);
return HTTP_NOT_FOUND;	return HTTP_NOT_FOUND;
}	}

unless (($cuname) && ($cudom)) {	unless (-e $docroot.$fn) {
$r->log_reason($cuname.' at '.$cudom.
' trying to publish file '.$env{'form.filename'}.
' ('.$fn.') - not authorized',
$r->filename);
return HTTP_NOT_ACCEPTABLE;
}

my $home=&Apache::lonnet::homeserver($cuname,$cudom);
my $allowed=0;
my @ids=&Apache::lonnet::current_machine_ids();
foreach my $id (@ids) { if ($id eq $home) { $allowed = 1; } }
unless ($allowed) {
$r->log_reason($cuname.' at '.$cudom.
' trying to publish file '.$env{'form.filename'}.
' ('.$fn.') - not homeserver ('.$home.')',
$r->filename);
return HTTP_NOT_ACCEPTABLE;
}

$fn=~s/^http\:\/\/[^\/]+//;
$fn=~s/^\/\~(\w+)/\/home\/$1\/public_html/;

my $targetdir='';
$docroot=$r->dir_config('lonDocRoot');
if ($1 ne $cuname) {
$r->log_reason($cuname.' at '.$cudom.
' trying to publish unowned file '.
$env{'form.filename'}.' ('.$fn.')',
$r->filename);
return HTTP_NOT_ACCEPTABLE;
} else {
$targetdir=$docroot.'/res/'.$cudom;
}


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.')',
Line 2004 sub handler {	Line 2561 sub handler {
return HTTP_NOT_FOUND;	return HTTP_NOT_FOUND;
}	}

unless ($env{'form.phase'} eq 'two') {	# --------------------------------- File is there and owned, start page output

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

%addid=();

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

%nokey=();

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

}

# ---------------------------------------------------------- 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;

my $js=&Apache::loncommon::browser_and_searcher_javascript();	# Breadcrumbs
$r->print('<html><head><title>LON-CAPA Publishing</title>	&Apache::lonhtmlcommon::clear_breadcrumbs();
<script type="text/javascript">'.$js.'	&Apache::lonhtmlcommon::add_breadcrumb({
</script></head>');	'text' => 'Authoring Space',
$r->print(&Apache::loncommon::bodytag('Resource Publication'));	'href' => &Apache::loncommon::authorspace($fn),
	});
	&Apache::lonhtmlcommon::add_breadcrumb({
my $thisfn=$fn;	'text' => 'Resource Publication',
	'href' => '',
my $thistarget=$thisfn;	});

$thistarget=~s/^\/home/$targetdir/;	my $js='<script type="text/javascript">'.
$thistarget=~s/\/public\_html//;	&Apache::loncommon::browser_and_searcher_javascript().
	'</script>';
	my $startargs = {};
	if ($fn=~/\/$/) {
	unless ($env{'form.phase'} eq 'two') {
	$startargs->{'add_entries'} = { onload => 'javascript:setDefaultAccess();' };
	$js .= <<"END";
	<script type="text/javascript">
	// <![CDATA[
	function showHideAccess(caller,div) {
	if (document.getElementById(div)) {
	if (caller.checked) {
	document.getElementById(div).style.display='inline-block';
	} else {
	document.getElementById(div).style.display='none';
	}
	}
	}

my $thisdistarget=$thistarget;	function showHideCustom(caller,divid) {
$thisdistarget=~s/^\Q$docroot\E//;	if (document.getElementById(divid)) {
	if (caller.options[caller.selectedIndex].value == 'custom') {
	document.getElementById(divid).style.display="inline-block";
	} else {
	document.getElementById(divid).style.display="none";
	}
	}
	}
	function setDefaultAccess() {
	var chkids = Array('LC_commondist','LC_commonsource');
	for (var i=0; i<chkids.length; i++) {
	if (document.getElementById(chkids[i])) {
	document.getElementById(chkids[i]).checked = false;
	}
	if (document.getElementById(chkids[i]+'select')) {
	document.getElementById(chkids[i]+'select').selectedIndex = 0;
	}
	if (document.getElementById(chkids[i]+'div')) {
	document.getElementById(chkids[i]+'div').style.display = 'none';
	}
	}
	}
	// ]]>
	</script>

my $thisdisfn=$thisfn;	END
$thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///;	}
	}
	$r->print(&Apache::loncommon::start_page('Resource Publication',$js,$startargs)
	.&Apache::lonhtmlcommon::breadcrumbs()
	.&Apache::loncommon::head_subbox(
	&Apache::loncommon::CSTR_pageheader($docroot.$fn))
	);

	my $thisdisfn=&HTML::Entities::encode($fn,'<>&"');
	my $thistarget=$fn;
	$thistarget=~s/^\/priv\//\/res\//;
	my $thisdistarget=&HTML::Entities::encode($thistarget,'<>&"');
	my $nokeyref = &getnokey($r->dir_config('lonIncludes'));

if ($fn=~/\/$/) {	if ($fn=~/\/$/) {
# -------------------------------------------------------- This is a directory	# -------------------------------------------------------- This is a directory
&publishdirectory($r,$fn,$thisdisfn);	&publishdirectory($r,$docroot.$fn,$thisdisfn,$nokeyref);
$r->print('<hr /><a href="/priv/'	$r->print(
.$cuname.'/'.$thisdisfn	'<br /><br />'.
.'">'.&mt('Return to Directory').'</a>');	&Apache::lonhtmlcommon::actionbox([
	'<a href="'.$thisdisfn.'">'.&mt('Return to Directory').'</a>']));

} else {	} else {
# ---------------------- Evaluate individual file, and then output information.	# ---------------------- Evaluate individual file, and then output information.
$thisfn=~/\.(\w+)$/;	$fn=~/\.(\w+)$/;
my $thistype=$1;	my $thistype=$1;
my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);	my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
if ($thistype eq 'page') { $thisembstyle = 'rat'; }	if ($thistype eq 'page') { $thisembstyle = 'rat'; }
$r->print('<h2>'.&mt('Publishing').' '.
&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("$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()
	);

	$r->print(&Apache::lonhtmlcommon::row_title(&mt('Target'))
	.'<tt>'.$thisdistarget.'</tt>'
	);
if (($cuname ne $env{'user.name'})\|\|($cudom ne $env{'user.domain'})) {	if (($cuname ne $env{'user.name'})\|\|($cudom ne $env{'user.domain'})) {
$r->print('<h3><font color="red">'.&mt('Co-Author').': '.	$r->print(&Apache::lonhtmlcommon::row_closure()
$cuname.&mt(' at ').$cudom.'</font></h3>');	.&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=$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 $fn to $thistarget with $thisembstyle.

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

return OK;	return OK;
}	}

	BEGIN {

	# ----------------------------------- Read addid.tab
	unless ($readit) {
	%addid=();

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


1;	1;
__END__	__END__

Line 2126 __END__	Line 2756 __END__

=back	=back

=back

=cut	=cut

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

Removed from v.1.201
changed lines
	Added in v.1.299