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.180 and 1.196

version 1.180, 2004/10/11 17:40:46	version 1.196, 2005/05/30 16:56:46
Line 121 use HTML::LCParser;	Line 121 use HTML::LCParser;
use Apache::lonxml;	use Apache::lonxml;
use Apache::loncacc;	use Apache::loncacc;
use DBI;	use DBI;
use Apache::lonnet();	use Apache::lonnet;
use Apache::loncommon();	use Apache::loncommon();
use Apache::lonmysql;	use Apache::lonmysql;
use Apache::lonlocal;	use Apache::lonlocal;
Line 138 my $docroot;	Line 138 my $docroot;
my $cuname;	my $cuname;
my $cudom;	my $cudom;

	my $registered_cleanup;
	my $modified_urls;

=pod	=pod

=item B<metaeval>	=item B<metaeval>
Line 323 sub textfield {	Line 326 sub textfield {
$value=~s/\s+$//gs;	$value=~s/\s+$//gs;
$value=~s/\s+/ /gs;	$value=~s/\s+/ /gs;
$title=&mt($title);	$title=&mt($title);
$ENV{'form.'.$name}=$value;	$env{'form.'.$name}=$value;
return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".	return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".
"</b></font></p><br />".	"</b></font></p><br />".
'<input type="text" name="'.$name.'" size=80 value="'.$value.'" />';	'<input type="text" name="'.$name.'" size=80 value="'.$value.'" />';
Line 335 sub text_with_browse_field {	Line 338 sub text_with_browse_field {
$value=~s/\s+$//gs;	$value=~s/\s+$//gs;
$value=~s/\s+/ /gs;	$value=~s/\s+/ /gs;
$title=&mt($title);	$title=&mt($title);
$ENV{'form.'.$name}=$value;	$env{'form.'.$name}=$value;
return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".	return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".
"</b></font></p><br />".	"</b></font></p><br />".
'<input type="text" name="'.$name.'" size=80 value="'.$value.'" />'.	'<input type="text" name="'.$name.'" size=80 value="'.$value.'" />'.
Line 346 sub text_with_browse_field {	Line 349 sub text_with_browse_field {

sub hiddenfield {	sub hiddenfield {
my ($name,$value)=@_;	my ($name,$value)=@_;
$ENV{'form.'.$name}=$value;	$env{'form.'.$name}=$value;
return "\n".'<input type="hidden" name="'.$name.'" value="'.$value.'" />';	return "\n".'<input type="hidden" name="'.$name.'" value="'.$value.'" />';
}	}

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

sub selectbox {	sub selectbox {
my ($title,$name,$value,$functionref,@idlist)=@_;	my ($title,$name,$value,$functionref,@idlist)=@_;
$title=&mt($title);	$title=&mt($title);
$value=(split(/\s,\s/,$value))[-1];	$value=(split(/\s,\s/,$value))[-1];
if (defined($value)) {	if (defined($value)) {
$ENV{'form.'.$name}=$value;	$env{'form.'.$name}=$value;
} else {	} else {
$ENV{'form.'.$name}=$idlist[0];	$env{'form.'.$name}=$idlist[0];
}	}
my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".	my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".
'</b></font></p><br /><select name="'.$name.'">';	'</b></font></p><br /><select name="'.$name.'">';
Line 373 sub selectbox {	Line 381 sub selectbox {

sub select_level_form {	sub select_level_form {
my ($value,$name)=@_;	my ($value,$name)=@_;
$ENV{'form.'.$name}=$value;	$env{'form.'.$name}=$value;
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);
}	}
#########################################	#########################################
Line 545 sub get_max_ids_indices {	Line 553 sub get_max_ids_indices {
my $counter;	my $counter;
if ($counter=$addid{$token->[1]}) {	if ($counter=$addid{$token->[1]}) {
if ($counter eq 'id') {	if ($counter eq 'id') {
if (defined($token->[2]->{'id'})) {	if (defined($token->[2]->{'id'}) &&
	$token->[2]->{'id'} !~ /^\s*$/) {
$maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;	$maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
if (exists($allids{$token->[2]->{'id'}})) {	if (exists($allids{$token->[2]->{'id'}})) {
$duplicateids=1;	$duplicateids=1;
Line 557 sub get_max_ids_indices {	Line 566 sub get_max_ids_indices {
$needsfixup=1;	$needsfixup=1;
}	}
} else {	} else {
if (defined($token->[2]->{'index'})) {	if (defined($token->[2]->{'index'}) &&
	$token->[2]->{'index'} !~ /^\s*$/) {
$maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;	$maxindex=($token->[2]->{'index'}>$maxindex)?$token->[2]->{'index'}:$maxindex;
} else {	} else {
$needsfixup=1;	$needsfixup=1;
Line 671 sub fix_ids_and_indices {	Line 681 sub fix_ids_and_indices {
if (!$counter) { $counter=$addid{$lctag}; }	if (!$counter) { $counter=$addid{$lctag}; }
if ($counter) {	if ($counter) {
if ($counter eq 'id') {	if ($counter eq 'id') {
unless (defined($parms{'id'})) {	unless (defined($parms{'id'}) &&
	$parms{'id'}!~/^\s*$/) {
$maxid++;	$maxid++;
$parms{'id'}=$maxid;	$parms{'id'}=$maxid;
print $logfile 'ID: '.$tag.':'.$maxid."\n";	print $logfile 'ID: '.$tag.':'.$maxid."\n";
}	}
} elsif ($counter eq 'index') {	} elsif ($counter eq 'index') {
unless (defined($parms{'index'})) {	unless (defined($parms{'index'}) &&
	$parms{'index'}!~/^\s*$/) {
$maxindex++;	$maxindex++;
$parms{'index'}=$maxindex;	$parms{'index'}=$maxindex;
print $logfile 'Index: '.$tag.':'.$maxindex."\n";	print $logfile 'Index: '.$tag.':'.$maxindex."\n";
Line 839 sub store_metadata {	Line 851 sub store_metadata {
}	}


	# ========================================== Parse file for errors and warnings

	sub checkonthis {
	my ($r,$source)=@_;
	my $uri=&Apache::lonnet::hreflocation($source);
	$uri=~s/\/$//;
	my $result=&Apache::lonnet::ssi_body($uri,
	('grade_target'=>'web',
	'return_only_error_and_warning_counts' => 1));
	my ($errorcount,$warningcount)=split(':',$result);
	if (($errorcount) \|\| ($warningcount)) {
	$r->print('<br /><tt>'.$uri.'</tt>: ');
	if ($errorcount) {
	$r->print('<img src="/adm/lonMisc/bomb.gif" /><font color="red"><b>'.
	$errorcount.' '.
	&mt('error(s)').'</b></font> ');
	}
	if ($warningcount) {
	$r->print('<font color="blue">'.
	$warningcount.' '.
	&mt('warning(s)').'</font>');
	}
	} else {
	#$r->print('<font color="green">'.&mt('ok').'</font>');
	}
	$r->rflush();
	return ($warningcount,$errorcount);
	}

# ============================================== Parse file itself for metadata	# ============================================== Parse file itself for metadata
#	#
# parses a file with target meta, sets global %metadatafields %metadatakeys	# parses a file with target meta, sets global %metadatafields %metadatakeys
Line 892 sub publish {	Line 933 sub publish {
return ('<font color="red">'.&mt('No write permission to user directory, FAIL').'</font>',1);	return ('<font color="red">'.&mt('No write permission to user directory, FAIL').'</font>',1);
}	}
print $logfile	print $logfile
"\n\n================= Publish ".localtime()." Phase One ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n";	"\n\n================= Publish ".localtime()." Phase One ================\n".$env{'user.name'}.'@'.$env{'user.domain'}."\n";

if (($style eq 'ssi') \|\| ($style eq 'rat') \|\| ($style eq 'prv')) {	if (($style eq 'ssi') \|\| ($style eq 'rat') \|\| ($style eq 'prv')) {
# ------------------------------------------------------- This needs processing	# ------------------------------------------------------- This needs processing
Line 979 sub publish {	Line 1020 sub publish {
}	}

# ------------------------------------------------ First, check out environment	# ------------------------------------------------ First, check out environment
unless (-e $source.'.meta') {	if ((!(-e $source.'.meta')) \|\| ($env{'form.forceoverride'})) {
$metadatafields{'author'}=$ENV{'environment.firstname'}.' '.	$metadatafields{'author'}=$env{'environment.firstname'}.' '.
$ENV{'environment.middlename'}.' '.	$env{'environment.middlename'}.' '.
$ENV{'environment.lastname'}.' '.	$env{'environment.lastname'}.' '.
$ENV{'environment.generation'};	$env{'environment.generation'};
$metadatafields{'author'}=~s/\s+/ /g;	$metadatafields{'author'}=~s/\s+/ /g;
$metadatafields{'author'}=~s/\s+$//;	$metadatafields{'author'}=~s/\s+$//;
$metadatafields{'owner'}=$cuname.'@'.$cudom;	$metadatafields{'owner'}=$cuname.'@'.$cudom;
Line 1004 sub publish {	Line 1045 sub publish {
$scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);	$scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);
$prefix=~s\|^\.\./\|\|;	$prefix=~s\|^\.\./\|\|;
}	}

# ----------------------------------------------------------- Parse file itself	# ----------------------------------------------------------- Parse file itself
# read %metadatafields from file itself	# read %metadatafields from file itself

Line 1028 sub publish {	Line 1070 sub publish {
delete $metadatafields{$_};	delete $metadatafields{$_};
}	}
}	}
	# ------------------------------------------------------------- Save some stuff
	my %savemeta=();
	foreach ('title') {
	$savemeta{$_}=$metadatafields{$_};
	}
# ------------------------------------------ See if anything new in file itself	# ------------------------------------------ See if anything new in file itself

$allmeta=&parseformeta($source,$style);	$allmeta=&parseformeta($source,$style);
	# ----------------------------------------------------------- Restore the stuff
	foreach (keys %savemeta) {
	$metadatafields{$_}=$savemeta{$_};
	}
}	}


Line 1104 sub publish {	Line 1154 sub publish {
# interactive mode html goes into $intr_scrout	# interactive mode html goes into $intr_scrout
# batch mode throws away this HTML	# batch mode throws away this HTML
# additionally all of the field functions have a by product of setting	# additionally all of the field functions have a by product of setting
# $ENV{'from.'..} so that it can be used by the phase two handler in	# $env{'from.'..} so that it can be used by the phase two handler in
# batch mode	# batch mode

my $intr_scrout.=	my $intr_scrout.=
'<form name="pubform" action="/adm/publish" method="post">'.	'<form name="pubform" action="/adm/publish" method="post">'.
'<p><input type="submit" value="'.&mt('Finalize Publication').'" /></p>'.	'<p>'.($env{'form.makeobsolete'}?'':'<input type="submit" value="'.&mt('Finalize Publication').'" />').'</p>'.
&hiddenfield('phase','two').	&hiddenfield('phase','two').
&hiddenfield('filename',$ENV{'form.filename'}).	&hiddenfield('filename',$env{'form.filename'}).
&hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).	&hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).
&hiddenfield('dependencies',join(',',keys %allow)).	&hiddenfield('dependencies',join(',',keys %allow));
	unless ($env{'form.makeobsolete'}) {
	$intr_scrout.=
&textfield('Title','title',$metadatafields{'title'}).	&textfield('Title','title',$metadatafields{'title'}).
&textfield('Author(s)','author',$metadatafields{'author'}).	&textfield('Author(s)','author',$metadatafields{'author'}).
&textfield('Subject','subject',$metadatafields{'subject'});	&textfield('Subject','subject',$metadatafields{'subject'});
	# --------------------------------------------------- Scan content for keywords
# --------------------------------------------------- Scan content for keywords

my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");	my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");
my $KEYWORDS=&mt('Keywords');	my $KEYWORDS=&mt('Keywords');
Line 1151 END	Line 1202 END
if ($metadatafields{'keywords'}) {	if ($metadatafields{'keywords'}) {
if ($metadatafields{'keywords'}=~/\Q$_\E/) {	if ($metadatafields{'keywords'}=~/\Q$_\E/) {
$keywordout.=' checked="on"';	$keywordout.=' checked="on"';
$ENV{'form.keywords'}.=$_.',';	$env{'form.keywords'}.=$_.',';
}	}
} elsif (&Apache::loncommon::keyword($_)) {	} elsif (&Apache::loncommon::keyword($_)) {
$keywordout.=' checked="on"';	$keywordout.=' checked="on"';
$ENV{'form.keywords'}.=$_.',';	$env{'form.keywords'}.=$_.',';
}	}
$keywordout.=' />'.$_.'</label></td>';	$keywordout.=' />'.$_.'</label></td>';
if ($colcount>10) {	if ($colcount>10) {
Line 1164 END	Line 1215 END
}	}
$colcount++;	$colcount++;
}	}
$ENV{'form.keywords'}=~s/\,$//;	$env{'form.keywords'}=~s/\,$//;

$keywordout.='</tr></table>';	$keywordout.='</tr></table>';

Line 1252 END	Line 1303 END
}	}
my $copyright_help =	my $copyright_help =
Apache::loncommon::help_open_topic('Publishing_Copyright');	Apache::loncommon::help_open_topic('Publishing_Copyright');
$intr_scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;	$intr_scrout =~ s/Distribution:/'Distribution: ' . $copyright_help/ge;
$intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights').$copyright_help;	$intr_scrout.=&text_with_browse_field('Custom Distribution File','customdistributionfile',$metadatafields{'customdistributionfile'},'rights').$copyright_help;
$intr_scrout.=&selectbox('Source Distribution','sourceavail',	$intr_scrout.=&selectbox('Source Distribution','sourceavail',
$defaultsourceoption,	$defaultsourceoption,
Line 1273 END	Line 1324 END
} else {	} else {
$intr_scrout.=&hiddenfield('copyright','private');	$intr_scrout.=&hiddenfield('copyright','private');
}	}
	} else {
	$intr_scrout.=
	&hiddenfield('title',$metadatafields{'title'}).
	&hiddenfield('author',$metadatafields{'author'}).
	&hiddenfield('subject',$metadatafields{'subject'}).
	&hiddenfield('keywords',$metadatafields{'keywords'}).
	&hiddenfield('abstract',$metadatafields{'abstract'}).
	&hiddenfield('notes',$metadatafields{'notes'}).
	&hiddenfield('mime',$metadatafields{'mime'}).
	&hiddenfield('creationdate',$metadatafields{'creationdate'}).
	&hiddenfield('lastrevisiondate',time).
	&hiddenfield('owner',$metadatafields{'owner'}).
	&hiddenfield('lowestgradelevel',$metadatafields{'lowestgradelevel'}).
	&hiddenfield('standards',$metadatafields{'standards'}).
	&hiddenfield('highestgradelevel',$metadatafields{'highestgradelevel'}).
	&hiddenfield('language',$metadatafields{'language'}).
	&hiddenfield('copyright',$metadatafields{'copyright'}).
	&hiddenfield('sourceavail',$metadatafields{'sourceavail'}).
	&hiddenfield('customdistributionfile',$metadatafields{'customdistributionfile'}).
	&hiddenfield('obsolete',1).
	&text_with_browse_field('Suggested Replacement for Obsolete File',
	'obsoletereplacement',
	$metadatafields{'obsoletereplacement'});
	}
if (!$batch) {	if (!$batch) {
$scrout.=$intr_scrout.'<p><input type="submit" value="'.	$scrout.=$intr_scrout.'<p><input type="submit" value="'.
&mt('Finalize Publication').'" /></p></form>';	&mt($env{'form.makeobsolete'}?'Make Obsolete':'Finalize Publication').'" /></p></form>';
}	}
return($scrout,0);	return($scrout,0);
}	}
Line 1323 sub phasetwo {	Line 1398 sub phasetwo {
my ($r,$source,$target,$style,$distarget,$batch)=@_;	my ($r,$source,$target,$style,$distarget,$batch)=@_;
$source=~s/\/+/\//g;	$source=~s/\/+/\//g;
$target=~s/\/+/\//g;	$target=~s/\/+/\//g;
	#
if ($target=~/\_\_\_/) {	# Unless trying to get rid of something, check name validity
$r->print(	#
'<font color="red">'.&mt('Unsupported character combination').	unless ($env{'form.obsolete'}) {
' "<tt>___</tt>" '.&mt('in filename, FAIL').'</font>');	if ($target=~/(\_\_\_\|\&\&\&\|\:\:\:)/) {
return 0;	$r->print(
	'<font color="red">'.&mt('Unsupported character combination').
	' "<tt>'.$1.'</tt>" '.&mt('in filename, FAIL').'</font>');
	return 0;
	}
	unless ($target=~/\.(\w+)$/) {
	$r->print('<font color="red">'.&mt('No valid extension found in filename, FAIL').'</font>');
	return 0;
	}
	if ($target=~/\.(\d+)\.(\w+)$/) {
	$r->print('<font color="red">'.&mt('Cannot publish versioned resource, FAIL').'</font>');
	return 0;
	}
}	}

	#
	# End name check
	#
$distarget=~s/\/+/\//g;	$distarget=~s/\/+/\//g;
my $logfile;	my $logfile;
unless ($logfile=Apache::File->new('>>'.$source.'.log')) {	unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
Line 1339 sub phasetwo {	Line 1430 sub phasetwo {
return 0;	return 0;
}	}
print $logfile	print $logfile
"\n================= Publish ".localtime()." Phase Two ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n";	"\n================= Publish ".localtime()." Phase Two ================\n".$env{'user.name'}.'@'.$env{'user.domain'}."\n";

%metadatafields=();	%metadatafields=();
%metadatakeys=();	%metadatakeys=();

&metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));	&metaeval(&Apache::lonnet::unescape($env{'form.allmeta'}));

$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'};
$metadatafields{'notes'}=$ENV{'form.notes'};	$metadatafields{'notes'}=$env{'form.notes'};
$metadatafields{'abstract'}=$ENV{'form.abstract'};	$metadatafields{'abstract'}=$env{'form.abstract'};
$metadatafields{'mime'}=$ENV{'form.mime'};	$metadatafields{'mime'}=$env{'form.mime'};
$metadatafields{'language'}=$ENV{'form.language'};	$metadatafields{'language'}=$env{'form.language'};
$metadatafields{'creationdate'}=$ENV{'form.creationdate'};	$metadatafields{'creationdate'}=$env{'form.creationdate'};
$metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};	$metadatafields{'lastrevisiondate'}=$env{'form.lastrevisiondate'};
$metadatafields{'owner'}=$ENV{'form.owner'};	$metadatafields{'owner'}=$env{'form.owner'};
$metadatafields{'copyright'}=$ENV{'form.copyright'};	$metadatafields{'copyright'}=$env{'form.copyright'};
$metadatafields{'standards'}=$ENV{'form.standards'};	$metadatafields{'standards'}=$env{'form.standards'};
$metadatafields{'lowestgradelevel'}=$ENV{'form.lowestgradelevel'};	$metadatafields{'lowestgradelevel'}=$env{'form.lowestgradelevel'};
$metadatafields{'highestgradelevel'}=$ENV{'form.highestgradelevel'};	$metadatafields{'highestgradelevel'}=$env{'form.highestgradelevel'};
$metadatafields{'customdistributionfile'}=	$metadatafields{'customdistributionfile'}=
$ENV{'form.customdistributionfile'};	$env{'form.customdistributionfile'};
$metadatafields{'sourceavail'}=$ENV{'form.sourceavail'};	$metadatafields{'sourceavail'}=$env{'form.sourceavail'};
$metadatafields{'obsolete'}=$ENV{'form.obsolete'};	$metadatafields{'obsolete'}=$env{'form.obsolete'};
$metadatafields{'obsoletereplacement'}=	$metadatafields{'obsoletereplacement'}=
$ENV{'form.obsoletereplacement'};	$env{'form.obsoletereplacement'};
$metadatafields{'dependencies'}=$ENV{'form.dependencies'};	$metadatafields{'dependencies'}=$env{'form.dependencies'};
$metadatafields{'modifyinguser'}=$ENV{'user.name'}.'@'.	$metadatafields{'modifyinguser'}=$env{'user.name'}.'@'.
$ENV{'user.domain'};	$env{'user.domain'};
$metadatafields{'authorspace'}=$cuname.'@'.$cudom;	$metadatafields{'authorspace'}=$cuname.'@'.$cudom;

my $allkeywords=$ENV{'form.addkey'};	my $allkeywords=$env{'form.addkey'};
if (exists($ENV{'form.keywords'})) {	if (exists($env{'form.keywords'})) {
if (ref($ENV{'form.keywords'})) {	if (ref($env{'form.keywords'})) {
$allkeywords .= ','.join(',',@{$ENV{'form.keywords'}});	$allkeywords .= ','.join(',',@{$env{'form.keywords'}});
} else {	} else {
$allkeywords .= ','.$ENV{'form.keywords'};	$allkeywords .= ','.$env{'form.keywords'};
}	}
}	}
$allkeywords=~s/[\"\']//g;	$allkeywords=~s/[\"\']//g;
Line 1541 sub phasetwo {	Line 1632 sub phasetwo {
"<font color=\"red\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</font>";	"<font color=\"red\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</font>";
}	}
$r->rflush;	$r->rflush;
# --------------------------------------------------- Send update notifications

my @subscribed=&get_subscribed_hosts($target);	# ------------------------------------------------------------- Trigger updates
foreach my $subhost (@subscribed) {	push(@{$modified_urls},[$target,$source]);
$r->print('<p>'.&mt('Notifying host').' '.$subhost.':');$r->rflush;	unless ($registered_cleanup) {
print $logfile "\nNotifying host ".$subhost.':';	$r->register_cleanup(\&notify);
my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);	$registered_cleanup=1;
$r->print($reply.'</p><br />');$r->rflush;
print $logfile $reply;
}

# ---------------------------------------- Send update notifications, meta only

my @subscribedmeta=&get_subscribed_hosts("$target.meta");
foreach my $subhost (@subscribedmeta) {
$r->print('<p>'.
&mt('Notifying host for metadata only').' '.$subhost.':');$r->rflush;
print $logfile "\nNotifying host for metadata only ".$subhost.':';
my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
$subhost);
$r->print($reply.'</p><br />');$r->rflush;
print $logfile $reply;
}

# --------------------------------------------------- Notify subscribed courses
my %courses=&coursedependencies($target);
my $now=time;
foreach (keys %courses) {
$r->print('<p>'.&mt('Notifying course').' '.$_.':');$r->rflush;
print $logfile "\nNotifying host ".$_.':';
my ($cdom,$cname)=split(/\_/,$_);
my $reply=&Apache::lonnet::cput
('versionupdate',{$target => $now},$cdom,$cname);
$r->print($reply.'</p><br />');$r->rflush;
print $logfile $reply;
}	}
# ------------------------------------------------ Provide link to new resource	# ------------------------------------------------ Provide link to new resource
unless ($batch) {	unless ($batch) {
Line 1598 sub phasetwo {	Line 1660 sub phasetwo {
'"><font size="+2">'.	'"><font size="+2">'.
&mt('Back to Source Directory').'</font></a></p>');	&mt('Back to Source Directory').'</font></a></p>');
}	}
	$logfile->close();
return '<p><font color="green">'.&mt('Done').'</font></p>';	return '<p><font color="green">'.&mt('Done').'</font></p>';
}	}

	# =============================================================== Notifications
	sub notify {
	# --------------------------------------------------- Send update notifications
	foreach my $targetsource (@{$modified_urls}){
	my ($target,$source)=@{$targetsource};
	my $logfile=Apache::File->new('>>'.$source.'.log');
	print $logfile "\nCleanup phase: Notifications\n";
	my @subscribed=&get_subscribed_hosts($target);
	foreach my $subhost (@subscribed) {
	print $logfile "\nNotifying host ".$subhost.':';
	my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
	print $logfile $reply;
	}
	# ---------------------------------------- Send update notifications, meta only
	my @subscribedmeta=&get_subscribed_hosts("$target.meta");
	foreach my $subhost (@subscribedmeta) {
	print $logfile "\nNotifying host for metadata only ".$subhost.':';
	my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
	$subhost);
	print $logfile $reply;
	}
	# --------------------------------------------------- Notify subscribed courses
	my %courses=&coursedependencies($target);
	my $now=time;
	foreach (keys %courses) {
	print $logfile "\nNotifying course ".$_.':';
	my ($cdom,$cname)=split(/\_/,$_);
	my $reply=&Apache::lonnet::cput
	('versionupdate',{$target => $now},$cdom,$cname);
	print $logfile $reply;
	}
	print $logfile "\n============ Done ============\n";
	$logfile->close();
	}
	return OK;
	}

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

sub batchpublish {	sub batchpublish {
my ($r,$srcfile,$targetfile)=@_;	my ($r,$srcfile,$targetfile)=@_;
#publication pollutes %ENV with form.* values	#publication pollutes %env with form.* values
my %oldENV=%ENV;	my %oldenv=%env;
$srcfile=~s/\/+/\//g;	$srcfile=~s/\/+/\//g;
$targetfile=~s/\/+/\//g;	$targetfile=~s/\/+/\//g;
my $thisdisfn=$srcfile;	my $thisdisfn=$srcfile;
Line 1634 sub batchpublish {	Line 1734 sub batchpublish {
$r->print('<p>'.$outstring.'</p>');	$r->print('<p>'.$outstring.'</p>');
# phase two takes	# phase two takes
# my ($source,$target,$style,$distarget,batch)=@_;	# my ($source,$target,$style,$distarget,batch)=@_;
# $ENV{'form.allmeta'},$ENV{'form.title'},$ENV{'form.author'},...	# $env{'form.allmeta'},$env{'form.title'},$env{'form.author'},...
if (!$error) {	if (!$error) {
$r->print('<p>');	$r->print('<p>');
&phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);	&phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
$r->print('</p>');	$r->print('</p>');
}	}
%ENV=%oldENV;	%env=%oldenv;
return '';	return '';
}	}

Line 1657 sub publishdirectory {	Line 1757 sub publishdirectory {
&mt('Target').': <tt>'.$resdir.'</tt><br />');	&mt('Target').': <tt>'.$resdir.'</tt><br />');

my $dirptr=16384; # Mask indicating a directory in stat.cmode.	my $dirptr=16384; # Mask indicating a directory in stat.cmode.
	unless ($env{'form.phase'} eq 'two') {
opendir(DIR,$fn);	# ask user what they want
my @files=sort(readdir(DIR));	$r->print('<form name="pubdirpref" method="post">'.
foreach my $filename (@files) {	&hiddenfield('phase','two').
my ($cdev,$cino,$cmode,$cnlink,	&hiddenfield('filename',$env{'form.filename'}).
$cuid,$cgid,$crdev,$csize,	&checkbox('pubrec','include subdirectories').
$catime,$cmtime,$cctime,	&checkbox('forcerepub','force republication of previously published files').
$cblksize,$cblocks)=stat($fn.'/'.$filename);	&checkbox('forceobsolete','make file(s) obsolete').
	&checkbox('forceoverride','force directory level catalog information over existing').
my $extension='';	'<br /><input type="submit" value="'.&mt('Publish Directory').'" /></form>');
if ($filename=~/\.(\w+)$/) { $extension=$1; }	} else {
if ($cmode&$dirptr) {	# actually publish things
if (($filename!~/^\./) && ($ENV{'form.pubrec'})) {	opendir(DIR,$fn);
&publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);	my @files=sort(readdir(DIR));
}	foreach my $filename (@files) {
} elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&	my ($cdev,$cino,$cmode,$cnlink,
($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {	$cuid,$cgid,$crdev,$csize,
	$catime,$cmtime,$cctime,
	$cblksize,$cblocks)=stat($fn.'/'.$filename);

	my $extension='';
	if ($filename=~/\.(\w+)$/) { $extension=$1; }
	if ($cmode&$dirptr) {
	if (($filename!~/^\./) && ($env{'form.pubrec'})) {
	&publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);
	}
	} elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
	($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
# find out publication status and/or exiting metadata	# find out publication status and/or exiting metadata
my $publishthis=0;	my $publishthis=0;
if (-e $resdir.'/'.$filename) {	if (-e $resdir.'/'.$filename) {
my ($rdev,$rino,$rmode,$rnlink,	my ($rdev,$rino,$rmode,$rnlink,
$ruid,$rgid,$rrdev,$rsize,	$ruid,$rgid,$rrdev,$rsize,
$ratime,$rmtime,$rctime,	$ratime,$rmtime,$rctime,
$rblksize,$rblocks)=stat($resdir.'/'.$filename);	$rblksize,$rblocks)=stat($resdir.'/'.$filename);
if (($rmtime<$cmtime) \|\| ($ENV{'form.forcerepub'})) {	if (($rmtime<$cmtime) \|\| ($env{'form.forcerepub'})) {
# previously published, modified now	# previously published, modified now
$publishthis=1;	$publishthis=1;
}	}
} else {	} else {
# never published	# never published
$publishthis=1;	$publishthis=1;
}	}
if ($publishthis) {	if ($publishthis) {
&batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);	&batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);
} else {	} else {
$r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');	$r->print('<br />'.&mt('Skipping').' '.$filename.'<br />');
	}
	$r->rflush();
}	}
$r->rflush();
}	}
	closedir(DIR);
}	}
closedir(DIR);
}	}

#########################################	#########################################
Line 1810 sub handler {	Line 1922 sub handler {
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},	&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['filename']);	['filename']);

	# -------------------------------------- Flag and buffer for registered cleanup
	$registered_cleanup=0;
	@{$modified_urls}=();
# -------------------------------------------------------------- Check filename	# -------------------------------------------------------------- Check filename

my $fn=&Apache::lonnet::unescape($ENV{'form.filename'});	my $fn=&Apache::lonnet::unescape($env{'form.filename'});

($cuname,$cudom)=	($cuname,$cudom)=
&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));	&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
Line 1831 sub handler {	Line 1946 sub handler {

unless (($cuname) && ($cudom)) {	unless (($cuname) && ($cudom)) {
$r->log_reason($cuname.' at '.$cudom.	$r->log_reason($cuname.' at '.$cudom.
' trying to publish file '.$ENV{'form.filename'}.	' trying to publish file '.$env{'form.filename'}.
' ('.$fn.') - not authorized',	' ('.$fn.') - not authorized',
$r->filename);	$r->filename);
return HTTP_NOT_ACCEPTABLE;	return HTTP_NOT_ACCEPTABLE;
Line 1843 sub handler {	Line 1958 sub handler {
foreach my $id (@ids) { if ($id eq $home) { $allowed = 1; } }	foreach my $id (@ids) { if ($id eq $home) { $allowed = 1; } }
unless ($allowed) {	unless ($allowed) {
$r->log_reason($cuname.' at '.$cudom.	$r->log_reason($cuname.' at '.$cudom.
' trying to publish file '.$ENV{'form.filename'}.	' trying to publish file '.$env{'form.filename'}.
' ('.$fn.') - not homeserver ('.$home.')',	' ('.$fn.') - not homeserver ('.$home.')',
$r->filename);	$r->filename);
return HTTP_NOT_ACCEPTABLE;	return HTTP_NOT_ACCEPTABLE;
Line 1857 sub handler {	Line 1972 sub handler {
if ($1 ne $cuname) {	if ($1 ne $cuname) {
$r->log_reason($cuname.' at '.$cudom.	$r->log_reason($cuname.' at '.$cudom.
' trying to publish unowned file '.	' trying to publish unowned file '.
$ENV{'form.filename'}.' ('.$fn.')',	$env{'form.filename'}.' ('.$fn.')',
$r->filename);	$r->filename);
return HTTP_NOT_ACCEPTABLE;	return HTTP_NOT_ACCEPTABLE;
} else {	} else {
Line 1868 sub handler {	Line 1983 sub handler {
unless (-e $fn) {	unless (-e $fn) {
$r->log_reason($cuname.' at '.$cudom.	$r->log_reason($cuname.' at '.$cudom.
' trying to publish non-existing file '.	' trying to publish non-existing file '.
$ENV{'form.filename'}.' ('.$fn.')',	$env{'form.filename'}.' ('.$fn.')',
$r->filename);	$r->filename);
return HTTP_NOT_FOUND;	return HTTP_NOT_FOUND;
}	}

unless ($ENV{'form.phase'} eq 'two') {	unless ($env{'form.phase'} eq 'two') {

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

Line 1927 sub handler {	Line 2042 sub handler {
if ($fn=~/\/$/) {	if ($fn=~/\/$/) {
# -------------------------------------------------------- This is a directory	# -------------------------------------------------------- This is a directory
&publishdirectory($r,$fn,$thisdisfn);	&publishdirectory($r,$fn,$thisdisfn);
$r->print('<hr><font size="+2">'.&mt('Done').'</font><br><a href="/priv/'	$r->print('<hr /><a href="/priv/'
.$cuname.'/'.$thisdisfn	.$cuname.'/'.$thisdisfn
.'">'.&mt('Return to Directory').'</a>');	.'">'.&mt('Return to Directory').'</a>');

Line 1947 ENDCAPTION	Line 2062 ENDCAPTION
$r->print('</tt></h2><b>'.&mt('Target').':</b> <tt>'.	$r->print('</tt></h2><b>'.&mt('Target').':</b> <tt>'.
$thisdistarget.'</tt><br />');	$thisdistarget.'</tt><br />');

if (($cuname ne $ENV{'user.name'})\|\|($cudom ne $ENV{'user.domain'})) {	if (($cuname ne $env{'user.name'})\|\|($cudom ne $env{'user.domain'})) {
$r->print('<h3><font color="red">'.&mt('Co-Author').': '.	$r->print('<h3><font color="red">'.&mt('Co-Author').': '.
$cuname.&mt(' at ').$cudom.'</font></h3>');	$cuname.&mt(' at ').$cudom.'</font></h3>');
}	}
Line 1962 ENDDIFF	Line 2077 ENDDIFF

# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.	# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.

unless ($ENV{'form.phase'} eq 'two') {	unless ($env{'form.phase'} eq 'two') {
my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle);	# ---------------------------------------------------------- Parse for problems
$r->print('<hr />'.$outstring);	my ($warningcount,$errorcount);
	if ($thisembstyle eq 'ssi') {
	($warningcount,$errorcount)=&checkonthis($r,$thisfn);
	}
	unless ($errorcount) {
	my ($outstring,$error)=
	&publish($thisfn,$thistarget,$thisembstyle);
	$r->print('<hr />'.$outstring);
	} else {
	$r->print('<h3>'.
	&mt('The document contains errors and cannot be published.').
	'</h3>');
	}
} else {	} else {
$r->print('<hr />'.	$r->print('<hr />'.
&phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget));	&phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget));

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

Removed from v.1.180
changed lines
	Added in v.1.196