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.265 and 1.303

version 1.265, 2009/12/03 17:23:00	version 1.303, 2023/07/14 22:19:22
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 121 use HTML::LCParser;	Line 119 use HTML::LCParser;
use HTML::Entities;	use HTML::Entities;
use Encode::Encoder;	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();
Line 131 use Apache::lonlocal;	Line 128 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);	use LONCAPA qw(:DEFAULT :match);


my %addid;
my %nokey;

my $docroot;	my $docroot;

my $cuname;	my $cuname;
Line 150 my $lock;	Line 143 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 201 sub metaeval {	Line 196 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 266 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 '<div><b>'	return '<p class="LC_warning">'
.&mt('No file: [_1]'	.&mt('No file: [_1]',&Apache::loncfile::display($fn))
,'</b> <tt>'.&Apache::loncfile::display($fn).'</tt></div>');	.'</p>';
}	}
print($logfile 'Processing '.$fn."\n");	print($logfile 'Processing '.$fn."\n");
my $metastring;	my $metastring;
Line 277 sub metaread {	Line 272 sub metaread {
$metastring=join('',<$metafh>);	$metastring=join('',<$metafh>);
}	}
&metaeval($metastring,$prefix);	&metaeval($metastring,$prefix);
return '<div><b>'	return '<p class="LC_info">'
.&mt('Processed file: [_1]'	.&mt('Processed file: [_1]',&Apache::loncfile::display($fn))
,'</b> <tt>'.&Apache::loncfile::display($fn).'</tt></div>');	.'</p>';
}	}

#########################################	#########################################
Line 294 sub coursedependencies {	Line 289 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 319 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 330 string which presents the form field (fo	Line 329 string which presents the form field (fo
#########################################	#########################################
#########################################	#########################################
sub textfield {	sub textfield {
my ($title,$name,$value,$noline)=@_;	my ($title,$name,$value,$noline,$readonly)=@_;
$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 342 sub textfield {	Line 341 sub textfield {
}	}

sub text_with_browse_field {	sub text_with_browse_field {
my ($title,$name,$value,$restriction,$noline)=@_;	my ($title,$name,$value,$restriction,$noline,$readonly)=@_;
$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".&Apache::lonhtmlcommon::row_title($title)	my $disabled;
.'<input type="text" name="'.$name.'" size="80" value="'.$value.'" />'	if ($readonly) {
.'<br />'	$disabled = ' disabled="disabled"';
	}
	my $output =
	"\n".&Apache::lonhtmlcommon::row_title($title)
	.'<input type="text" name="'.$name.'" size="80" value="'.$value.'"'.$disabled.' />';
	unless ($readonly) {
	$output .=
	'<br />'
.'<a href="javascript:openbrowser(\'pubform\',\''.$name.'\',\''.$restriction.'\');">'	.'<a href="javascript:openbrowser(\'pubform\',\''.$name.'\',\''.$restriction.'\');">'
.&mt('Select')	.&mt('Select')
.'</a> '	.'</a> '
.'<a href="javascript:opensearcher(\'pubform\',\''.$name.'\');">'	.'<a href="javascript:opensearcher(\'pubform\',\''.$name.'\');">'
.&mt('Search')	.&mt('Search')
.'</a>'	.'</a>';
.&Apache::lonhtmlcommon::row_closure($noline);	}
	$output .= &Apache::lonhtmlcommon::row_closure($noline);
	return $output;
}	}

sub hiddenfield {	sub hiddenfield {
Line 368 sub hiddenfield {	Line 376 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>";
}	}

sub selectbox {	sub selectbox {
my ($title,$name,$value,$functionref,@idlist)=@_;	my ($title,$name,$value,$readonly,$functionref,@idlist)=@_;
$title=&mt($title);	$title=&mt($title);
$value=(split(/\s,\s/,$value))[-1];	$value=(split(/\s,\s/,$value))[-1];
if (defined($value)) {	if (defined($value)) {
Line 383 sub selectbox {	Line 391 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="selected"';	$selout.=' selected="selected"';
}	}
$selout.='>'.&{$functionref}($_).'</option>';	if ($readonly) {
	$selout .= ' disabled="disabled"';
	}
	$selout.='>'.&{$functionref}($id).'</option>';
}	}
$selout.='</select>'.&Apache::lonhtmlcommon::row_closure();	$selout.='</select>'.&Apache::lonhtmlcommon::row_closure();
return $selout;	return $selout;
Line 400 sub select_level_form {	Line 411 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 469 Currently undocumented	Line 532 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 481 sub set_allow {	Line 544 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 722 sub fix_ids_and_indices {	Line 790 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 781 sub fix_ids_and_indices {	Line 851 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 959 I<Additional documentation needed.>	Line 1114 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 1017 sub publish {	Line 1172 sub publish {
$outdep.= ' - <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 1051 sub publish {	Line 1211 sub publish {
$content=$outstring;	$content=$outstring;

}	}

	# ----------------------------------------------------- Course Authoring Space.
	my ($courseauthor,$crsaurights,$readonly);
	if ($env{'request.course.id'}) {
	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
	my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'};
	if ($source =~ m{^\Q$docroot/priv/$cdom/$cnum/\E}) {
	$courseauthor = $cnum.':'.$cdom;
	$crsaurights = "/res/$cdom/$cnum/default.rights";
	$readonly = 1;
	}
	}

# -------------------------------------------- Initial step done, now metadata.	# -------------------------------------------- Initial step done, now metadata.

# --------------------------------------- Storage for metadata keys and fields.	# --------------------------------------- Storage for metadata keys and fields.
Line 1080 sub publish {	Line 1254 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 1101 sub publish {	Line 1275 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 1112 sub publish {	Line 1286 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 1136 sub publish {	Line 1308 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 1154 sub publish {	Line 1326 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 1196 sub publish {	Line 1368 sub publish {
$textonly=~s/[^a-z^ü^ä^ö^ß\s]//g; #dont delete german "Umlaute"	$textonly=~s/[^a-z^ü^ä^ö^ß\s]//g; #dont delete german "Umlaute"

foreach ($textonly=~m/[^\s]+/g) { #match all but whitespaces	foreach ($textonly=~m/[^\s]+/g) { #match all but whitespaces
unless ($nokey{$_}) {	unless ($nokeyref->{$_}) {
$keywords{$_}=1;	$keywords{$_}=1;
}	}
}	}
Line 1228 sub publish {	Line 1400 sub publish {
.'</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 1339 END	Line 1511 END
$defaultlanguage =~ s/,\s*$//g;	$defaultlanguage =~ s/,\s*$//g;

$intr_scrout.=&selectbox('Language','language',	$intr_scrout.=&selectbox('Language','language',
$defaultlanguage,	$defaultlanguage,'',
\&Apache::loncommon::languagedescription,	\&Apache::loncommon::languagedescription,
(&Apache::loncommon::languageids),	(&Apache::loncommon::languageids),
);	);
Line 1356 END	Line 1528 END
if ($style eq 'prv') {	if ($style eq 'prv') {
$pubowner_last = 1;	$pubowner_last = 1;
}	}
	if ($courseauthor) {
	$metadatafields{'owner'} = $courseauthor;
	}
$intr_scrout.=&textfield('Publisher/Owner','owner',	$intr_scrout.=&textfield('Publisher/Owner','owner',
$metadatafields{'owner'},$pubowner_last);	$metadatafields{'owner'},$pubowner_last,$readonly);

# ---------------------------------------------- Retrofix for unused copyright	# ---------------------------------------------- Retrofix for unused copyright
if ($metadatafields{'copyright'} eq 'free') {	if ($metadatafields{'copyright'} eq 'free') {
Line 1370 END	Line 1545 END
# ------------------------------------------------ Dial in reasonable defaults	# ------------------------------------------------ Dial in reasonable defaults
my $defaultoption=$metadatafields{'copyright'};	my $defaultoption=$metadatafields{'copyright'};
unless ($defaultoption) { $defaultoption='default'; }	unless ($defaultoption) { $defaultoption='default'; }
	if ($courseauthor) {
	$defaultoption='custom';
	$metadatafields{'customdistributionfile'}=$crsaurights;
	}
my $defaultsourceoption=$metadatafields{'sourceavail'};	my $defaultsourceoption=$metadatafields{'sourceavail'};
unless ($defaultsourceoption) { $defaultsourceoption='closed'; }	unless ($defaultsourceoption) { $defaultsourceoption='closed'; }
unless ($style eq 'prv') {	unless ($style eq 'prv') {
Line 1381 END	Line 1560 END
$defaultoption='default';	$defaultoption='default';
}	}
$intr_scrout.=&selectbox('Copyright/Distribution','copyright',	$intr_scrout.=&selectbox('Copyright/Distribution','copyright',
$defaultoption,	$defaultoption,$readonly,
\&Apache::loncommon::copyrightdescription,	\&Apache::loncommon::copyrightdescription,
(grep !/^(public\|priv)$/,(&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,$readonly,
\&Apache::loncommon::copyrightdescription,	\&Apache::loncommon::copyrightdescription,
(grep !/^priv$/,(&Apache::loncommon::copyrightids)));	(grep !/^priv$/,(&Apache::loncommon::copyrightids)));
}	}
Line 1395 END	Line 1574 END
my $replace=&mt('Copyright/Distribution:');	my $replace=&mt('Copyright/Distribution:');
$intr_scrout =~ s/$replace/$replace.' '.$copyright_help/ge;	$intr_scrout =~ s/$replace/$replace.' '.$copyright_help/ge;

$intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights');	$intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights','',$readonly);
$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');
Line 1447 END	Line 1626 END
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 1469 Parameters:	Line 1660 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 1487 Returns:	Line 1688 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('<span class="LC_error">'.	$output = '<span class="LC_error">'.
&mt('Unsupported character combination [_1] in filename, FAIL.',"<tt>'.$1.'</tt>").	&mt('Unsupported character combination [_1] in filename, FAIL.',"<tt>'.$1.'</tt>").
'</span>');	'</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('<span class="LC_error">'.&mt('No valid extension found in filename, FAIL').'</span>');	$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('<span class="LC_error">'.&mt('Filename of resource contains internal version number. Cannot publish such resources, FAIL').'</span>');	$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 1516 sub phasetwo {	Line 1745 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">'.
'<span class="LC_error">'.	&mt('No write permission to user directory, FAIL').'</span>';
&mt('No write permission to user directory, FAIL').'</span>');	if ($usebuffer) {
return 0;	if (wantarray) {
	return ($output,0);
	} else {
	return 0;
	}
	} else {
	return 0;
	}
}	}

if ($source =~ /\.rights$/) {	if ($source =~ /\.rights$/) {
$r->print('<p><span class="LC_warning">'.&mt('Warning: It can take up to 1 hour for rights changes to fully propagate.').'</span></p>');	$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
Line 1533 sub phasetwo {	Line 1773 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 1559 sub phasetwo {	Line 1825 sub phasetwo {
$env{'user.domain'};	$env{'user.domain'};
$metadatafields{'authorspace'}=$cuname.':'.$cudom;	$metadatafields{'authorspace'}=$cuname.':'.$cudom;
$metadatafields{'domain'}=$cudom;	$metadatafields{'domain'}=$cudom;

	my $crsauthor;
	if ($env{'request.course.id'}) {
	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
	if ($distarget =~ m{^/res/$cdom/$cnum}) {
	$crsauthor = 1;
	my $default_rights = "/res/$cdom/$cnum/default.rights";
	unless ($distarget eq $default_rights) {
	$metadatafields{'copyright'} = 'custom';
	$metadatafields{'customdistributionfile'} = $default_rights;
	}
	}
	}

my $allkeywords=$env{'form.addkey'};	my $allkeywords=$env{'form.addkey'};
if (exists($env{'form.keywords'})) {	if (exists($env{'form.keywords'})) {
if (ref($env{'form.keywords'})) {	if (ref($env{'form.keywords'})) {
Line 1579 sub phasetwo {	Line 1859 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').
'<span class="LC_error">'.&mt('No valid custom distribution rights file specified, FAIL').	'</span>';
'</span>');	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').
'<span class="LC_error">'.&mt('Could not write metadata, FAIL').	'</span>';
'</span>');	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 1620 sub phasetwo {	Line 1921 sub phasetwo {
$metadatafields{'url'} = $distarget;	$metadatafields{'url'} = $distarget;
$metadatafields{'version'} = 'current';	$metadatafields{'version'} = 'current';

my ($error,$success) = &store_metadata(%metadatafields);	unless ($crsauthor) {
if ($success) {	my ($error,$success) = &store_metadata(%metadatafields);
$r->print('<p>'.&mt('Synchronized SQL metadata database').'</p>');	if ($success) {
print $logfile "\nSynchronized SQL metadata database";	$output .= '<p>'.&mt('Synchronized SQL metadata database').'</p>';
} else {	print $logfile "\nSynchronized SQL metadata database";
$r->print($error);	} else {
print $logfile "\n".$error;	$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 1644 sub phasetwo {	Line 1955 sub phasetwo {
my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'};	my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'};
unless ($srcd=~/^\Q$docroot\E\/res/) {	unless ($srcd=~/^\Q$docroot\E\/res/) {
print $logfile "\nPANIC: Target dir is ".$srcd;	print $logfile "\nPANIC: Target dir is ".$srcd;
$r->print(	$output .=
"<span class=\"LC_error\">".&mt('Invalid target directory, FAIL')."</span>");	"<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 1661 sub phasetwo {	Line 1981 sub phasetwo {
}	}
closedir(DIR);	closedir(DIR);
$maxversion++;	$maxversion++;
$r->print('<p>'.&mt('Creating old version [_1]',$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(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old target file')));	$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(&Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1));	$output .= &Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1);
return 0;	if ($usebuffer) {
	if (wantarray) {
	return ($output,0);
	} else {
	return 0;
	}
	} else {
	$r->print($output);
	return 0;
	}
}	}

# --------------------------------------------------------------- Copy Metadata	# --------------------------------------------------------------- Copy Metadata
Line 1681 sub phasetwo {	Line 2018 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(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata')));	$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(&Apache::lonhtmlcommon::confirm_success(	$output .= &Apache::lonhtmlcommon::confirm_success(
&mt('Failed to write old metadata copy').", $!",1));	&mt('Failed to write old metadata copy').", $!",1);
return 0;	if ($usebuffer) {
	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 1709 sub phasetwo {	Line 2061 sub phasetwo {
if ((-e $path)!=1) {	if ((-e $path)!=1) {
print $logfile "\nCreating directory ".$path;	print $logfile "\nCreating directory ".$path;
mkdir($path,0777);	mkdir($path,0777);
$r->print('<p>'	$output .= '<p>'
.&mt('Created directory [_1]'	.&mt('Created directory [_1]'
,'<span class="LC_filename">'.$parts[$count].'</span>')	,'<span class="LC_filename">'.$parts[$count].'</span>')
.'</p>'	.'</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(&Apache::lonhtmlcommon::confirm_success(&mt('Copied source file')));	$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(&Apache::lonhtmlcommon::confirm_success(	$output .= &Apache::lonhtmlcommon::confirm_success(
&mt('Failed to copy source').", $!",1));	&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	# ---------------------------------------------- Delete local tmp-preview files
Line 1735 sub phasetwo {	Line 2103 sub phasetwo {

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(&Apache::lonhtmlcommon::confirm_success(&mt('Copied metadata')));	$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(&Apache::lonhtmlcommon::confirm_success(	$output .= &Apache::lonhtmlcommon::confirm_success(
&mt('Failed to write metadata copy').", $!",1));	&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]);
Line 1761 sub phasetwo {	Line 2144 sub phasetwo {

# ------------------------------------------------------------- Everything done	# ------------------------------------------------------------- Everything done
$logfile->close();	$logfile->close();
$r->print('<p class="LC_success">'.&mt('Done').'</p>');	$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;
$thissrc=~s{^/home/($match_username)/public_html}{/priv/$1};

	my $thissrc=&Apache::loncfile::url($source);
my $thissrcdir=$thissrc;	my $thissrcdir=$thissrc;
$thissrcdir=~s/\/[^\/]+$/\//;	$thissrcdir=~s/\/[^\/]+$/\//;

$r->print(&Apache::loncommon::head_subbox(	$output .=
&Apache::lonhtmlcommon::start_funclist().	&Apache::lonhtmlcommon::actionbox([
&Apache::lonhtmlcommon::add_item_funclist(
'<a href="'.$thisdistarget.'">'.	'<a href="'.$thisdistarget.'">'.
&mt('View Published Version').	&mt('View Published Version').
'</a>').	'</a>',
&Apache::lonhtmlcommon::add_item_funclist(
'<a href="'.$thissrc.'">'.	'<a href="'.$thissrc.'">'.
&mt('Back to Source').	&mt('Back to Source').
'</a>').	'</a>',
&Apache::lonhtmlcommon::add_item_funclist(
'<a href="'.$thissrcdir.'">'.	'<a href="'.$thissrcdir.'">'.
&mt('Back to Source Directory').	&mt('Back to Source Directory').
'</a>').	'</a>']);
&Apache::lonhtmlcommon::end_funclist())	unless ($usebuffer) {
);	$r->print($output);
	$output = '';
	}
	}

	if ($usebuffer) {
	if (wantarray) {
	return ($output,1);
	} else {
	return 1;
	}
	} else {
	if (wantarray) {
	return ('',1);
	} else {
	return 1;
	}
}	}
return 1;
}	}

# =============================================================== Notifications	# =============================================================== Notifications
Line 1815 sub notify {	Line 2213 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 1832 sub notify {	Line 2230 sub notify {
#########################################	#########################################

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 1854 sub batchpublish {	Line 2249 sub batchpublish {

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

$r->print('<h2>'	my $output = '<h2>'
.&mt('Publishing [_1]'	.&mt('Publishing [_1]',&Apache::loncfile::display($srcfile))
,'<span class="LC_filename">'.$thisdisfn.'</span>')	.'</h2>';
.'</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,$crsauthor)=@_;
$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(&Apache::lonhtmlcommon::start_pick_box()	$r->print('<form name="pubdirpref" method="post" action="">'
	.&Apache::lonhtmlcommon::start_pick_box()
.&Apache::lonhtmlcommon::row_title(&mt('Directory'))	.&Apache::lonhtmlcommon::row_title(&mt('Directory'))
.'<span class="LC_filename">'.$thisdisfn.'</span>'	.'<span class="LC_filename">'.$thisdisfn.'</span>'
.&Apache::lonhtmlcommon::row_closure()	.&Apache::lonhtmlcommon::row_closure()
.&Apache::lonhtmlcommon::row_title(&mt('Target'))	.&Apache::lonhtmlcommon::row_title(&mt('Target'))
.'<span class="LC_filename">'.$resdir.'</span>'	.'<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(&Apache::lonhtmlcommon::row_closure()	$r->print(&Apache::lonhtmlcommon::row_closure()
.&Apache::lonhtmlcommon::row_title(&mt('Options'))	.&Apache::lonhtmlcommon::row_title(&mt('Options')
);	.&Apache::loncommon::help_open_topic('Publishing_Directory_Options')));
$r->print('<form name="pubdirpref" method="post">'.	$r->print(&hiddenfield('phase','two').
&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('obsolete','make file(s) obsolete').	'</fieldset>'.
&checkbox('forceoverride','force directory level metadata 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 />');
	unless ($crsauthor) {
	$r->print(&common_access('dist',&mt('apply common copyright/distribution'),
	['default','domain','public','custom']).'<br />');
	}
	$r->print(&common_access('source',&mt('apply common source availability'),
	['closed','open']).
	'</fieldset>'
	);
$r->print(&Apache::lonhtmlcommon::row_closure(1)	$r->print(&Apache::lonhtmlcommon::row_closure(1)
.&Apache::lonhtmlcommon::end_pick_box()	.&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)	$r->print(&Apache::lonhtmlcommon::row_closure(1)
.&Apache::lonhtmlcommon::end_pick_box()	.&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)); }	unless ($lock) { $lock=&Apache::lonnet::set_lock(&mt('Publishing [_1]',$fn)); }
# actually publish things	# actually publish things
opendir(DIR,$fn);	opendir(DIR,$fn);
Line 1929 sub publishdirectory {	Line 2363 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,$crsauthor);
}	}
} 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 1942 sub publishdirectory {	Line 2377 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';
my $meta_cmtime = (stat($fn.'/'.$filename.'.meta'))[9];	} else {
my $meta_rmtime = (stat($resdir.'/'.$filename.'.meta'))[9];	$publishthis=1;
if ( $meta_rmtime<$meta_cmtime ) {	}
$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 1971 sub publishdirectory {	Line 2456 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');
Line 2019 sub defaultmetapublish {	Line 2503 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 Metadata').'</a>');
$r->print(&Apache::loncommon::end_page());	$r->print(&Apache::loncommon::end_page());
return OK;	return OK;
}	}
Line 2085 sub handler {	Line 2567 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 2145 sub handler {	Line 2602 sub handler {
return HTTP_NOT_FOUND;	return HTTP_NOT_FOUND;
}	}

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

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

# Breadcrumbs	# Breadcrumbs
&Apache::lonhtmlcommon::clear_breadcrumbs();	&Apache::lonhtmlcommon::clear_breadcrumbs();
	my $crumbtext = 'Authoring Space';
	my $crumbhref = &Apache::loncommon::authorspace($fn);
	my $crsauthor;
	if ($env{'request.course.id'}) {
	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
	if ($crumbhref eq "/priv/$cdom/$cnum/") {
	$crumbtext = 'Course Authoring Space';
	$crsauthor = 1;
	}
	}
&Apache::lonhtmlcommon::add_breadcrumb({	&Apache::lonhtmlcommon::add_breadcrumb({
'text' => 'Construction Space',	'text' => $crumbtext,
'href' => &Apache::loncommon::authorspace(),	'href' => $crumbhref,
});	});
&Apache::lonhtmlcommon::add_breadcrumb({	&Apache::lonhtmlcommon::add_breadcrumb({
'text' => 'Resource Publication',	'text' => 'Resource Publication',
Line 2186 sub handler {	Line 2632 sub handler {
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') {
	$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';
	}
	}
	}

	function showHideCustom(caller,divid) {
	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>

	END
	}
	}
	$r->print(&Apache::loncommon::start_page('Resource Publication',$js,$startargs)
.&Apache::lonhtmlcommon::breadcrumbs()	.&Apache::lonhtmlcommon::breadcrumbs()
.&Apache::loncommon::head_subbox(	.&Apache::loncommon::head_subbox(
&Apache::loncommon::CSTR_pageheader()) # FIXME crumbs broken?	&Apache::loncommon::CSTR_pageheader($docroot.$fn))
);	);

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

my $thisdistarget=$thistarget;
$thisdistarget=~s/^\Q$docroot\E//;

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

if ($fn=~/\/$/) {	if ($fn=~/\/$/) {
# -------------------------------------------------------- This is a directory	# -------------------------------------------------------- This is a directory
&publishdirectory($r,$fn,$thisdisfn);	&publishdirectory($r,$docroot.$fn,$thisdisfn,$nokeyref,$crsauthor);
$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'; }
Line 2240 sub handler {	Line 2723 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 2263 ENDCAPTION	Line 2746 ENDCAPTION
$r->print(&Apache::lonhtmlcommon::row_closure()	$r->print(&Apache::lonhtmlcommon::row_closure()
.&Apache::lonhtmlcommon::row_title(&mt('Diffs')));	.&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>');
}	}
Line 2272 ENDDIFF	Line 2755 ENDDIFF
.&Apache::lonhtmlcommon::end_pick_box()	.&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($outstring);	$r->print($outstring);
} else {	} else {
$r->print('<h3 class="LC_error">'.	$r->print('<h3 class="LC_error">'.
Line 2290 ENDDIFF	Line 2773 ENDDIFF
'</h3>');	'</h3>');
}	}
} else {	} else {
&phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget);	my ($output,$error) = &phasetwo($r,$docroot.$fn,$docroot.$thistarget,
	$thisembstyle,$thisdistarget);
	$r->print($output);
}	}
}	}
$r->print(&Apache::loncommon::end_page());	$r->print(&Apache::loncommon::end_page());
Line 2298 ENDDIFF	Line 2783 ENDDIFF
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 2305 __END__	Line 2808 __END__

=back	=back

=back

=cut	=cut

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

Removed from v.1.265
changed lines
	Added in v.1.303