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.281 and 1.302

version 1.281, 2013/01/15 18:21:31	version 1.302, 2023/07/14 20:16:04
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 130 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 149 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 200 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 293 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 318 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 329 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 341 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 367 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 382 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 399 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 468 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 480 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 721 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 780 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 958 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 1055 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 1105 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 1116 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'}; }
if ($metadatafields{$_}) { $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 1140 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 1158 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 1200 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 1239 sub publish {	Line 1407 sub publish {
&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 1343 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 1360 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 1374 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 1385 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 1399 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 1451 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 1473 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 1491 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 1520 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 1537 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 1563 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 1583 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 1624 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 1648 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 1665 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 1685 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 1713 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 1739 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 1765 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) {
Line 1774 sub phasetwo {	Line 2157 sub phasetwo {
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 1818 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 1835 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;
$srcfile=~s/\/+/\//g;

my $docroot=$r->dir_config('lonDocRoot');	my $docroot=$r->dir_config('lonDocRoot');
my $thisdistarget=$targetfile;	my $thisdistarget=$targetfile;
Line 1855 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]',&Apache::loncfile::display($srcfile))	.&mt('Publishing [_1]',&Apache::loncfile::display($srcfile))
.'</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)=@_;
$fn=~s/\/+/\//g;	$fn=~s/\/+/\//g;
$thisdisfn=~s/\/+/\//g;	$thisdisfn=~s/\/+/\//g;
my $thisdisresdir=$thisdisfn;	my $thisdisresdir=$thisdisfn;
$thisdisresdir=~s/^\/priv\//\/res\//;	$thisdisresdir=~s/^\/priv\//\/res\//;
my $resdir = $r->dir_config('lonDocRoot').$thisdisresdir;	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">'.$thisdisresdir.'</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 />'.
	&common_access('dist',&mt('apply common copyright/distribution'),
	['default','domain','public','custom']).'<br />'.
	&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 2361 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,$docroot.$fn.'/'.$filename,$thisdisfn.'/'.$filename);	&publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename,$nokeyref);
}	}
} elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&	} elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {	($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
# find out publication status and/or exiting metadata	# find out publication status and/or existing metadata
my $publishthis=0;	my $publishthis=0;
	my $skipthis;
if (-e $resdir.'/'.$filename) {	if (-e $resdir.'/'.$filename) {
my ($rdev,$rino,$rmode,$rnlink,	my ($rdev,$rino,$rmode,$rnlink,
$ruid,$rgid,$rrdev,$rsize,	$ruid,$rgid,$rrdev,$rsize,
Line 1942 sub publishdirectory {	Line 2375 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 2117 sub handler {	Line 2600 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);
	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';
	}
	}
&Apache::lonhtmlcommon::add_breadcrumb({	&Apache::lonhtmlcommon::add_breadcrumb({
'text' => 'Construction Space',	'text' => $crumbtext,
'href' => &Apache::loncommon::authorspace($fn),	'href' => $crumbhref,
});	});
&Apache::lonhtmlcommon::add_breadcrumb({	&Apache::lonhtmlcommon::add_breadcrumb({
'text' => 'Resource Publication',	'text' => 'Resource Publication',
Line 2158 sub handler {	Line 2628 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($docroot.$fn))	&Apache::loncommon::CSTR_pageheader($docroot.$fn))
Line 2168 sub handler {	Line 2684 sub handler {
my $thistarget=$fn;	my $thistarget=$fn;
$thistarget=~s/^\/priv\//\/res\//;	$thistarget=~s/^\/priv\//\/res\//;
my $thisdistarget=&HTML::Entities::encode($thistarget,'<>&"');	my $thisdistarget=&HTML::Entities::encode($thistarget,'<>&"');
	my $nokeyref = &getnokey($r->dir_config('lonIncludes'));

if ($fn=~/\/$/) {	if ($fn=~/\/$/) {
# -------------------------------------------------------- This is a directory	# -------------------------------------------------------- This is a directory
&publishdirectory($r,$docroot.$fn,$thisdisfn);	&publishdirectory($r,$docroot.$fn,$thisdisfn,$nokeyref);
$r->print('<hr /><a href="'.$thisdisfn.'">'.&mt('Return to Directory').'</a>');	$r->print(
	'<br /><br />'.
	&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.
$fn=~/\.(\w+)$/;	$fn=~/\.(\w+)$/;
Line 2222 ENDCAPTION	Line 2742 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=$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 2241 ENDDIFF	Line 2761 ENDDIFF
}	}
unless ($errorcount) {	unless ($errorcount) {
my ($outstring,$error)=	my ($outstring,$error)=
&publish($docroot.$fn,$docroot.$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 2249 ENDDIFF	Line 2769 ENDDIFF
'</h3>');	'</h3>');
}	}
} else {	} else {
&phasetwo($r,$docroot.$fn,$docroot.$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 2257 ENDDIFF	Line 2779 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 2264 __END__	Line 2804 __END__

=back	=back

=back

=cut	=cut

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

Removed from v.1.281
changed lines
	Added in v.1.302