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.65 and 1.79

version 1.65, 2001/12/15 18:15:27	version 1.79, 2002/04/17 18:32:35
Line 41	Line 41
# 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 Scott Harrison	# 12/15,12/16 Scott Harrison
	# 12/25 Gerd Kortemeyer
	# YEAR=2002
	# 1/16,1/17 Scott Harrison
	# 1/17 Gerd Kortemeyer
#	#
###	###

Line 64 use strict;	Line 68 use strict;
use Apache::File;	use Apache::File;
use File::Copy;	use File::Copy;
use Apache::Constants qw(:common :http :methods);	use Apache::Constants qw(:common :http :methods);
use HTML::TokeParser;	use HTML::LCParser;
use Apache::lonxml;	use Apache::lonxml;
use Apache::lonhomework;	use Apache::lonhomework;
use Apache::loncacc;	use Apache::loncacc;
Line 87 my $cudom;	Line 91 my $cudom;
sub metaeval {	sub metaeval {
my $metastring=shift;	my $metastring=shift;

my $parser=HTML::TokeParser->new(\$metastring);	my $parser=HTML::LCParser->new(\$metastring);
my $token;	my $token;
while ($token=$parser->get_token) {	while ($token=$parser->get_token) {
if ($token->[0] eq 'S') {	if ($token->[0] eq 'S') {
Line 145 sub metaread {	Line 149 sub metaread {

# ---------------------------- convert 'time' format into a datetime sql format	# ---------------------------- convert 'time' format into a datetime sql format
sub sqltime {	sub sqltime {
	my $timef=shift @_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(@_[0]);	localtime($timef);
$mon++; $year+=1900;	$mon++; $year+=1900;
return "$year-$mon-$mday $hour:$min:$sec";	return "$year-$mon-$mday $hour:$min:$sec";
}	}
Line 184 sub selectbox {	Line 189 sub selectbox {
sub urlfixup {	sub urlfixup {
my ($url,$target)=@_;	my ($url,$target)=@_;
unless ($url) { return ''; }	unless ($url) { return ''; }
	#javascript code needs no fixing
	if ($url =~ /^javascript:/i) { return $url; }
	if ($url =~ /^mailto:/i) { return $url; }
	#internal document links need no fixing
	if ($url =~ /^\#/) { return $url; }
my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);	my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);
foreach (values %Apache::lonnet::hostname) {	foreach (values %Apache::lonnet::hostname) {
if ($_ eq $host) {	if ($_ eq $host) {
Line 193 sub urlfixup {	Line 203 sub urlfixup {
}	}
if ($url=~/^http\:\/\//) { return $url; }	if ($url=~/^http\:\/\//) { return $url; }
$url=~s/\~$cuname/res\/$cudom\/$cuname/;	$url=~s/\~$cuname/res\/$cudom\/$cuname/;
	return $url;
	}


	sub absoluteurl {
	my ($url,$target)=@_;
	unless ($url) { return ''; }
if ($target) {	if ($target) {
$target=~s/\/[^\/]+$//;	$target=~s/\/[^\/]+$//;
$url=&Apache::lonnet::hreflocation($target,$url);	$url=&Apache::lonnet::hreflocation($target,$url);
Line 240 sub publish {	Line 257 sub publish {
$content=join('',<$org>);	$content=join('',<$org>);
}	}
{	{
my $parser=HTML::TokeParser->new(\$content);	my $parser=HTML::LCParser->new(\$content);
my $token;	my $token;
while ($token=$parser->get_token) {	while ($token=$parser->get_token) {
if ($token->[0] eq 'S') {	if ($token->[0] eq 'S') {
Line 271 sub publish {	Line 288 sub publish {
"Max Index: $maxindex (min 10)\n";	"Max Index: $maxindex (min 10)\n";
}	}
my $outstring='';	my $outstring='';
my $parser=HTML::TokeParser->new(\$content);	my $parser=HTML::LCParser->new(\$content);
$parser->xml_mode(1);	$parser->xml_mode(1);
my $token;	my $token;
while ($token=$parser->get_token) {	while ($token=$parser->get_token) {
Line 297 sub publish {	Line 314 sub publish {
print $logfile 'Index: '.$tag.':'.$maxindex."\n";	print $logfile 'Index: '.$tag.':'.$maxindex."\n";
}	}
}	}
}	}

foreach ('src','href','background') {	foreach my $type ('src','href','background','bgimg') {
if (defined($parms{$_})) {	foreach my $key (keys(%parms)) {
my $oldurl=$parms{$_};	if ($key =~ /^$type$/i) {
my $newurl=&urlfixup($oldurl,$target);	my $oldurl=$parms{$key};
if ($newurl ne $oldurl) {	my $newurl=&urlfixup($oldurl,$target);
$parms{$_}=$newurl;	if ($newurl ne $oldurl) {
print $logfile 'URL: '.$tag.':'.$oldurl.' - '.	$parms{$key}=$newurl;
$newurl."\n";	print $logfile 'URL: '.$tag.':'.$oldurl.' - '.
	$newurl."\n";
	}
	if (($newurl !~ /^javascript:/i) &&
	($newurl !~ /^mailto:/i) &&
	($newurl !~ /^http:/i) &&
	($newurl !~ /^\#/)) {
	$allow{&absoluteurl($newurl,$target)}=1;
	}
}	}
$allow{$newurl}=1;	last;
}	}
}	}

if ($lctag eq 'applet') {	if ($lctag eq 'applet') {
Line 327 sub publish {	Line 352 sub publish {
$oldcodebase.' - '.	$oldcodebase.' - '.
$codebase."\n";	$codebase."\n";
}	}
$allow{$codebase.'/*'}=1;	$allow{&absoluteurl($codebase,$target).'/*'}=1;
} else {	} else {
foreach ('archive','code','object') {	foreach ('archive','code','object') {
if (defined($parms{$_})) {	if (defined($parms{$_})) {
Line 337 sub publish {	Line 362 sub publish {
print $logfile 'Allow: applet '.$_.':'.	print $logfile 'Allow: applet '.$_.':'.
$oldurl.' allows '.	$oldurl.' allows '.
$newurl."\n";	$newurl."\n";
$allow{$newurl}=1;	$allow{&absoluteurl($newurl,$target)}=1;
}	}
}	}
}	}
Line 372 sub publish {	Line 397 sub publish {

$scrout.='<h3>Dependencies</h3>';	$scrout.='<h3>Dependencies</h3>';
my $allowstr='';	my $allowstr='';
foreach (keys %allow) {	foreach (sort(keys(%allow))) {
my $thisdep=$_;	my $thisdep=$_;
	if ($thisdep !~ /[^\s]/) { next; }
unless ($style eq 'rat') {	unless ($style eq 'rat') {
$allowstr.="\n".'<allow src="'.$thisdep.'" />';	$allowstr.="\n".'<allow src="'.$thisdep.'" />';
}	}
Line 400 sub publish {	Line 426 sub publish {
}	}
}	}
}	}
	$allowstr=~s/\n+/\n/g;
$outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;	$outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;

	#Encode any High ASCII characters
	$outstring=&HTML::Entities::encode($outstring,"\200-\377");
# ------------------------------------------------------------- Write modified	# ------------------------------------------------------------- Write modified

{	{
Line 509 sub publish {	Line 538 sub publish {
$chparms;	$chparms;
}	}

my $chparms='';	$chparms='';
foreach (sort keys %oldparmstores) {	foreach (sort keys %oldparmstores) {
if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {	if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {
unless (($metadatafields{$_.'.name'}) \|\|	unless (($metadatafields{$_.'.name'}) \|\|
Line 527 sub publish {	Line 556 sub publish {
# ------------------------------------------------------- Now have all metadata	# ------------------------------------------------------- Now have all metadata

$scrout.=	$scrout.=
'<form 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'}).
Line 539 sub publish {	Line 568 sub publish {

# --------------------------------------------------- Scan content for keywords	# --------------------------------------------------- Scan content for keywords

my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';	my $keywordout=<<"END";
	<script>
	function checkAll(field)
	{
	for (i = 0; i < field.length; i++)
	field[i].checked = true ;
	}

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

if (length($content)<500000) {	if (length($content)<500000) {
my $textonly=$content;	my $textonly=$content;
Line 551 sub publish {	Line 600 sub publish {
$textonly=~s/[\$\&][a-z]\w*//g;	$textonly=~s/[\$\&][a-z]\w*//g;
$textonly=~s/[^a-z\s]//g;	$textonly=~s/[^a-z\s]//g;

my %keywords=();
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;
}	}

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

} else {
$keywordout.='<td>File too long for keyword analysis</td>';
}

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

Line 597 sub publish {	Line 647 sub publish {

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

Line 618 sub publish {	Line 668 sub publish {
}	}
$scrout.=&selectbox('Copyright/Distribution','copyright',	$scrout.=&selectbox('Copyright/Distribution','copyright',
$metadatafields{'copyright'},	$metadatafields{'copyright'},
\&{Apache::loncommon::copyrightdescription},	\&Apache::loncommon::copyrightdescription,
(grep !/^public$/,(&Apache::loncommon::copyrightids)));	(grep !/^public$/,(&Apache::loncommon::copyrightids)));
}	}
else {	else {
$scrout.=&selectbox('Copyright/Distribution','copyright',	$scrout.=&selectbox('Copyright/Distribution','copyright',
$metadatafields{'copyright'},	$metadatafields{'copyright'},
\&{Apache::loncommon::copyrightdescription},	\&Apache::loncommon::copyrightdescription,
(&Apache::loncommon::copyrightids));	(&Apache::loncommon::copyrightids));
}	}
return $scrout.	return $scrout.
Line 638 sub phasetwo {	Line 688 sub phasetwo {
my ($source,$target,$style,$distarget)=@_;	my ($source,$target,$style,$distarget)=@_;
my $logfile;	my $logfile;
my $scrout='';	my $scrout='';

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>';	'<font color=red>No write permission to user directory, FAIL</font>';
Line 665 sub phasetwo {	Line 714 sub phasetwo {
$metadatafields{'dependencies'}=$ENV{'form.dependencies'};	$metadatafields{'dependencies'}=$ENV{'form.dependencies'};

my $allkeywords=$ENV{'form.addkey'};	my $allkeywords=$ENV{'form.addkey'};
foreach (keys %ENV) {	if (exists($ENV{'form.keywords'}) && (ref($ENV{'form.keywords'}))) {
if ($_=~/^form\.key\.(\w+)/) {	my @Keywords = @{$ENV{'form.keywords'}};
$allkeywords.=','.$1;	foreach (@Keywords) {
	$allkeywords.=','.$_;
}	}
}	}
$allkeywords=~s/\W+/\,/;	$allkeywords=~s/\W+/\,/;
Line 693 sub phasetwo {	Line 743 sub phasetwo {
$value=~s/\"/\'\'/g;	$value=~s/\"/\'\'/g;
print $mfh ' '.$_.'="'.$value.'"';	print $mfh ' '.$_.'="'.$value.'"';
}	}
print $mfh '>'.$metadatafields{$unikey}.'</'.$tag.'>';	print $mfh '>'.
	&HTML::Entities::encode($metadatafields{$unikey})
	.'</'.$tag.'>';
}	}
}	}
$scrout.='<p>Wrote Metadata';	$scrout.='<p>Wrote Metadata';
Line 757 sub phasetwo {	Line 809 sub phasetwo {

} else {	} else {
$scrout.='<p>Private Publication - did not synchronize database';	$scrout.='<p>Private Publication - did not synchronize database';
print $logfile "\nPrivate: Did not ynchronized SQL metadata database";	print $logfile "\nPrivate: Did not synchronize data into ".
	"SQL metadata database";
}	}
# ----------------------------------------------------------- Copy old versions	# ----------------------------------------------------------- Copy old versions

Line 917 if (-e $target) {	Line 970 if (-e $target) {


return $warning.$scrout.	return $warning.$scrout.
'<hr><a href="'.$thisdistarget.'"><font size=+2>View Target</font></a>'.	'<hr><a href="'.$thisdistarget.'"><font size=+2>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><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>';
Line 1058 unless ($ENV{'form.phase'} eq 'two') {	Line 1111 unless ($ENV{'form.phase'} eq 'two') {
$thisdisfn=~s/^\/home\/$cuname\/public_html\///;	$thisdisfn=~s/^\/home\/$cuname\/public_html\///;

$r->print('<h2>Publishing '.	$r->print('<h2>Publishing '.
&Apache::lonnet::filedescription($thistype).' <tt>'.	&Apache::loncommon::filedescription($thistype).' <tt>'.
$thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');	$thisdisfn.'</tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><p>');

if (($cuname ne $ENV{'user.name'}) \|\| ($cudom ne $ENV{'user.domain'})) {	if (($cuname ne $ENV{'user.name'}) \|\| ($cudom ne $ENV{'user.domain'})) {
Line 1091 unless ($ENV{'form.phase'} eq 'two') {	Line 1144 unless ($ENV{'form.phase'} eq 'two') {
1;	1;
__END__	__END__

	=head1 NAME

	Apache::lonpublisher - Publication Handler

	=head1 SYNOPSIS

	Invoked by /etc/httpd/conf/srm.conf:

	<Location /adm/publish>
	PerlAccessHandler Apache::lonacc
	SetHandler perl-script
	PerlHandler Apache::lonpublisher
	ErrorDocument 403 /adm/login
	ErrorDocument 404 /adm/notfound.html
	ErrorDocument 406 /adm/unauthorized.html
	ErrorDocument 500 /adm/errorhandler
	</Location>

	=head1 INTRODUCTION

	This module publishes a file. This involves gathering metadata,
	versioning the file, copying file from construction space to
	publication space, and copying metadata from construction space
	to publication space.

	This is part of the LearningOnline Network with CAPA project
	described at http://www.lon-capa.org.

	=head1 HANDLER SUBROUTINE

	This routine is called by Apache and mod_perl.

	=over 4

	=item *

	Get query string for limited number of parameters

	=item *

	Check filename

	=item *

	File is there and owned, init lookup tables

	=item *

	Start page output

	=item *

	Individual file

	=item *

	publish from $thisfn to $thistarget with $thisembstyle

	=back

	=head1 OTHER SUBROUTINES

	=over 4

	=item *

	metaeval() : Evaluate string with metadata

	=item *

	metaread() : Read a metadata file

	=item *

	sqltime() : convert 'time' format into a datetime sql format

	=item *

	textfield() : form field

	=item *

	hiddenfield() : form field

	=item *

	selectbox() : form field

	=item *

	urlfixup() : fixup URL (Publication Step One)

	=item *

	publish() : publish (Publication Step One)

	=item *

	phasetwo() : render second interface showing status of publication steps
	(Publication Step Two)

	=back

	=cut

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

Removed from v.1.65
changed lines
	Added in v.1.79