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.51 and 1.78

version 1.51, 2001/10/16 19:33:26	version 1.78, 2002/04/17 16:21:46
Line 1	Line 1
# The LearningOnline Network with CAPA	# The LearningOnline Network with CAPA
# Publication Handler	# Publication Handler
	#
	# $Id$
	#
	# Copyright Michigan State University Board of Trustees
	#
	# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
	#
	# LON-CAPA is free software; you can redistribute it and/or modify
	# it under the terms of the GNU General Public License as published by
	# the Free Software Foundation; either version 2 of the License, or
	# (at your option) any later version.
	#
	# LON-CAPA is distributed in the hope that it will be useful,
	# but WITHOUT ANY WARRANTY; without even the implied warranty of
	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	# GNU General Public License for more details.
	#
	# You should have received a copy of the GNU General Public License
	# along with LON-CAPA; if not, write to the Free Software
	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	#
	# /home/httpd/html/adm/gpl.txt
	#
	# http://www.lon-capa.org/
	#
#	#
# (TeX Content Handler	# (TeX Content Handler
#	#
Line 12	Line 37
# 05/03,05/05,05/07 Gerd Kortemeyer	# 05/03,05/05,05/07 Gerd Kortemeyer
# 05/28/2001 Scott Harrison	# 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/05 Gerd Kortemeyer
	# 12/05 Guy Albertelli
	# 12/06,12/07 Gerd Kortemeyer
	# 12/15,12/16 Scott Harrison
	# 12/25 Gerd Kortemeyer
	# YEAR=2002
	# 1/16,1/17 Scott Harrison
	# 1/17 Gerd Kortemeyer
	#
	###

	###############################################################################
	## ##
	## ORGANIZATION OF THIS PERL MODULE ##
	## ##
	## 1. Modules used by this module ##
	## 2. Various subroutines ##
	## 3. Publication Step One ##
	## 4. Phase Two ##
	## 5. Main Handler ##
	## ##
	###############################################################################

package Apache::lonpublisher;	package Apache::lonpublisher;

	# ------------------------------------------------- modules used by this module
use strict;	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;
use DBI;	use DBI;
	use Apache::lonnet();
	use Apache::loncommon();

my %addid;	my %addid;
my %nokey;	my %nokey;
my %language;
my %cprtag;

my %metadatafields;	my %metadatafields;
my %metadatakeys;	my %metadatakeys;
Line 39 my $cuname;	Line 88 my $cuname;
my $cudom;	my $cudom;

# ----------------------------------------------- Evaluate string with metadata	# ----------------------------------------------- Evaluate string with metadata

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 61 sub metaeval {	Line 109 sub metaeval {
if (defined($token->[2]->{'name'})) {	if (defined($token->[2]->{'name'})) {
$unikey.='_'.$token->[2]->{'name'};	$unikey.='_'.$token->[2]->{'name'};
}	}
map {	foreach (@{$token->[3]}) {
$metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};	$metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
if ($metadatakeys{$unikey}) {	if ($metadatakeys{$unikey}) {
$metadatakeys{$unikey}.=','.$_;	$metadatakeys{$unikey}.=','.$_;
} else {	} else {
$metadatakeys{$unikey}=$_;	$metadatakeys{$unikey}=$_;
}	}
} @{$token->[3]};	}
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}=~/$newentry/) \|\|
Line 83 sub metaeval {	Line 131 sub metaeval {
}	}

# -------------------------------------------------------- Read a metadata file	# -------------------------------------------------------- Read a metadata file

sub metaread {	sub metaread {
my ($logfile,$fn)=@_;	my ($logfile,$fn)=@_;
unless (-e $fn) {	unless (-e $fn) {
Line 102 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 122 sub hiddenfield {	Line 170 sub hiddenfield {
}	}

sub selectbox {	sub selectbox {
my ($title,$name,$value,%options)=@_;	my ($title,$name,$value,$functionref,@idlist)=@_;
my $selout="\n<p><b>$title:</b><br>".'<select name="'.$name.'">';	my $uctitle=uc($title);
map {	my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
$selout.='<option value="'.$_.'"';	"</b></font><br />".'<select name="'.$name.'">';
if ($_ eq $value) { $selout.=' selected'; }	foreach (@idlist) {
$selout.='>'.$options{$_}.'</option>';	$selout.='<option value=\''.$_.'\'';
} sort keys %options;	if ($_ eq $value) {
	$selout.=' selected>'.&{$functionref}($_).'</option>';
	}
	else {$selout.='>'.&{$functionref}($_).'</option>';}
	}
return $selout.'</select>';	return $selout.'</select>';
}	}

Line 137 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\:\/\/)*([^\/]+)/);
map {	foreach (values %Apache::lonnet::hostname) {
if ($_ eq $host) {	if ($_ eq $host) {
$url=~s/^http\:\/\///;	$url=~s/^http\:\/\///;
$url=~s/^$host//;	$url=~s/^$host//;
}	}
} values %Apache::lonnet::hostname;	}
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 193 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 224 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);
my $token;	my $token;
while ($token=$parser->get_token) {	while ($token=$parser->get_token) {
if ($token->[0] eq 'S') {	if ($token->[0] eq 'S') {
my $counter;	my $counter;
my $tag=$token->[1];	my $tag=$token->[1];
unless ($tag eq 'allow') {	my $lctag=lc($tag);
	unless ($lctag eq 'allow') {
my %parms=%{$token->[2]};	my %parms=%{$token->[2]};
if ($counter=$addid{$tag}) {	$counter=$addid{$tag};
	if (!$counter) { $counter=$addid{$lctag}; }
	if ($counter) {
if ($counter eq 'id') {	if ($counter eq 'id') {
unless (defined($parms{'id'})) {	unless (defined($parms{'id'})) {
$maxid++;	$maxid++;
Line 246 sub publish {	Line 314 sub publish {
print $logfile 'Index: '.$tag.':'.$maxindex."\n";	print $logfile 'Index: '.$tag.':'.$maxindex."\n";
}	}
}	}
}	}

map {	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;
}	}
} ('src','href','background');	}

if ($tag eq 'applet') {	if ($lctag eq 'applet') {
my $codebase='';	my $codebase='';
if (defined($parms{'codebase'})) {	if (defined($parms{'codebase'})) {
my $oldcodebase=$parms{'codebase'};	my $oldcodebase=$parms{'codebase'};
Line 276 sub publish {	Line 352 sub publish {
$oldcodebase.' - '.	$oldcodebase.' - '.
$codebase."\n";	$codebase."\n";
}	}
$allow{$codebase.'/*'}=1;	$allow{&absoluteurl($codebase,$target).'/*'}=1;
} else {	} else {
map {	foreach ('archive','code','object') {
if (defined($parms{$_})) {	if (defined($parms{$_})) {
my $oldurl=$parms{$_};	my $oldurl=$parms{$_};
my $newurl=&urlfixup($oldurl,$target);	my $newurl=&urlfixup($oldurl,$target);
Line 286 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;
}	}
} ('archive','code','object');	}
}	}
}	}

my $newparmstring='';	my $newparmstring='';
my $endtag='';	my $endtag='';
map {	foreach (keys %parms) {
if ($_ eq '/') {	if ($_ eq '/') {
$endtag=' /';	$endtag=' /';
} else {	} else {
my $quote=($parms{$_}=~/\"/?"'":'"');	my $quote=($parms{$_}=~/\"/?"'":'"');
$newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote;	$newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote;
}	}
} keys %parms;	}
	if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
$outstring.='<'.$tag.$newparmstring.$endtag.'>';	$outstring.='<'.$tag.$newparmstring.$endtag.'>';
} else {	} else {
$allow{$token->[2]->{'src'}}=1;	$allow{$token->[2]->{'src'}}=1;
}	}
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
	if ($token->[2]) {
unless ($token->[1] eq 'allow') {	unless ($token->[1] eq 'allow') {
$outstring.='</'.$token->[1].'>';	$outstring.='</'.$token->[1].'>';
}	}
	}
} else {	} else {
$outstring.=$token->[1];	$outstring.=$token->[1];
}	}
}	}
# ------------------------------------------------------------ Construct Allows	# ------------------------------------------------------------ Construct Allows
unless ($style eq 'rat') {
$scrout.='<h3>Dependencies</h3>';	$scrout.='<h3>Dependencies</h3>';
my $allowstr="\n";	my $allowstr='';
map {	foreach (sort(keys(%allow))) {
$allowstr.='<allow src="'.$_.'" />'."\n";	my $thisdep=$_;
	if ($thisdep !~ /[^\s]/) { next; }
	unless ($style eq 'rat') {
	$allowstr.="\n".'<allow src="'.$thisdep.'" />';
	}
$scrout.='<br>';	$scrout.='<br>';
unless ($_=~/\*/) {	unless ($thisdep=~/\*/) {
$scrout.='<a href="'.$_.'">';	$scrout.='<a href="'.$thisdep.'">';
}	}
$scrout.='<tt>'.$_.'</tt>';	$scrout.='<tt>'.$thisdep.'</tt>';
unless ($_=~/\*/) {	unless ($thisdep=~/\*/) {
$scrout.='</a>';	$scrout.='</a>';
	if (
	&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
	$thisdep.'.meta') eq '-1') {
	$scrout.=
	' - <font color=red>Currently not available</font>';
	} else {
	my %temphash=(&Apache::lonnet::declutter($target).'___'.
	&Apache::lonnet::declutter($thisdep).'___usage'
	=> time);
	$thisdep=~/^\/res\/(\w+)\/(\w+)\//;
	if ((defined($1)) && (defined($2))) {
	&Apache::lonnet::put('resevaldata',\%temphash,$1,$2);
	}
	}
}	}
} keys %allow;	}
	$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 384 sub publish {	Line 483 sub publish {

my $currentpath='/home/'.$cuname.'/';	my $currentpath='/home/'.$cuname.'/';

map {	foreach (@urlparts) {
$currentpath.=$_.'/';	$currentpath.=$_.'/';
$scrout.=&metaread($logfile,$currentpath.'default.meta');	$scrout.=&metaread($logfile,$currentpath.'default.meta');
} @urlparts;	}

# ------------------- Clear out parameters and stores (there should not be any)	# ------------------- Clear out parameters and stores (there should not be any)

map {	foreach (keys %metadatafields) {
if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {	if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {
delete $metadatafields{$_};	delete $metadatafields{$_};
}	}
} keys %metadatafields;	}

} else {	} else {
# ---------------------- Read previous metafile, remember parameters and stores	# ---------------------- Read previous metafile, remember parameters and stores

$scrout.=&metaread($logfile,$source.'.meta');	$scrout.=&metaread($logfile,$source.'.meta');

map {	foreach (keys %metadatafields) {
if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {	if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {
$oldparmstores{$_}=1;	$oldparmstores{$_}=1;
delete $metadatafields{$_};	delete $metadatafields{$_};
}	}
} keys %metadatafields;	}

}	}

Line 424 sub publish {	Line 523 sub publish {
# ---------------- Find and document discrepancies in the parameters and stores	# ---------------- Find and document discrepancies in the parameters and stores

my $chparms='';	my $chparms='';
map {	foreach (sort keys %metadatafields) {
if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {	if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {
unless ($_=~/\.\w+$/) {	unless ($_=~/\.\w+$/) {
unless ($oldparmstores{$_}) {	unless ($oldparmstores{$_}) {
Line 433 sub publish {	Line 532 sub publish {
}	}
}	}
}	}
} sort keys %metadatafields;	}
if ($chparms) {	if ($chparms) {
$scrout.='<p><b>New parameters or stored values:</b> '.	$scrout.='<p><b>New parameters or stored values:</b> '.
$chparms;	$chparms;
}	}

my $chparms='';	$chparms='';
map {	foreach (sort keys %oldparmstores) {
if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {	if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {
unless (($metadatafields{$_.'.name'}) \|\|	unless (($metadatafields{$_.'.name'}) \|\|
($metadatafields{$_.'.package'}) \|\| ($_=~/\.\w+$/)) {	($metadatafields{$_.'.package'}) \|\| ($_=~/\.\w+$/)) {
Line 448 sub publish {	Line 547 sub publish {
$chparms.=$_.' ';	$chparms.=$_.' ';
}	}
}	}
} sort keys %oldparmstores;	}
if ($chparms) {	if ($chparms) {
$scrout.='<p><b>Obsolete parameters or stored values:</b> '.	$scrout.='<p><b>Obsolete parameters or stored values:</b> '.
$chparms;	$chparms;
Line 457 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>'.
&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)).
&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 $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;
$textonly=~s/\<script[^\<]+\<\/script\>//g;	$textonly=~s/\<script[^\<]+\<\/script\>//g;
$textonly=~s/\<m\>[^\<]+\<\/m\>//g;	$textonly=~s/\<m\>[^\<]+\<\/m\>//g;
Line 479 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) {
map {
unless ($nokey{$_}) {	unless ($nokey{$_}) {
$keywords{$_}=1;	$keywords{$_}=1;
}	}
} ($textonly=~m/(\w+)/g);	}
	}

map {
	foreach (split(/\W+/,$metadatafields{'keywords'})) {
$keywords{$_}=1;	$keywords{$_}=1;
} split(/\W+/,$metadatafields{'keywords'});	}

map {	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";
$colcount=0;	$colcount=0;
}	}
$colcount++;	$colcount++;
} sort keys %keywords;	}

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

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

Line 524 sub publish {	Line 646 sub publish {
$scrout.=&hiddenfield('mime',$1);	$scrout.=&hiddenfield('mime',$1);

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

unless ($metadatafields{'creationdate'}) {	unless ($metadatafields{'creationdate'}) {
$metadatafields{'creationdate'}=time;	$metadatafields{'creationdate'}=time;
Line 538 sub publish {	Line 663 sub publish {
$metadatafields{'owner'});	$metadatafields{'owner'});
# --------------------------------------------------- Correct copyright for rat	# --------------------------------------------------- Correct copyright for rat
if ($style eq 'rat') {	if ($style eq 'rat') {
if ($metadatafields{'copyright'} eq 'public') {	if ($metadatafields{'copyright'} eq 'public') {
delete $metadatafields{'copyright'};	delete $metadatafields{'copyright'};
}	}
delete $cprtag{'public'};
}

$scrout.=&selectbox('Copyright/Distribution','copyright',	$scrout.=&selectbox('Copyright/Distribution','copyright',
$metadatafields{'copyright'},%cprtag);	$metadatafields{'copyright'},
	\&Apache::loncommon::copyrightdescription,
	(grep !/^public$/,(&Apache::loncommon::copyrightids)));
	}
	else {
	$scrout.=&selectbox('Copyright/Distribution','copyright',
	$metadatafields{'copyright'},
	\&Apache::loncommon::copyrightdescription,
	(&Apache::loncommon::copyrightids));
	}
return $scrout.	return $scrout.
'<p><input type="submit" value="Finalize Publication"></form>';	'<p><input type="submit" value="Finalize Publication" /></p></form>';
}	}

# -------------------------------------------------------- Publication Step Two	# -------------------------------------------------------- Publication Step Two
Line 558 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 582 sub phasetwo {	Line 711 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{'dependencies'}=$ENV{'form.dependencies'};

my $allkeywords=$ENV{'form.addkey'};	my $allkeywords=$ENV{'form.addkey'};
map {	if (exists($ENV{'form.keywords'})) {
if ($_=~/^form\.key\.(\w+)/) {	my @Keywords = @{$ENV{'form.keywords'}};
$allkeywords.=','.$1;	foreach (@Keywords) {
	$allkeywords.=','.$_;
}	}
} keys %ENV;	}
$allkeywords=~s/\W+/\,/;	$allkeywords=~s/\W+/\,/;
$allkeywords=~s/^\,//;	$allkeywords=~s/^\,//;
$metadatafields{'keywords'}=$allkeywords;	$metadatafields{'keywords'}=$allkeywords;
Line 599 sub phasetwo {	Line 730 sub phasetwo {
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>';
}	}
map {	foreach (sort keys %metadatafields) {
unless ($_=~/\./) {	unless ($_=~/\./) {
my $unikey=$_;	my $unikey=$_;
$unikey=~/^([A-Za-z]+)/;	$unikey=~/^([A-Za-z]+)/;
my $tag=$1;	my $tag=$1;
$tag=~tr/A-Z/a-z/;	$tag=~tr/A-Z/a-z/;
print $mfh "\n\<$tag";	print $mfh "\n\<$tag";
map {	foreach (split(/\,/,$metadatakeys{$unikey})) {
my $value=$metadatafields{$unikey.'.'.$_};	my $value=$metadatafields{$unikey.'.'.$_};
$value=~s/\"/\'\'/g;	$value=~s/\"/\'\'/g;
print $mfh ' '.$_.'="'.$value.'"';	print $mfh ' '.$_.'="'.$value.'"';
} split(/\,/,$metadatakeys{$unikey});	}
print $mfh '>'.$metadatafields{$unikey}.'</'.$tag.'>';	print $mfh '>'.
	&HTML::Entities::encode($metadatafields{$unikey})
	.'</'.$tag.'>';
}	}
} sort keys %metadatafields;	}
$scrout.='<p>Wrote Metadata';	$scrout.='<p>Wrote Metadata';
print $logfile "\nWrote metadata";	print $logfile "\nWrote metadata";
}	}

# -------------------------------- Synchronize entry with SQL metadata database	# -------------------------------- Synchronize entry with SQL metadata database
my %perlvar;	my $warning;
open (CONFIG,"/etc/httpd/conf/access.conf") \|\| die "Can't read access.conf";
my $configline;	unless ($metadatafields{'copyright'} eq 'priv') {
while ($configline=<CONFIG>) {
if ($configline =~ /PerlSetVar/) {
my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
chomp($varvalue);
$perlvar{$varname}=$varvalue;
}
}
close(CONFIG);

my $warning;
my $dbh;	my $dbh;
{	{
unless (	unless (
$dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})	$dbh = DBI->connect("DBI:mysql:loncapa","www",
	$Apache::lonnet::perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0})
) {	) {
$warning='<font color=red>WARNING: Cannot connect to '.	$warning='<font color=red>WARNING: Cannot connect to '.
'database!</font>';	'database!</font>';
Line 648 sub phasetwo {	Line 773 sub phasetwo {
'delete from metadata where url like binary'.	'delete from metadata where url like binary'.
'"'.$sqldatafields{'url'}.'"');	'"'.$sqldatafields{'url'}.'"');
$sth->execute();	$sth->execute();
map {my $field=$metadatafields{$_}; $field=~s/\"/\'\'/g;	foreach ('title','author','subject','keywords','notes','abstract',
$sqldatafields{$_}=$field;}
('title','author','subject','keywords','notes','abstract',
'mime','language','creationdate','lastrevisiondate','owner',	'mime','language','creationdate','lastrevisiondate','owner',
'copyright');	'copyright') {
	my $field=$metadatafields{$_}; $field=~s/\"/\'\'/g;
	$sqldatafields{$_}=$field;
	}

$sth=$dbh->prepare('insert into metadata values ('.	$sth=$dbh->prepare('insert into metadata values ('.
'"'.delete($sqldatafields{'title'}).'"'.','.	'"'.delete($sqldatafields{'title'}).'"'.','.
Line 681 sub phasetwo {	Line 807 sub phasetwo {
}	}
}	}

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

if (-e $target) {	if (-e $target) {
Line 840 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 860 sub handler {	Line 990 sub handler {

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

map {	foreach (split(/&/,$ENV{'QUERY_STRING'})) {
my ($name, $value) = split(/=/,$_);	my ($name, $value) = split(/=/,$_);
$value =~ tr/+/ /;	$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
Line 869 sub handler {	Line 999 sub handler {
$ENV{'form.'.$name}=$value;	$ENV{'form.'.$name}=$value;
}	}
}	}
} (split(/&/,$ENV{'QUERY_STRING'}));	}


# -------------------------------------------------------------- Check filename	# -------------------------------------------------------------- Check filename
Line 944 unless ($ENV{'form.phase'} eq 'two') {	Line 1074 unless ($ENV{'form.phase'} eq 'two') {

{	{
my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');	my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab');
map {	while (<$fh>) {
my $word=$_;	my $word=$_;
chomp($word);	chomp($word);
$nokey{$word}=1;	$nokey{$word}=1;
} <$fh>;	}
}

%language=();

{
my $fh=Apache::File->new($r->dir_config('lonTabDir').'/language.tab');
map {
$_=~/(\w+)\s+([\w\s\-]+)/;
$language{$1}=$2;
} <$fh>;
}

%cprtag=();

{
my $fh=Apache::File->new($r->dir_config('lonIncludes').'/copyright.tab');
map {
$_=~/(\w+)\s+([\w\s\-]+)/;
$cprtag{$1}=$2;
} <$fh>;
}	}

}	}
Line 987 unless ($ENV{'form.phase'} eq 'two') {	Line 1097 unless ($ENV{'form.phase'} eq 'two') {
{	{
$thisfn=~/\.(\w+)$/;	$thisfn=~/\.(\w+)$/;
my $thistype=$1;	my $thistype=$1;
my $thisembstyle=&Apache::lonnet::fileembstyle($thistype);	my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);

my $thistarget=$thisfn;	my $thistarget=$thisfn;

Line 1001 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 1009 unless ($ENV{'form.phase'} eq 'two') {	Line 1119 unless ($ENV{'form.phase'} eq 'two') {
'</font></h3>');	'</font></h3>');
}	}

if (&Apache::lonnet::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>');	'&versionone=priv" target=cat>Diffs with Current Version</a><p>');
Line 1034 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.51
changed lines
	Added in v.1.78