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.102 and 1.117

version 1.102, 2002/10/10 15:05:36	version 1.117, 2003/03/14 16:02:49
Line 33	Line 33
# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer	# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
# 03/23 Guy Albertelli	# 03/23 Guy Albertelli
# 03/24,03/29,04/03 Gerd Kortemeyer	# 03/24,03/29,04/03 Gerd Kortemeyer
# 04/16/2001 Scott Harrison
# 05/03,05/05,05/07 Gerd Kortemeyer	# 05/03,05/05,05/07 Gerd Kortemeyer
# 05/28/2001 Scott Harrison
# 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26,10/16 Gerd Kortemeyer	# 06/23,08/07,08/11,8/13,8/17,8/18,8/24,9/26,10/16 Gerd Kortemeyer
# 12/04,12/05 Guy Albertelli	# 12/04,12/05 Guy Albertelli
# 12/05 Gerd Kortemeyer	# 12/05 Gerd Kortemeyer
# 12/05 Guy Albertelli	# 12/05 Guy Albertelli
# 12/06,12/07 Gerd Kortemeyer	# 12/06,12/07 Gerd Kortemeyer
# 12/15,12/16 Scott Harrison
# 12/25 Gerd Kortemeyer	# 12/25 Gerd Kortemeyer
# YEAR=2002	# YEAR=2002
# 1/16,1/17 Scott Harrison
# 1/17 Gerd Kortemeyer	# 1/17 Gerd Kortemeyer
#	#
###	###
Line 121 use File::Copy;	Line 117 use File::Copy;
use Apache::Constants qw(:common :http :methods);	use Apache::Constants qw(:common :http :methods);
use HTML::LCParser;	use HTML::LCParser;
use Apache::lonxml;	use Apache::lonxml;
use Apache::lonhomework;
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 vars qw(%metadatafields %metadatakeys);

my %addid;	my %addid;
my %nokey;	my %nokey;

my %metadatafields;
my %metadatakeys;

my $docroot;	my $docroot;

my $cuname;	my $cuname;
my $cudom;	my $cudom;

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

=pod	=pod

=item B<metaeval>	=item B<metaeval>
Line 267 sub metaread {	Line 257 sub metaread {
#########################################	#########################################
#########################################	#########################################

=pod

=item B<sqltime>

Convert 'time' format into a datetime sql format

Parameters:

=over 4

=item I<$timef>

Seconds since 00:00:00 UTC, January 1, 1970.

=back

Returns:

=over 4

=item Scalar string

MySQL-compatible datetime string.

=back

=cut

#########################################
#########################################
sub sqltime {
my $timef=shift @_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime($timef);
$mon++; $year+=1900;
return "$year-$mon-$mday $hour:$min:$sec";
}


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

sub coursedependencies {	sub coursedependencies {
my $url=&Apache::lonnet::declutter(shift);	my $url=&Apache::lonnet::declutter(shift);
$url=~s/\.meta$//;	$url=~s/\.meta$//;
Line 535 sub get_max_ids_indices {	Line 483 sub get_max_ids_indices {
my $maxindex=10;	my $maxindex=10;
my $maxid=10;	my $maxid=10;
my $needsfixup=0;	my $needsfixup=0;
	my $duplicateids=0;

	my %allids;
	my %duplicatedids;

my $parser=HTML::LCParser->new($content);	my $parser=HTML::LCParser->new($content);
my $token;	my $token;
Line 545 sub get_max_ids_indices {	Line 497 sub get_max_ids_indices {
if ($counter eq 'id') {	if ($counter eq 'id') {
if (defined($token->[2]->{'id'})) {	if (defined($token->[2]->{'id'})) {
$maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;	$maxid=($token->[2]->{'id'}>$maxid)?$token->[2]->{'id'}:$maxid;
	if (exists($allids{$token->[2]->{'id'}})) {
	$duplicateids=1;
	$duplicatedids{$token->[2]->{'id'}}=1;
	} else {
	$allids{$token->[2]->{'id'}}=1;
	}
} else {	} else {
$needsfixup=1;	$needsfixup=1;
}	}
Line 558 sub get_max_ids_indices {	Line 516 sub get_max_ids_indices {
}	}
}	}
}	}
return ($needsfixup,$maxid,$maxindex);	return ($needsfixup,$maxid,$maxindex,$duplicateids,
	(keys(%duplicatedids)));
}	}

#########################################	#########################################
Line 590 sub get_all_text_unbalanced {	Line 549 sub get_all_text_unbalanced {
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
$result.=$token->[2];	$result.=$token->[2];
}	}
if ($result =~ /(.)$tag(.)/) {	if ($result =~ /(.)\Q$tag\E(.)/s) {
#&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2);	#&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2);
#&Apache::lonnet::logthis('Result is :'.$1);	#&Apache::lonnet::logthis('Result is :'.$1);
$result=$1;	$result=$1;
Line 627 sub fix_ids_and_indices {	Line 586 sub fix_ids_and_indices {
$content=join('',<$org>);	$content=join('',<$org>);
}	}

my ($needsfixup,$maxid,$maxindex)=&get_max_ids_indices(\$content);	my ($needsfixup,$maxid,$maxindex,$duplicateids,@duplicatedids)=
	&get_max_ids_indices(\$content);

	print $logfile ("Got $needsfixup,$maxid,$maxindex,$duplicateids--".
	join(', ',@duplicatedids));
	if ($duplicateids) {
	print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n";
	my $outstring='<font color="red">Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are: '.join(', ',@duplicatedids).'</font>';
	return ($outstring,1);
	}
if ($needsfixup) {	if ($needsfixup) {
print $logfile "Needs ID and/or index fixup\n".	print $logfile "Needs ID and/or index fixup\n".
"Max ID : $maxid (min 10)\n".	"Max ID : $maxid (min 10)\n".
Line 752 sub fix_ids_and_indices {	Line 719 sub fix_ids_and_indices {
print $logfile "Does not need ID and/or index fixup\n";	print $logfile "Does not need ID and/or index fixup\n";
}	}

return ($outstring,%allow);	return ($outstring,0,%allow);
}	}

#########################################	#########################################
Line 822 This is the workhorse function of this m	Line 789 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 838 sub publish {	Line 809 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";
Line 853 sub publish {	Line 823 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;	my ($outstring,$error);
($outstring,%allow)=&fix_ids_and_indices($logfile,$source,$target);	($outstring,$error,%allow)=&fix_ids_and_indices($logfile,$source,
	$target);
	if ($error) { return ($outstring,$error); }
# ------------------------------------------------------------ Construct Allows	# ------------------------------------------------------------ Construct Allows

$scrout.='<h3>Dependencies</h3>';	$scrout.='<h3>Dependencies</h3>';
Line 903 sub publish {	Line 875 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 986 sub publish {	Line 957 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 (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;
$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;
}	}

# ------------------------------------------------------- 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 ;
}	}
Line 1079 function uncheckAll(field)	Line 1047 function uncheckAll(field)
<input type="button" value="uncheck all" onclick="javascript:uncheckAll(document.pubform.keywords)">	<input type="button" value="uncheck all" onclick="javascript:uncheckAll(document.pubform.keywords)">
<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'}=~/$_/) {
	$keywordout.=' checked';
	}
	} elsif (&Apache::loncommon::keyword($_)) {
	$keywordout.=' checked';
	}
	$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>'.	'<p><b>Abstract:</b><br><textarea cols=80 rows=5 name=abstract>'.
$metadatafields{'abstract'}.'</textarea>';	$metadatafields{'abstract'}.'</textarea>';

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

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

$scrout.=&selectbox('Language','language',	$scrout.=&selectbox('Language','language',
$metadatafields{'language'},	$metadatafields{'language'},
\&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',$metadatafields{'creationdate'});	$scrout.=&hiddenfield('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') {	unless ($style eq 'prv') {
if ($metadatafields{'copyright'} eq 'public') {	if ($style eq 'rat') {
delete $metadatafields{'copyright'};	if ($metadatafields{'copyright'} eq 'public') {
	delete $metadatafields{'copyright'};
	}
	$scrout.=&selectbox('Copyright/Distribution','copyright',
	$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;
	$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'}=~/$_/) {
	$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 1228 sub phasetwo {	Line 1202 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=~/\_\_\_/) {
	$r->print(
	'<font color="red">Unsupported character combination "<tt>___</tt>" in filename, FAIL</font>');
	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')) {
return	$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;
}	}
print $logfile	print $logfile
"\n================= Publish ".localtime()." Phase Two ================\n";	"\n================= Publish ".localtime()." Phase Two ================\n";
Line 1249 sub phasetwo {	Line 1230 sub phasetwo {
$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'}=	$metadatafields{'creationdate'}=$ENV{'form.creationdate'};
&sqltime($ENV{'form.creationdate'});	$metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};
$metadatafields{'lastrevisiondate'}=
&sqltime($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 1274 sub phasetwo {	Line 1255 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 1326 sub phasetwo {	Line 1307 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 1351 sub phasetwo {	Line 1332 sub phasetwo {
$r->print('<p>Copied old target file');	$r->print('<p>Copied old target file');
} 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 1365 sub phasetwo {	Line 1346 sub phasetwo {
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>";
}	}
}	}

Line 1396 sub phasetwo {	Line 1377 sub phasetwo {
$r->print('<p>Copied source file');	$r->print('<p>Copied source file');
} 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 1409 sub phasetwo {	Line 1390 sub phasetwo {
} 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 1497 sub batchpublish {	Line 1478 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 1618 sub handler {	Line 1602 sub handler {

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

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


unless ($fn) {	unless ($fn) {
Line 1742 unless ($ENV{'form.phase'} eq 'two') {	Line 1726 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.
'&versionone=priv" target="cat">Diffs with Current Version</a><p>');	'&versiontwo=priv" target="cat">Diffs with Current Version</a><p>');
}	}

# ------------------ 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>');

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

Removed from v.1.102
changed lines
	Added in v.1.117