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.239 and 1.295

version 1.239, 2008/06/30 18:10:24	version 1.295, 2016/03/22 16:41:10
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;
Line 147 my $lock;	Line 147 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 198 sub metaeval {	Line 200 sub metaeval {
if (defined($token->[2]->{'name'})) {	if (defined($token->[2]->{'name'})) {
$unikey.="\0".$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 263 sub metaread {	Line 265 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 273 sub metaread {	Line 276 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><br />';	.&mt('Processed file: [_1]',&Apache::loncfile::display($fn))
	.'</p>';
}	}

#########################################	#########################################
Line 289 sub coursedependencies {	Line 293 sub coursedependencies {
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 314 string which presents the form field (fo	Line 318 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 325 string which presents the form field (fo	Line 333 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;
Line 333 sub textfield {	Line 341 sub textfield {
$env{'form.'.$name}=$value;	$env{'form.'.$name}=$value;
return "\n".&Apache::lonhtmlcommon::row_title($title)	return "\n".&Apache::lonhtmlcommon::row_title($title)
.'<input type="text" name="'.$name.'" size="80" value="'.$value.'" />'	.'<input type="text" name="'.$name.'" size="80" value="'.$value.'" />'
.&Apache::lonhtmlcommon::row_closure();	.&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;
Line 352 sub text_with_browse_field {	Line 360 sub text_with_browse_field {
.'<a href="javascript:opensearcher(\'pubform\',\''.$name.'\');">'	.'<a href="javascript:opensearcher(\'pubform\',\''.$name.'\');">'
.&mt('Search')	.&mt('Search')
.'</a>'	.'</a>'
.&Apache::lonhtmlcommon::row_closure();	.&Apache::lonhtmlcommon::row_closure($noline);
}	}

sub hiddenfield {	sub hiddenfield {
Line 378 sub selectbox {	Line 386 sub selectbox {
}	}
my $selout="\n".&Apache::lonhtmlcommon::row_title($title)	my $selout="\n".&Apache::lonhtmlcommon::row_title($title)
.'<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>';
}	}
$selout.='</select>'.&Apache::lonhtmlcommon::row_closure();	$selout.='</select>'.&Apache::lonhtmlcommon::row_closure();
return $selout;	return $selout;
Line 395 sub select_level_form {	Line 403 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";
	<br />
	<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 464 Currently undocumented	Line 525 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 476 sub set_allow {	Line 537 sub set_allow {
($newurl !~ /^mailto:/i) &&	($newurl !~ /^mailto:/i) &&
($newurl !~ /^(?:http\|https\|ftp):/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 690 sub fix_ids_and_indices {	Line 756 sub fix_ids_and_indices {
$responsecounter=0;	$responsecounter=0;
}	}
if ($lctag=~/response$/) { $responsecounter++; }	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 716 sub fix_ids_and_indices {	Line 783 sub fix_ids_and_indices {
foreach my $type ('src','href','background','bgimg') {	foreach my $type ('src','href','background','bgimg') {
foreach my $key (keys(%parms)) {	foreach my $key (keys(%parms)) {
if ($key =~ /^$type$/i) {	if ($key =~ /^$type$/i) {
	next if (($lctag eq 'img') && ($type eq 'src') &&
	($parms{$key} =~ m{^data\:image/gif;base64,}));
$parms{$key}=&set_allow(\%allow,$logfile,	$parms{$key}=&set_allow(\%allow,$logfile,
$target,$tag,	$target,$tag,
$parms{$key});	$parms{$key},$type);
}	}
}	}
}	}
Line 775 sub fix_ids_and_indices {	Line 844 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' \|\| $lctag eq 'answer'	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') {
Line 842 sub store_metadata {	Line 996 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='<span class="LC_error">WARNING: Cannot connect to '.	$error='<span class="LC_error">'
'database!</span>';	.&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 ='<span class="LC_error">WARNING: The metadata table does not '.	$error ='<span class="LC_error">'
'exist in the LON-CAPA database.</span>';	.&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);
}	}
Line 865 sub store_metadata {	Line 1021 sub store_metadata {
\%metadata);	\%metadata);
}	}
if (defined($status) && $status ne '') {	if (defined($status) && $status ne '') {
$error='<span class="LC_error">Error occured saving new values in '.	$error='<span class="LC_error">'
'metadata table in LON-CAPA database</span>';	.&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);
Line 886 sub checkonthis {	Line 1043 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" /><span class="LC_error"><b>'.	$r->print('<ul>');
$errorcount.' '.	if ($warningcount) {
&mt('error(s)').'</b></span> ');	$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 935 backup copies, performs any automatic pr	Line 1096 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 978 sub publish {	Line 1139 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 my $thisdep (sort(keys(%allow))) {	foreach my $thisdep (sort(keys(%allow))) {
if ($thisdep !~ /[^\s]/) { next; }	if ($thisdep !~ /[^\s]/) { next; }
if ($thisdep =~/\$/) {	if ($thisdep =~/\$/) {
$scrout.='<br /><span class="LC_warning">'	$outdep.='<div class="LC_warning">'
.&mt('The resource depends on another resource with variable filename, i.e., [_1].','<tt>'.$thisdep.'</tt>').'<br />'	.&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>')	.&mt('You likely need to explicitly allow access to all possible dependencies using the [_1]-tag.','<tt><allow></tt>')
.'</span><br />';	."</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.= ' - <span class="LC_error">'.&mt('Currently not available').	$outdep.= ' - <span class="LC_error">'.&mt('Currently not available').
'</span>';	'</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);
Line 1014 sub publish {	Line 1180 sub publish {
}	}
}	}
}	}
	$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 1043 sub publish {	Line 1215 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 1061 sub publish {	Line 1233 sub publish {
# ------------------------------------------------ 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 1082 sub publish {	Line 1254 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 1093 sub publish {	Line 1265 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 1117 sub publish {	Line 1287 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}) {
my $disp_key = $_;	my $disp_key = $field;
$disp_key =~ tr/\0/_/;	$disp_key =~ tr/\0/_/;
print $logfile ('New: '.$disp_key."\n");	print $logfile ('New: '.$disp_key."\n");
$chparms .= $disp_key.' ';	$chparms .= $disp_key.' ';
Line 1135 sub publish {	Line 1305 sub publish {
}	}

$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+$/)) {
my $disp_key = $_;	my $disp_key = $olditem;
$disp_key =~ tr/\0/_/;	$disp_key =~ tr/\0/_/;
print $logfile ('Obsolete: '.$disp_key."\n");	print $logfile ('Obsolete: '.$disp_key."\n");
$chparms.=$disp_key.' ';	$chparms.=$disp_key.' ';
Line 1147 sub publish {	Line 1317 sub publish {
}	}
}	}
if ($chparms) {	if ($chparms) {
$scrout.='<p><b>'.&mt('Obsolete parameters or saved values').':</b> '.	$scrout.='<p><b>'.&mt('Obsolete parameters or saved values').':</b> '
$chparms.'</p><h1><span class="LC_warning">'.&mt('Warning!').	.$chparms.'</p>'
'</span></h1><p><span class="LC_warning">'.	.'<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.').'</span></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') {	if ($metadatafields{'copyright'} eq 'priv') {
$scrout.='</p><h1><span class="LC_warning">'.&mt('Warning!').	$scrout.='<p class="LC_warning"><b>'.&mt('Warning!').'</b><br />'
'</span></h1><p><span class="LC_warning">'.	.&mt('Copyright/distribution option "Private" is no longer supported. Select another option from below. Consider "Custom Rights" for maximum control over the usage of your resource.')
&mt('Copyright/distribution option "Private" is no longer supported. Select another option from below. Consider "Custom Rights" for maximum control over the usage of your resource.').'</span></p><hr />';	.'</p><hr />';
}	}

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

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

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

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


	}

foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {	foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {
$addkey=~s/\s+/ /g;	$addkey=~s/\s+/ /g;
Line 1198 sub publish {	Line 1374 sub publish {
my $intr_scrout.='<br />'	my $intr_scrout.='<br />'
.'<form name="pubform" action="/adm/publish" method="post">';	.'<form name="pubform" action="/adm/publish" method="post">';
unless ($env{'form.makeobsolete'}) {	unless ($env{'form.makeobsolete'}) {
$intr_scrout.='<p>'	$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.')	.&mt('Searching for your resource will be based on the following metadata. Please provide as much data as possible.')
.'</p>'	.'</p>'
.'<p><input type="submit" value="'	.'<p><input type="submit" value="'
.&mt('Finalize Publication')	.&mt('Finalize Publication')
.'" /></p>';	.'" /> <a href="'.&Apache::loncfile::url($source).'">'.&mt('Cancel').'</a></p>';
}	}
$intr_scrout.=&Apache::lonhtmlcommon::start_pick_box();	$intr_scrout.=&Apache::lonhtmlcommon::start_pick_box();
$intr_scrout.=	$intr_scrout.=
&hiddenfield('phase','two').	&hiddenfield('phase','two').
&hiddenfield('filename',$env{'form.filename'}).	&hiddenfield('filename',$env{'form.filename'}).
&hiddenfield('allmeta',&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 1237 END	Line 1413 END
.'<input type="button" value="'.&mt('check all').'" onclick="javascript:checkAll(document.pubform.keywords)" />'	.'<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)" />'	.'<input type="button" value="'.&mt('uncheck all').'" onclick="javascript:uncheckAll(document.pubform.keywords)" />'
.'</p><br />'	.'</p><br />'
.'<table border="2"><tr>';	.&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();	.&Apache::lonhtmlcommon::row_closure();

$intr_scrout.=$keywordout;	$intr_scrout.=$keywordout;
Line 1309 END	Line 1503 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') {
Line 1356 END	Line 1553 END
(&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');
my $obsolete_checked=($metadatafields{'obsolete'})?' checked="1" ':'';	my $obsolete_checked=($metadatafields{'obsolete'})?' checked="checked"':'';
$intr_scrout.="\n".&Apache::lonhtmlcommon::row_title($uctitle)	$intr_scrout.="\n".&Apache::lonhtmlcommon::row_title($uctitle)
.'<input type="checkbox" name="obsolete" '.$obsolete_checked.'/ >'	.'<input type="checkbox" name="obsolete"'.$obsolete_checked.' />'
.&Apache::lonhtmlcommon::row_closure(1);	.&Apache::lonhtmlcommon::row_closure(1);
$intr_scrout.=&text_with_browse_field('Suggested Replacement for Obsolete File',	$intr_scrout.=&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 1388 END	Line 1585 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	$scrout.=$intr_scrout
Line 1434 Returns:	Line 1631 Returns:
0: fail	0: fail
1: success	1: success

	=back

=cut	=cut

#'stupid emacs	#'stupid emacs
Line 1459 sub phasetwo {	Line 1658 sub phasetwo {
return 0;	return 0;
}	}
if ($target=~/\.(\d+)\.(\w+)$/) {	if ($target=~/\.(\d+)\.(\w+)$/) {
$r->print('<span class="LC_error">'.&mt('Cannot publish versioned resource, FAIL').'</span>');	$r->print('<span class="LC_error">'.&mt('Filename of resource contains internal version number. Cannot publish such resources, FAIL').'</span>');
return 0;	return 0;
}	}
}	}
Line 1487 sub phasetwo {	Line 1686 sub phasetwo {
%metadatakeys=();	%metadatakeys=();

&metaeval(&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 1548 sub phasetwo {	Line 1773 sub phasetwo {
'</span>');	'</span>');
return 0;	return 0;
}	}
foreach (sort keys %metadatafields) {	foreach my $field (sort(keys(%metadatafields))) {
unless ($_=~/\./) {	unless ($field=~/\./) {
my $unikey=$_;	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},'<>&"')
Line 1595 sub phasetwo {	Line 1820 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(	$r->print(
"<span class=\"LC_error\">".&mt('Invalid target directory, FAIL')."</span>");	"<span class=\"LC_error\">".&mt('Invalid target directory, FAIL')."</span>");
Line 1607 sub phasetwo {	Line 1833 sub phasetwo {
unlink($srcd.'/'.$filename);	unlink($srcd.'/'.$filename);
unlink($srcd.'/'.$filename.'.meta');	unlink($srcd.'/'.$filename.'.meta');
} else {	} else {
if ($filename=~/\Q$srcf\E\.(\d+)\.\Q$srct\E$/) {	if ($filename=~/^\Q$srcf\E\.(\d+)\.\Q$srct\E$/) {
$maxversion=($1>$maxversion)?$1:$maxversion;	$maxversion=($1>$maxversion)?$1:$maxversion;
}	}
}	}
}	}
closedir(DIR);	closedir(DIR);
$maxversion++;	$maxversion++;
$r->print('<p>Creating old version '.$maxversion.'</p>');	$r->print('<p>'.&mt('Creating old version [_1]',$maxversion).'</p>');
print $logfile "\nCreating old version ".$maxversion."\n";	print $logfile "\nCreating old version ".$maxversion."\n";

my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;	my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct;

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>');	$r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old target file')));
} else {	} else {
print $logfile "Unable to write ".$copyfile.':'.$!."\n";	print $logfile "Unable to write ".$copyfile.':'.$!."\n";
$r->print("<span class=\"LC_error\">".&mt('Failed to copy old target').	$r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1));
", $!, ".&mt('FAIL')."</span>");
return 0;	return 0;
}	}

Line 1635 sub phasetwo {	Line 1860 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>')	$r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata')));
} 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(	$r->print(&Apache::lonhtmlcommon::confirm_success(
"<span class=\"LC_error\">".	&mt('Failed to write old metadata copy').", $!",1));
&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')."</span>");
return 0;	return 0;
}	}
}	}
Line 1663 sub phasetwo {	Line 1887 sub phasetwo {
$path.="/$parts[$count]";	$path.="/$parts[$count]";
if ((-e $path)!=1) {	if ((-e $path)!=1) {
print $logfile "\nCreating directory ".$path;	print $logfile "\nCreating directory ".$path;
$r->print('<p>'.&mt('Created directory').' '.$parts[$count].'</p>');
mkdir($path,0777);	mkdir($path,0777);
	$r->print('<p>'
	.&mt('Created directory [_1]'
	,'<span class="LC_filename">'.$parts[$count].'</span>')
	.'</p>'
	);
}	}
}	}

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>');	$r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied source file')));
} else {	} else {
print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";	print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
$r->print("<span class=\"LC_error\">".	$r->print(&Apache::lonhtmlcommon::confirm_success(
&mt('Failed to copy source').", $!, ".&mt('FAIL')."</span>");	&mt('Failed to copy source').", $!",1));
return 0;	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>');	$r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied metadata')));
} else {	} else {
print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";	print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
$r->print(	$r->print(&Apache::lonhtmlcommon::confirm_success(
"<span class=\"LC_error\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</span>");	&mt('Failed to write metadata copy').", $!",1));
return 0;	return 0;
}	}
$r->rflush;	$r->rflush;
Line 1696 sub phasetwo {	Line 1926 sub phasetwo {
# ------------------------------------------------------------- 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 1707 sub phasetwo {	Line 1938 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();
	$r->print('<p class="LC_success">'.&mt('Done').'</p>');

# ------------------------------------------------ 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/($match_username)/public_html}{/priv/$1};

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


$r->print(	$r->print(
'<hr /><a href="'.$thisdistarget.'"><font size="+2">'.	&Apache::lonhtmlcommon::actionbox([
&mt('View Published Version').'</font></a>'.	'<a href="'.$thisdistarget.'">'.
'<p><a href="'.$thissrc.'"><font size="+2">'.	&mt('View Published Version').
&mt('Back to Source').'</font></a></p>'.	'</a>',
'<p><a href="'.$thissrcdir.	'<a href="'.$thissrc.'">'.
'"><font size="+2">'.	&mt('Back to Source').
&mt('Back to Source Directory').'</font></a></p>');	'</a>',
	'<a href="'.$thissrcdir.'">'.
	&mt('Back to Source Directory').
	'</a>'])
	);
}	}
$logfile->close();
$r->print('<p><font color="green">'.&mt('Done').'</font></p>');
return 1;	return 1;
}	}

Line 1755 sub notify {	Line 1989 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 1777 sub batchpublish {	Line 2011 sub batchpublish {
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;	$srcfile=~s/\/+/\//g;

my $docroot=$r->dir_config('lonDocRoot');	my $docroot=$r->dir_config('lonDocRoot');
Line 1794 sub batchpublish {	Line 2026 sub batchpublish {

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

$r->print('<h2>'.&mt('Publishing').' <tt>'.$thisdisfn.'</tt></h2>');	$r->print('<h2>'
	.&mt('Publishing [_1]',&Apache::loncfile::display($srcfile))
	.'</h2>'
	);

# phase one takes	# phase one takes
# my ($source,$target,$style,$batch)=@_;	# my ($source,$target,$style,$batch)=@_;
Line 1818 sub publishdirectory {	Line 2053 sub publishdirectory {
my ($r,$fn,$thisdisfn)=@_;	my ($r,$fn,$thisdisfn)=@_;
$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 $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'))
	);
	$r->print(&hiddenfield('phase','two').
&hiddenfield('filename',$env{'form.filename'}).	&hiddenfield('filename',$env{'form.filename'}).
&checkbox('pubrec','include subdirectories').	&checkbox('pubrec','include subdirectories').
&checkbox('forcerepub','force republication of previously published files').	&checkbox('forcerepub','force republication of previously published files').
&checkbox('obsolete','make file(s) obsolete').	&checkbox('obsolete','make file(s) obsolete').
&checkbox('forceoverride','force directory level catalog information over existing').	&checkbox('forceoverride','force directory level metadata over existing').
'<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');	&common_access('dist',&mt('apply common copyright/distribution'),
	['default','domain','custom']).
	&common_access('source',&mt('apply common source availability'),
	['closed','open'])
	);
	$r->print(&Apache::lonhtmlcommon::row_closure(1)
	.&Apache::lonhtmlcommon::end_pick_box()
	.'<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>'
	);
$lock=0;	$lock=0;
} else {	} else {
	$r->print(&Apache::lonhtmlcommon::row_closure(1)
	.&Apache::lonhtmlcommon::end_pick_box()
	);
unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); }	unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); }
# actually publish things	# actually publish things
opendir(DIR,$fn);	opendir(DIR,$fn);
Line 1893 sub publishdirectory {	Line 2147 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(&Apache::loncommon::start_page('Catalog Information Publication'));	$r->print(&Apache::loncommon::start_page('Metadata Publication'));

# ---------------------------------------------------------------- Write Source	# ---------------------------------------------------------------- Write Source
my $copyfile=$target;	my $copyfile=$target;
Line 1916 sub defaultmetapublish {	Line 2169 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>'
	);
}	}
}	}

Line 1937 sub defaultmetapublish {	Line 2194 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("<a href='$link'>".&mt('Back to Catalog Information').'</a>');
$r->print(&Apache::loncommon::end_page());	$r->print(&Apache::loncommon::end_page());
return OK;	return OK;
}	}
Line 2003 sub handler {	Line 2258 sub handler {
# -------------------------------------------------------------- Check filename	# -------------------------------------------------------------- Check filename

my $fn=&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{^/~($match_username)}{/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 2090 sub handler {	Line 2320 sub handler {
&Apache::loncommon::content_type($r,'text/html');	&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;	$r->send_http_header;

	# Breadcrumbs
	&Apache::lonhtmlcommon::clear_breadcrumbs();
	&Apache::lonhtmlcommon::add_breadcrumb({
	'text' => 'Authoring Space',
	'href' => &Apache::loncommon::authorspace($fn),
	});
	&Apache::lonhtmlcommon::add_breadcrumb({
	'text' => 'Resource Publication',
	'href' => '',
	});

my $js='<script type="text/javascript">'.	my $js='<script type="text/javascript">'.
&Apache::loncommon::browser_and_searcher_javascript().	&Apache::loncommon::browser_and_searcher_javascript().
'</script>';	'</script>';
$r->print(&Apache::loncommon::start_page('Resource Publication',$js));	my $startargs = {};
	if ($fn=~/\/$/) {
	unless ($env{'form.phase'} eq 'two') {
my $thisfn=$fn;	$startargs->{'add_entries'} = { onload => 'javascript:setDefaultAccess();' };
	$js .= <<"END";
my $thistarget=$thisfn;	<script type="text/javascript">
	// <![CDATA[
$thistarget=~s/^\/home/$targetdir/;	function showHideAccess(caller,div) {
$thistarget=~s/\/public\_html//;	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,'<>&"');

if ($fn=~/\/$/) {	if ($fn=~/\/$/) {
# -------------------------------------------------------- This is a directory	# -------------------------------------------------------- This is a directory
&publishdirectory($r,$fn,$thisdisfn);	&publishdirectory($r,$docroot.$fn,$thisdisfn);
$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 [_1]','<tt>'.$thisdisfn.'</tt>').'</h2>');	$r->print('<h2>'
	.&mt('Publishing [_1]'
	,'<span class="LC_filename">'.$thisdisfn.'</span>')
	.'</h2>'
	);

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

Line 2139 sub handler {	Line 2424 sub handler {
.'<tt>'	.'<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>'	$r->print('</tt>'
Line 2148 ENDCAPTION	Line 2433 ENDCAPTION

$r->print(&Apache::lonhtmlcommon::row_title(&mt('Target'))	$r->print(&Apache::lonhtmlcommon::row_title(&mt('Target'))
.'<tt>'.$thisdistarget.'</tt>'	.'<tt>'.$thisdistarget.'</tt>'
.&Apache::lonhtmlcommon::row_closure()
);	);

# SB - ToDo:
if (($cuname ne $env{'user.name'})\|\|($cudom ne $env{'user.domain'})) {	if (($cuname ne $env{'user.name'})\|\|($cudom ne $env{'user.domain'})) {
# $r->print(&Apache::lonhtmlcommon::row_title('<span class="LC_warning">'.&mt('Co-Author').'</span>')	$r->print(&Apache::lonhtmlcommon::row_closure()
$r->print(&Apache::lonhtmlcommon::row_title(&mt('Co-Author'))	.&Apache::lonhtmlcommon::row_title(&mt('Co-Author'))
.'<span class="LC_warning">'	.'<span class="LC_warning">'
.&mt('[_1] at [_2]',$cuname,$cudom)	.&Apache::loncommon::plainname($cuname,$cudom) .' ('.$cuname.':'.$cudom.')'
.'</span>'	.'</span>'
.&Apache::lonhtmlcommon::row_closure()
);	);
}	}

if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {	if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
$r->print(&Apache::lonhtmlcommon::row_title(&mt('Diffs')));	$r->print(&Apache::lonhtmlcommon::row_closure()
	.&Apache::lonhtmlcommon::row_title(&mt('Diffs')));
$r->print(<<ENDDIFF);	$r->print(<<ENDDIFF);
<a href='javascript:void(window.open("/adm/diff?filename=/~$cuname/$thisdisfn&versiontwo=priv","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>	<a href='javascript:void(window.open("/adm/diff?filename=$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>'	$r->print(&mt('Diffs with Current Version').'</a>');
.&Apache::lonhtmlcommon::row_closure()
);

}	}

$r->print(&Apache::lonhtmlcommon::end_pick_box());	$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);
$r->print('<hr />'.$outstring);	$r->print($outstring);
} else {	} else {
$r->print('<h3 class="LC_error">'.	$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);	&phasetwo($r,$docroot.$fn,$docroot.$thistarget,$thisembstyle,$thisdistarget);
$r->print('<hr />');
}	}
}	}
$r->print(&Apache::loncommon::end_page());	$r->print(&Apache::loncommon::end_page());
Line 2209 __END__	Line 2489 __END__

=back	=back

=back

=cut	=cut

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

Removed from v.1.239
changed lines
	Added in v.1.295