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.81

version 1.65, 2001/12/15 18:15:27	version 1.81, 2002/05/17 22:08:01
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 200 sub urlfixup {	Line 217 sub urlfixup {
return $url;	return $url;
}	}

	sub set_allow {
	my ($allow,$logfile,$target,$tag,$oldurl)=@_;
	my $newurl=&urlfixup($oldurl,$target);
	my $return_url=$oldurl;
	print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n";
	if ($newurl ne $oldurl) {
	$return_url=$newurl;
	print $logfile 'URL: '.$tag.':'.$oldurl.' - '.$newurl."\n";
	}
	if (($newurl !~ /^javascript:/i) &&
	($newurl !~ /^mailto:/i) &&
	($newurl !~ /^http:/i) &&
	($newurl !~ /^\#/)) {
	$$allow{&absoluteurl($newurl,$target)}=1;
	}
	return $return_url
	}

sub publish {	sub publish {

my ($source,$target,$style)=@_;	my ($source,$target,$style)=@_;
Line 240 sub publish {	Line 275 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 306 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 332 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{$_};	print $logfile "for $type, and $key\n";
my $newurl=&urlfixup($oldurl,$target);	if ($key =~ /^$type$/i) {
if ($newurl ne $oldurl) {	print $logfile "calling set_allow\n";
$parms{$_}=$newurl;	$parms{$key}=&set_allow(\%allow,$logfile,
print $logfile 'URL: '.$tag.':'.$oldurl.' - '.	$target,$tag,
$newurl."\n";	$parms{$key});
}	}
$allow{$newurl}=1;	}
}
}	}
	# probably a <randomlabel> image type <label>
	if ($lctag eq 'label' && defined($parms{'description'})) {
	my $next_token=$parser->get_token();
	if ($next_token->[0] eq 'T') {
	$next_token->[1]=&set_allow(\%allow,$logfile,
	$target,$tag,
	$next_token->[1]);
	}
	$parser->unget_token($next_token);
	}
if ($lctag eq 'applet') {	if ($lctag eq 'applet') {
my $codebase='';	my $codebase='';
if (defined($parms{'codebase'})) {	if (defined($parms{'codebase'})) {
Line 327 sub publish {	Line 370 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 380 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 415 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 444 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 556 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 574 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 586 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 618 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 646 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 665 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 686 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 706 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 732 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 761 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 827 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 988 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 937 sub handler {	Line 1008 sub handler {

# Get query string for limited number of parameters	# Get query string for limited number of parameters

foreach (split(/&/,$ENV{'QUERY_STRING'})) {	&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
my ($name, $value) = split(/=/,$_);	['filename']);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
if ($name eq 'filename') {
unless ($ENV{'form.'.$name}) {
$ENV{'form.'.$name}=$value;
}
}
}


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

Line 1058 unless ($ENV{'form.phase'} eq 'two') {	Line 1120 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 1153 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.81