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.111 and 1.126.2.1

version 1.111, 2003/02/18 23:13:54	version 1.126.2.1, 2003/08/21 17:12:32
Line 190 sub metaeval {	Line 190 sub metaeval {
}	}
if ($metadatafields{$unikey}) {	if ($metadatafields{$unikey}) {
my $newentry=$parser->get_text('/'.$entry);	my $newentry=$parser->get_text('/'.$entry);
unless (($metadatafields{$unikey}=~/$newentry/) \|\|	unless (($metadatafields{$unikey}=~/\Q$newentry\E/) \|\|
($newentry eq '')) {	($newentry eq '')) {
$metadatafields{$unikey}.=', '.$newentry;	$metadatafields{$unikey}.=', '.$newentry;
}	}
Line 242 sub metaread {	Line 242 sub metaread {
my ($logfile,$fn)=@_;	my ($logfile,$fn)=@_;
unless (-e $fn) {	unless (-e $fn) {
print($logfile 'No file '.$fn."\n");	print($logfile 'No file '.$fn."\n");
return '<br><b>No file:</b> <tt>'.$fn.'</tt>';	return '<br /><b>No file:</b> <tt>'.$fn.'</tt>';
}	}
print($logfile 'Processing '.$fn."\n");	print($logfile 'Processing '.$fn."\n");
my $metastring;	my $metastring;
Line 251 sub metaread {	Line 251 sub metaread {
$metastring=join('',<$metafh>);	$metastring=join('',<$metafh>);
}	}
&metaeval($metastring);	&metaeval($metastring);
return '<br><b>Processed file:</b> <tt>'.$fn.'</tt>';	return '<br /><b>Processed file:</b> <tt>'.$fn.'</tt>';
}	}

#########################################	#########################################
Line 304 string which presents the form field (fo	Line 304 string which presents the form field (fo
#########################################	#########################################
sub textfield {	sub textfield {
my ($title,$name,$value)=@_;	my ($title,$name,$value)=@_;
return "\n<p><b>$title:</b><br>".	my $uctitle=uc($title);
	return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
	"</b></font></p><br />".
'<input type="text" name="'.$name.'" size=80 value="'.$value.'" />';	'<input type="text" name="'.$name.'" size=80 value="'.$value.'" />';
}	}

Line 316 sub hiddenfield {	Line 318 sub hiddenfield {
sub selectbox {	sub selectbox {
my ($title,$name,$value,$functionref,@idlist)=@_;	my ($title,$name,$value,$functionref,@idlist)=@_;
my $uctitle=uc($title);	my $uctitle=uc($title);
	$value=(split(/\s,\s/,$value))[-1];
my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".	my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
"</b></font><br />".'<select name="'.$name.'">';	'</b></font></p><br /><select name="'.$name.'">';
foreach (@idlist) {	foreach (@idlist) {
$selout.='<option value=\''.$_.'\'';	$selout.='<option value=\''.$_.'\'';
if ($_ eq $value) {	if ($_ eq $value) {
Line 436 sub get_subscribed_hosts {	Line 439 sub get_subscribed_hosts {
my $srcf=$2;	my $srcf=$2;
opendir(DIR,$1);	opendir(DIR,$1);
while ($filename=readdir(DIR)) {	while ($filename=readdir(DIR)) {
if ($filename=~/$srcf\.(\w+)$/) {	if ($filename=~/\Q$srcf\E\.(\w+)$/) {
my $subhost=$1;	my $subhost=$1;
if (($subhost ne 'meta' && $subhost ne 'subscription') &&	if (($subhost ne 'meta' && $subhost ne 'subscription') &&
($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) {	($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) {
Line 695 sub fix_ids_and_indices {	Line 698 sub fix_ids_and_indices {
}	}
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') {	if ($lctag eq 'm' \|\| $lctag eq 'script'
$outstring.=&get_all_text_unbalanced('/m',\@parser);	\|\| $lctag eq 'display' \|\| $lctag eq 'tex') {
	$outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser);
}	}
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
if ($token->[2]) {	if ($token->[2]) {
Line 789 This is the workhorse function of this m	Line 793 This is the workhorse function of this m
backup copies, performs any automatic processing (prior to publication,	backup copies, performs any automatic processing (prior to publication,
especially for rat and ssi files),	especially for rat and ssi files),

	Returns a 2 element array, the first is the string to be shown to the
	user, the second is an error code, either 1 (an error occured) or 0
	(no error occurred)

I<Additional documentation needed.>	I<Additional documentation needed.>

=cut	=cut
Line 805 sub publish {	Line 813 sub publish {
my %allow=();	my %allow=();

unless ($logfile=Apache::File->new('>>'.$source.'.log')) {	unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
return	return ('<font color="red">No write permission to user directory, FAIL</font>',1);
'<font color=red>No write permission to user directory, FAIL</font>';
}	}
print $logfile	print $logfile
"\n\n================= Publish ".localtime()." Phase One ================\n";	"\n\n================= Publish ".localtime()." Phase One ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n";

if (($style eq 'ssi') \|\| ($style eq 'rat')) {	if (($style eq 'ssi') \|\| ($style eq 'rat') \|\| ($style eq 'prv')) {
# ------------------------------------------------------- This needs processing	# ------------------------------------------------------- This needs processing

# ----------------------------------------------------------------- Backup Copy	# ----------------------------------------------------------------- Backup Copy
Line 820 sub publish {	Line 827 sub publish {
print $logfile "Copied original file to ".$copyfile."\n";	print $logfile "Copied original file to ".$copyfile."\n";
} else {	} else {
print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";	print $logfile "Unable to write backup ".$copyfile.':'.$!."\n";
return "<font color=red>Failed to write backup copy, $!,FAIL</font>";	return ("<font color=\"red\">Failed to write backup copy, $!,FAIL</font>",1);
}	}
# ------------------------------------------------------------- IDs and indices	# ------------------------------------------------------------- IDs and indices

my ($outstring,$error);	my ($outstring,$error);
($outstring,$error,%allow)=&fix_ids_and_indices($logfile,$source,	($outstring,$error,%allow)=&fix_ids_and_indices($logfile,$source,
$target);	$target);
if ($error) { return $outstring; }	if ($error) { return ($outstring,$error); }
# ------------------------------------------------------------ Construct Allows	# ------------------------------------------------------------ Construct Allows

$scrout.='<h3>Dependencies</h3>';	$scrout.='<h3>Dependencies</h3>';
Line 838 sub publish {	Line 845 sub publish {
unless ($style eq 'rat') {	unless ($style eq 'rat') {
$allowstr.="\n".'<allow src="'.$thisdep.'" />';	$allowstr.="\n".'<allow src="'.$thisdep.'" />';
}	}
$scrout.='<br>';	$scrout.='<br />';
unless ($thisdep=~/\*/) {	unless ($thisdep=~/\*/) {
$scrout.='<a href="'.$thisdep.'">';	$scrout.='<a href="'.$thisdep.'">';
}	}
Line 872 sub publish {	Line 879 sub publish {
my $org;	my $org;
unless ($org=Apache::File->new('>'.$source)) {	unless ($org=Apache::File->new('>'.$source)) {
print $logfile "No write permit to $source\n";	print $logfile "No write permit to $source\n";
return	return ('<font color="red">No write permission to '.$source.
'<font color="red">No write permission to '.$source.	', FAIL</font>',1);
', FAIL</font>';
}	}
print($org $outstring);	print($org $outstring);
}	}
Line 905 sub publish {	Line 911 sub publish {
$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;
	$metadatafields{'modifyinguser'}=$ENV{'user.name'}.'@'.
	$ENV{'user.domain'};
	$metadatafields{'authorspace'}=$cuname.'@'.$cudom;

# ------------------------------------------------ Check out directory hierachy	# ------------------------------------------------ Check out directory hierachy

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

my @urlparts=split(/\//,$thisdisfn);	my @urlparts=split(/\//,$thisdisfn);
$#urlparts--;	$#urlparts--;
Line 944 sub publish {	Line 953 sub publish {
}	}

# -------------------------------------------------- Parse content for metadata	# -------------------------------------------------- Parse content for metadata
if ($style eq 'ssi') {	if (($style eq 'ssi') \|\| ($style eq 'prv')) {
my $oldenv=$ENV{'request.uri'};	my $oldenv=$ENV{'request.uri'};

$ENV{'request.uri'}=$target;	$ENV{'request.uri'}=$target;
$Apache::lonxml::debug=1;
$allmeta=Apache::lonxml::xmlparse(undef,'meta',$content);	$allmeta=Apache::lonxml::xmlparse(undef,'meta',$content);
$Apache::lonxml::debug=0;
$ENV{'request.uri'}=$oldenv;	$ENV{'request.uri'}=$oldenv;

&metaeval($allmeta);	&metaeval($allmeta);
}	}
# ---------------- 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 (sort keys %metadatafields) {
if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {	if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {
unless ($_=~/\.\w+$/) {	unless ($_=~/\.\w+$/) {
unless ($oldparmstores{$_}) {	unless ($oldparmstores{$_}) {
print $logfile 'New: '.$_."\n";	print $logfile 'New: '.$_."\n";
$chparms.=$_.' ';	$chparms.=$_.' ';
}	}
}	}
}	}
}	}
if ($chparms) {	if ($chparms) {
$scrout.='<p><b>New parameters or stored values:</b> '.	$scrout.='<p><b>New parameters or stored values:</b> '.$chparms.'</p>';
$chparms;	}
}

$chparms='';	$chparms='';
foreach (sort keys %oldparmstores) {	foreach (sort keys %oldparmstores) {
if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {	if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {
unless (($metadatafields{$_.'.name'}) \|\|	unless (($metadatafields{$_.'.name'}) \|\|
($metadatafields{$_.'.package'}) \|\| ($_=~/\.\w+$/)) {	($metadatafields{$_.'.package'}) \|\| ($_=~/\.\w+$/)) {
print $logfile 'Obsolete: '.$_."\n";	print $logfile 'Obsolete: '.$_."\n";
$chparms.=$_.' ';	$chparms.=$_.' ';
}	}
}	}
}	}
if ($chparms) {	if ($chparms) {
$scrout.='<p><b>Obsolete parameters or stored values:</b> '.	$scrout.='<p><b>Obsolete parameters or stored values:</b> '.
$chparms;	$chparms.'</p>';
}	}

# ------------------------------------------------------- Now have all metadata	# ------------------------------------------------------- Now have all metadata

my %keywords=();	my %keywords=();

if (length($content)<500000) {	if (length($content)<500000) {
my $textonly=$content;	my $textonly=$content;
$textonly=~s/\<script[^\<]+\<\/script\>//g;	$textonly=~s/\<script[^\<]+\<\/script\>//g;
$textonly=~s/\<m\>[^\<]+\<\/m\>//g;	$textonly=~s/\<m\>[^\<]+\<\/m\>//g;
$textonly=~s/\<[^\>]*\>//g;	$textonly=~s/\<[^\>]*\>//g;
$textonly=~tr/A-Z/a-z/;	$textonly=~tr/A-Z/a-z/;
$textonly=~s/[\$\&][a-z]\w*//g;	$textonly=~s/[\$\&][a-z]\w*//g;
$textonly=~s/[^a-z\s]//g;	$textonly=~s/[^a-z\s]//g;

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


foreach (split(/\W+/,$metadatafields{'keywords'})) {	foreach (split(/\W+/,$metadatafields{'keywords'})) {
$keywords{$_}=1;	$keywords{$_}=1;
}	}
# --------------------------------------------------- Now we also have keywords	# --------------------------------------------------- Now we also have keywords
# =============================================================================	# =============================================================================
# INTERACTIVE MODE	# INTERACTIVE MODE
#	#
unless ($batch) {	unless ($batch) {
$scrout.=	$scrout.=
'<form name="pubform" action="/adm/publish" method="post">'.	'<form name="pubform" action="/adm/publish" method="post">'.
'<p><input type="submit" value="Finalize Publication" /></p>'.	'<p><input type="submit" value="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)).
&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 $keywordout=<<"END";	my $keywordout=<<"END";
<script>	<script>
function checkAll(field)	function checkAll(field) {
{
for (i = 0; i < field.length; i++)	for (i = 0; i < field.length; i++)
field[i].checked = true ;	field[i].checked = true ;
}	}

function uncheckAll(field)	function uncheckAll(field) {
{
for (i = 0; i < field.length; i++)	for (i = 0; i < field.length; i++)
field[i].checked = false ;	field[i].checked = false ;
}	}
</script>	</script>
<p><b>Keywords: $keywords_help</b>	<p><font color="#800000" face="helvetica"><b>KEYWORDS:</b></font>
<input type="button" value="check all" onclick="javascript:checkAll(document.pubform.keywords)">	$keywords_help</b>
<input type="button" value="uncheck all" onclick="javascript:uncheckAll(document.pubform.keywords)">	<input type="button" value="check all" onclick="javascript:checkAll(document.pubform.keywords)" />
	<input type="button" value="uncheck all" onclick="javascript:uncheckAll(document.pubform.keywords)" />
	</p>
<br />	<br />
END	END
$keywordout.='<table border=2><tr>';	$keywordout.='<table border="2"><tr>';
my $colcount=0;	my $colcount=0;

	foreach (sort keys %keywords) {
	$keywordout.='<td><input type="checkbox" name="keywords" value="'.$_.'"';
	if ($metadatafields{'keywords'}) {
	if ($metadatafields{'keywords'}=~/\Q$_\E/) {
	$keywordout.=' checked="on"';
	}
	} elsif (&Apache::loncommon::keyword($_)) {
	$keywordout.=' checked="on"';
	}
	$keywordout.=' />'.$_.'</td>';
	if ($colcount>10) {
	$keywordout.="</tr><tr>\n";
	$colcount=0;
	}
	$colcount++;
	}

foreach (sort keys %keywords) {
$keywordout.='<td><input type=checkbox name="keywords" value="'.$_.'"';
if ($metadatafields{'keywords'}) {
if ($metadatafields{'keywords'}=~/$_/) {
$keywordout.=' checked';
}
} elsif (&Apache::loncommon::keyword($_)) {
$keywordout.=' checked';
}
$keywordout.='>'.$_.'</td>';
if ($colcount>10) {
$keywordout.="</tr><tr>\n";
$colcount=0;
}
$colcount++;
}

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

$scrout.=$keywordout;	$scrout.=$keywordout;

$scrout.=&textfield('Additional Keywords','addkey','');	$scrout.=&textfield('Additional Keywords','addkey','');

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

$scrout.=	$scrout.=
'<p><b>Abstract:</b><br><textarea cols=80 rows=5 name=abstract>'.	"\n<p><font color=\"#800000\" face=\"helvetica\"><b>ABSTRACT:".
$metadatafields{'abstract'}.'</textarea>';	"</b></font></p><br />".
	'<textarea cols="80" rows="5" name="abstract">'.
	$metadatafields{'abstract'}.'</textarea></p>';

$source=~/\.(\w+)$/;	$source=~/\.(\w+)$/;

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

$scrout.=&selectbox('Language','language',	my $defaultlanguage=$metadatafields{'language'};
$metadatafields{'language'},	$defaultlanguage =~ s/\snotset\s//g;
	$defaultlanguage =~ s/^,\s*//g;
	$defaultlanguage =~ s/,\s*$//g;

	$scrout.=&selectbox('Language','language',
	$defaultlanguage,
\&Apache::loncommon::languagedescription,	\&Apache::loncommon::languagedescription,
(&Apache::loncommon::languageids),	(&Apache::loncommon::languageids),
);	);

unless ($metadatafields{'creationdate'}) {	unless ($metadatafields{'creationdate'}) {
$metadatafields{'creationdate'}=time;	$metadatafields{'creationdate'}=time;
}	}
$scrout.=&hiddenfield('creationdate',	$scrout.=&hiddenfield('creationdate',
&Apache::loncommon::unsqltime($metadatafields{'creationdate'}));	&Apache::loncommon::unsqltime($metadatafields{'creationdate'}));

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

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


$scrout.=&textfield('Publisher/Owner','owner',	$scrout.=&textfield('Publisher/Owner','owner',
$metadatafields{'owner'});	$metadatafields{'owner'});

# -------------------------------------------------- Correct copyright for rat.	# -------------------------------------------------- Correct copyright for rat.
if ($style eq 'rat') {	my $defaultoption=$metadatafields{'copyright'};
if ($metadatafields{'copyright'} eq 'public') {	unless ($defaultoption) { $defaultoption='default'; }
delete $metadatafields{'copyright'};	unless ($style eq 'prv') {
	if ($style eq 'rat') {
	if ($metadatafields{'copyright'} eq 'public') {
	delete $metadatafields{'copyright'};
	$defaultoption='default';
	}
	$scrout.=&selectbox('Copyright/Distribution','copyright',
	$defaultoption,
	\&Apache::loncommon::copyrightdescription,
	(grep !/^public$/,(&Apache::loncommon::copyrightids)));
	} else {
	$scrout.=&selectbox('Copyright/Distribution','copyright',
	$defaultoption,
	\&Apache::loncommon::copyrightdescription,
	(&Apache::loncommon::copyrightids));
	}

	my $copyright_help =
	Apache::loncommon::help_open_topic('Publishing_Copyright');
	$scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;
	$scrout.=&textfield('Custom Distribution File','customdistributionfile',
	$metadatafields{'customdistributionfile'}).
	$copyright_help;
	} else {
	$scrout.=&hiddenfield('copyright','private');
}	}
$scrout.=&selectbox('Copyright/Distribution','copyright',	return ($scrout.'<p><input type="submit" value="Finalize Publication" /></p></form>',0);
$metadatafields{'copyright'},
\&Apache::loncommon::copyrightdescription,
(grep !/^public$/,(&Apache::loncommon::copyrightids)));
}
else {
$scrout.=&selectbox('Copyright/Distribution','copyright',
$metadatafields{'copyright'},
\&Apache::loncommon::copyrightdescription,
(&Apache::loncommon::copyrightids));
}

my $copyright_help =
Apache::loncommon::help_open_topic('Publishing_Copyright');
$scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;
return $scrout.
'<p><input type="submit" value="Finalize Publication" /></p></form>';
# =============================================================================	# =============================================================================
# BATCH MODE	# BATCH MODE
#	#
} else {	} else {
# Transfer metadata directly to environment for stage 2	# Transfer metadata directly to environment for stage 2
foreach (keys %metadatafields) {	foreach (keys %metadatafields) {
$ENV{'form.'.$_}=$metadatafields{$_};	$ENV{'form.'.$_}=$metadatafields{$_};
	}
	$ENV{'form.addkey'}='';
	$ENV{'form.keywords'}='';
	foreach (keys %keywords) {
	if ($metadatafields{'keywords'}) {
	if ($metadatafields{'keywords'}=~/\Q$_\E/) {
	$ENV{'form.keywords'}.=$_.',';
	}
	} elsif (&Apache::loncommon::keyword($_)) {
	$ENV{'form.keywords'}.=$_.',';
	}
	}
	$ENV{'form.keywords'}=~s/\,$//;
	unless ($ENV{'form.creationdate'}) { $ENV{'form.creationdate'}=time; }
	$ENV{'form.lastrevisiondate'}=time;
	if ((($style eq 'rat') && ($ENV{'form.copyright'} eq 'public')) \|\|
	(!$ENV{'form.copyright'})) {
	$ENV{'form.copyright'}='default';
	}
	$ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta);
	return ($scrout,0);
}	}
$ENV{'form.addkey'}='';
$ENV{'form.keywords'}='';
foreach (keys %keywords) {
if ($metadatafields{'keywords'}) {
if ($metadatafields{'keywords'}=~/$_/) {
$ENV{'form.keywords'}.=$_.',';
}
} elsif (&Apache::loncommon::keyword($_)) {
$ENV{'form.keywords'}.=$_.',';
}
}
$ENV{'form.keywords'}=~s/\,$//;
unless ($ENV{'form.creationdate'}) { $ENV{'form.creationdate'}=time; }
$ENV{'form.lastrevisiondate'}=time;
if ((($style eq 'rat') && ($ENV{'form.copyright'} eq 'public')) \|\|
(!$ENV{'form.copyright'})) {
$ENV{'form.copyright'}='default';
}
$ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta);
return $scrout;
}
}	}

#########################################	#########################################
Line 1203 sub phasetwo {	Line 1224 sub phasetwo {

if ($target=~/\_\_\_/) {	if ($target=~/\_\_\_/) {
$r->print(	$r->print(
'<font color=red>Unsupported character combination "<tt>___</tt>" in filename, FAIL</font>');	'<font color="red">Unsupported character combination "<tt>___</tt>" in filename, FAIL</font>');
return 0;	return 0;
}	}
$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(	$r->print(
'<font color=red>No write permission to user directory, FAIL</font>');	'<font color="red">No write permission to user directory, FAIL</font>');
return 0;	return 0;
}	}
print $logfile	print $logfile
"\n================= Publish ".localtime()." Phase Two ================\n";	"\n================= Publish ".localtime()." Phase Two ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n";

%metadatafields=();	%metadatafields=();
%metadatakeys=();	%metadatakeys=();
Line 1232 sub phasetwo {	Line 1253 sub phasetwo {
$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{'customdistributionfile'}=
	$ENV{'form.customdistributionfile'};
$metadatafields{'dependencies'}=$ENV{'form.dependencies'};	$metadatafields{'dependencies'}=$ENV{'form.dependencies'};

my $allkeywords=$ENV{'form.addkey'};	my $allkeywords=$ENV{'form.addkey'};
Line 1251 sub phasetwo {	Line 1274 sub phasetwo {
my $mfh;	my $mfh;
unless ($mfh=Apache::File->new('>'.$source.'.meta')) {	unless ($mfh=Apache::File->new('>'.$source.'.meta')) {
return	return
'<font color=red>Could not write metadata, FAIL</font>';	'<font color="red">Could not write metadata, FAIL</font>';
}	}
foreach (sort keys %metadatafields) {	foreach (sort keys %metadatafields) {
unless ($_=~/\./) {	unless ($_=~/\./) {
Line 1270 sub phasetwo {	Line 1293 sub phasetwo {
.'</'.$tag.'>';	.'</'.$tag.'>';
}	}
}	}
$r->print('<p>Wrote Metadata');	$r->print('<p>Wrote Metadata</p>');
print $logfile "\nWrote metadata";	print $logfile "\nWrote metadata";
}	}

Line 1281 sub phasetwo {	Line 1304 sub phasetwo {
unless ($metadatafields{'copyright'} eq 'priv') {	unless ($metadatafields{'copyright'} eq 'priv') {
my ($error,$success) = &store_metadata(\%metadatafields);	my ($error,$success) = &store_metadata(\%metadatafields);
if ($success) {	if ($success) {
$r->print('<p>Synchronized SQL metadata database');	$r->print('<p>Synchronized SQL metadata database</p>');
print $logfile "\nSynchronized SQL metadata database";	print $logfile "\nSynchronized SQL metadata database";
} else {	} else {
$r->print($error);	$r->print($error);
print $logfile "\n".$error;	print $logfile "\n".$error;
}	}
} else {	} else {
$r->print('<p>Private Publication - did not synchronize database');	$r->print('<p>Private Publication - did not synchronize database</p>');
print $logfile "\nPrivate: Did not synchronize data into ".	print $logfile "\nPrivate: Did not synchronize data into ".
"SQL metadata database";	"SQL metadata database";
}	}
Line 1303 sub phasetwo {	Line 1326 sub phasetwo {
my $srcd=$1;	my $srcd=$1;
unless ($srcd=~/^\/home\/httpd\/html\/res/) {	unless ($srcd=~/^\/home\/httpd\/html\/res/) {
print $logfile "\nPANIC: Target dir is ".$srcd;	print $logfile "\nPANIC: Target dir is ".$srcd;
return "<font color=red>Invalid target directory, FAIL</font>";	return "<font color=\"red\">Invalid target directory, FAIL</font>";
}	}
opendir(DIR,$srcd);	opendir(DIR,$srcd);
while ($filename=readdir(DIR)) {	while ($filename=readdir(DIR)) {
Line 1311 sub phasetwo {	Line 1334 sub phasetwo {
unlink($srcd.'/'.$filename);	unlink($srcd.'/'.$filename);
unlink($srcd.'/'.$filename.'.meta');	unlink($srcd.'/'.$filename.'.meta');
} else {	} else {
if ($filename=~/$srcf\.(\d+)\.$srct$/) {	if ($filename=~/\Q$srcf\E\.(\d+)\.\Q$srct\E$/) {
$maxversion=($1>$maxversion)?$1:$maxversion;	$maxversion=($1>$maxversion)?$1:$maxversion;
}	}
}	}
}	}
closedir(DIR);	closedir(DIR);
$maxversion++;	$maxversion++;
$r->print('<p>Creating old version '.$maxversion);	$r->print('<p>Creating old version '.$maxversion.'</p>');
print $logfile "\nCreating old version ".$maxversion;	print $logfile "\nCreating old version ".$maxversion."\n";

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

if (copy($target,$copyfile)) {	if (copy($target,$copyfile)) {
print $logfile "Copied old target to ".$copyfile."\n";	print $logfile "Copied old target to ".$copyfile."\n";
$r->print('<p>Copied old target file');	$r->print('<p>Copied old target file</p>');
} else {	} else {
print $logfile "Unable to write ".$copyfile.':'.$!."\n";	print $logfile "Unable to write ".$copyfile.':'.$!."\n";
return "<font color=red>Failed to copy old target, $!, FAIL</font>";	return "<font color=\"red\">Failed to copy old target, $!, FAIL</font>";
}	}

# --------------------------------------------------------------- Copy Metadata	# --------------------------------------------------------------- Copy Metadata
Line 1337 sub phasetwo {	Line 1360 sub phasetwo {

if (copy($target.'.meta',$copyfile)) {	if (copy($target.'.meta',$copyfile)) {
print $logfile "Copied old target metadata to ".$copyfile."\n";	print $logfile "Copied old target metadata to ".$copyfile."\n";
$r->print('<p>Copied old metadata')	$r->print('<p>Copied old metadata</p>')
} 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') {
return	return
"<font color=red>Failed to write old metadata copy, $!, FAIL</font>";	"<font color=\"red\">Failed to write old metadata copy, $!, FAIL</font>";
}	}
}	}


} else {	} else {
$r->print('<p>Initial version');	$r->print('<p>Initial version</p>');
print $logfile "\nInitial version";	print $logfile "\nInitial version";
}	}

Line 1363 sub phasetwo {	Line 1386 sub phasetwo {
$path.="/$parts[$count]";	$path.="/$parts[$count]";
if ((-e $path)!=1) {	if ((-e $path)!=1) {
print $logfile "\nCreating directory ".$path;	print $logfile "\nCreating directory ".$path;
$r->print('<p>Created directory '.$parts[$count]);	$r->print('<p>Created directory '.$parts[$count].'</p>');
mkdir($path,0777);	mkdir($path,0777);
}	}
}	}

if (copy($source,$copyfile)) {	if (copy($source,$copyfile)) {
print $logfile "\nCopied original source to ".$copyfile."\n";	print $logfile "\nCopied original source to ".$copyfile."\n";
$r->print('<p>Copied source file');	$r->print('<p>Copied source file</p>');
} else {	} else {
print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";	print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
return "<font color=red>Failed to copy source, $!, FAIL</font>";	return "<font color=\"red\">Failed to copy source, $!, FAIL</font>";
}	}

# --------------------------------------------------------------- Copy Metadata	# --------------------------------------------------------------- Copy Metadata
Line 1382 sub phasetwo {	Line 1405 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('<p>Copied metadata');	$r->print('<p>Copied metadata</p>');
} else {	} else {
print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";	print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
return	return
"<font color=red>Failed to write metadata copy, $!, FAIL</font>";	"<font color=\"red\">Failed to write metadata copy, $!, FAIL</font>";
}	}
$r->rflush;	$r->rflush;
# --------------------------------------------------- Send update notifications	# --------------------------------------------------- Send update notifications
Line 1396 sub phasetwo {	Line 1419 sub phasetwo {
$r->print('<p>Notifying host '.$subhost.':');$r->rflush;	$r->print('<p>Notifying host '.$subhost.':');$r->rflush;
print $logfile "\nNotifying host ".$subhost.':';	print $logfile "\nNotifying host ".$subhost.':';
my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);	my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
$r->print($reply.'<br />');$r->rflush;	$r->print($reply.'</p><br />');$r->rflush;
print $logfile $reply;	print $logfile $reply;
}	}

Line 1408 sub phasetwo {	Line 1431 sub phasetwo {
print $logfile "\nNotifying host for metadata only ".$subhost.':';	print $logfile "\nNotifying host for metadata only ".$subhost.':';
my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',	my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
$subhost);	$subhost);
$r->print($reply.'<br />');$r->rflush;	$r->print($reply.'</p><br />');$r->rflush;
print $logfile $reply;	print $logfile $reply;
}	}

Line 1421 sub phasetwo {	Line 1444 sub phasetwo {
my ($cdom,$cname)=split(/\_/,$_);	my ($cdom,$cname)=split(/\_/,$_);
my $reply=&Apache::lonnet::cput	my $reply=&Apache::lonnet::cput
('versionupdate',{$target => $now},$cdom,$cname);	('versionupdate',{$target => $now},$cdom,$cname);
$r->print($reply.'<br />');$r->rflush;	$r->print($reply.'</p><br />');$r->rflush;
print $logfile $reply;	print $logfile $reply;
}	}
# ------------------------------------------------ Provide link to new resource	# ------------------------------------------------ Provide link to new resource
unless ($batch) {	unless ($batch) {
my $thisdistarget=$target;	my $thisdistarget=$target;
$thisdistarget=~s/^$docroot//;	$thisdistarget=~s/^\Q$docroot\E//;

my $thissrc=$source;	my $thissrc=$source;
$thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/;	$thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/;
Line 1437 sub phasetwo {	Line 1460 sub phasetwo {


$r->print(	$r->print(
'<hr><a href="'.$thisdistarget.'"><font size="+2">'.	'<hr /><a href="'.$thisdistarget.'"><font size="+2">'.
'View Published Version</font></a>'.	'View Published Version</font></a>'.
'<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a>'.	'<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a></p>'.
'<p><a href="'.$thissrcdir.	'<p><a href="'.$thissrcdir.
'"><font size="+2">Back to Source Directory</font></a>');	'"><font size="+2">Back to Source Directory</font></a></p>');
}	}
}	}

Line 1457 sub batchpublish {	Line 1480 sub batchpublish {

my $docroot=$r->dir_config('lonDocRoot');	my $docroot=$r->dir_config('lonDocRoot');
my $thisdistarget=$targetfile;	my $thisdistarget=$targetfile;
$thisdistarget=~s/^$docroot//;	$thisdistarget=~s/^\Q$docroot\E//;


undef %metadatafields;	undef %metadatafields;
Line 1474 sub batchpublish {	Line 1497 sub batchpublish {

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

Line 1521 sub publishdirectory {	Line 1547 sub publishdirectory {
$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) {	if (($rmtime<$cmtime) \|\| ($ENV{'form.forcerepub'})) {
# previously published, modified now	# previously published, modified now
$publishthis=1;	$publishthis=1;
}	}
Line 1595 sub handler {	Line 1621 sub handler {

# -------------------------------------------------------------- Check filename	# -------------------------------------------------------------- Check filename

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


unless ($fn) {	unless ($fn) {
Line 1691 unless ($ENV{'form.phase'} eq 'two') {	Line 1717 unless ($ENV{'form.phase'} eq 'two') {
$thistarget=~s/\/public\_html//;	$thistarget=~s/\/public\_html//;

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

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

if ($fn=~/\/$/) {	if ($fn=~/\/$/) {
# -------------------------------------------------------- This is a directory	# -------------------------------------------------------- This is a directory
Line 1709 unless ($ENV{'form.phase'} eq 'two') {	Line 1735 unless ($ENV{'form.phase'} eq 'two') {
$r->print('<h2>Publishing '.	$r->print('<h2>Publishing '.
&Apache::loncommon::filedescription($thistype).' <tt>'.	&Apache::loncommon::filedescription($thistype).' <tt>'.
'<a href="/~'.$cuname.'/'.$thisdisfn.'" target="cat">'.$thisdisfn.	'<a href="/~'.$cuname.'/'.$thisdisfn.'" target="cat">'.$thisdisfn.
'</a></tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');	'</a></tt></h2><b>Target:</b> <tt>'.$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">Co-Author: '.$cuname.' at '.$cudom.	$r->print('<h3><font color="red">Co-Author: '.$cuname.' at '.$cudom.
Line 1719 unless ($ENV{'form.phase'} eq 'two') {	Line 1745 unless ($ENV{'form.phase'} eq 'two') {
if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {	if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
$r->print('<br /><a href="/adm/diff?filename=/~'.$cuname.'/'.	$r->print('<br /><a href="/adm/diff?filename=/~'.$cuname.'/'.
$thisdisfn.	$thisdisfn.
'&versiontwo=priv" target="cat">Diffs with Current Version</a><p>');	'&versiontwo=priv" target="cat">Diffs with Current Version</a><br />');
}	}

# ------------------ 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') {
$r->print(	my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle);
'<hr />'.&publish($thisfn,$thistarget,$thisembstyle));	$r->print('<hr />'.$outstring);
} else {	} else {
$r->print('<hr />');	$r->print('<hr />');
&phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget);	&phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget);
}	}

}	}
$r->print('</body></html>');	$r->print('</body></html>');

Line 1745 __END__	Line 1770 __END__

=back	=back

	=back

=cut	=cut

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

Removed from v.1.111
changed lines
	Added in v.1.126.2.1