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.41 and 1.68

version 1.41, 2001/08/17 21:25:36	version 1.68, 2002/01/08 21:14:53
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 11	Line 36
# 04/16/2001 Scott Harrison	# 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	# 05/28/2001 Scott Harrison
# 06/23,08/07,08/11,8/13,8/17 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
	#
	###

	###############################################################################
	## ##
	## 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;
Line 24 use Apache::lonxml;	Line 70 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 85 my $cuname;
my $cudom;	my $cudom;

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

sub metaeval {	sub metaeval {
my $metastring=shift;	my $metastring=shift;

Line 61 sub metaeval {	Line 106 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 128 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 122 sub hiddenfield {	Line 166 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 185 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; }
	#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/;
if ($target) {	if ($target) {
Line 225 sub publish {	Line 277 sub publish {
}	}
my $outstring='';	my $outstring='';
my $parser=HTML::TokeParser->new(\$content);	my $parser=HTML::TokeParser->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 248 sub publish {	Line 304 sub publish {
}	}
}	}

map {	foreach ('src','href','background') {
if (defined($parms{$_})) {	if (defined($parms{$_})) {
my $oldurl=$parms{$_};	my $oldurl=$parms{$_};
my $newurl=&urlfixup($oldurl,$target);	my $newurl=&urlfixup($oldurl,$target);
Line 259 sub publish {	Line 315 sub publish {
}	}
$allow{$newurl}=1;	$allow{$newurl}=1;
}	}
} ('src','href');	}

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 278 sub publish {	Line 334 sub publish {
}	}
$allow{$codebase.'/*'}=1;	$allow{$codebase.'/*'}=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 288 sub publish {	Line 344 sub publish {
$newurl."\n";	$newurl."\n";
$allow{$newurl}=1;	$allow{$newurl}=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') {
my $allowstr="\n";	$scrout.='<h3>Dependencies</h3>';
map {	my $allowstr='';
$allowstr.='<allow src="'.$_.'" />'."\n";	foreach (keys %allow) {
} keys %allow;	my $thisdep=$_;
	unless ($style eq 'rat') {
	$allowstr.="\n".'<allow src="'.$thisdep.'" />';
	}
	$scrout.='<br>';
	unless ($thisdep=~/\*/) {
	$scrout.='<a href="'.$thisdep.'">';
	}
	$scrout.='<tt>'.$thisdep.'</tt>';
	unless ($thisdep=~/\*/) {
	$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);
	}
	}
	}
	}
$outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;	$outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;
}
# ------------------------------------------------------------- Write modified	# ------------------------------------------------------------- Write modified

{	{
Line 352 sub publish {	Line 436 sub publish {
%metadatakeys=();	%metadatakeys=();

my %oldparmstores=();	my %oldparmstores=();

	$scrout.='<h3>Metadata Information</h3>';

# ------------------------------------------------ First, check out environment	# ------------------------------------------------ First, check out environment
unless (-e $source.'.meta') {	unless (-e $source.'.meta') {
Line 373 sub publish {	Line 459 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;	}

}	}

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

	$ENV{'request.uri'}=$target;
$allmeta=Apache::lonxml::xmlparse('meta',$content);	$allmeta=Apache::lonxml::xmlparse('meta',$content);
	$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='';
map {	foreach (sort keys %metadatafields) {
if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {	if (($_=~/^parameter/) \|\| ($_=~/^stores/)) {
unless ($_=~/\.\w+$/) {	unless ($_=~/\.\w+$/) {
unless ($oldparmstores{$_}) {	unless ($oldparmstores{$_}) {
Line 418 sub publish {	Line 508 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='';	my $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 433 sub publish {	Line 523 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 443 sub publish {	Line 533 sub publish {

$scrout.=	$scrout.=
'<form action="/adm/publish" method="post">'.	'<form 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'});
Line 454 sub publish {	Line 546 sub publish {

my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';	my $keywordout='<p><b>Keywords:</b><br><table border=2><tr>';
my $colcount=0;	my $colcount=0;
	my %keywords=();

{	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 464 sub publish {	Line 557 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="key.'.$_.'"';
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;	}
$keywordout.='</tr></table>';

}

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

	$scrout.=$keywordout;

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

Line 506 sub publish {	Line 603 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 518 sub publish {	Line 618 sub publish {

$scrout.=&textfield('Publisher/Owner','owner',	$scrout.=&textfield('Publisher/Owner','owner',
$metadatafields{'owner'});	$metadatafields{'owner'});
	# --------------------------------------------------- Correct copyright for rat
	if ($style eq 'rat') {
	if ($metadatafields{'copyright'} eq 'public') {
	delete $metadatafields{'copyright'};
	}
$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 557 sub phasetwo {	Line 669 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 {	foreach (keys %ENV) {
if ($_=~/^form\.key\.(\w+)/) {	if ($_=~/^form\.key\.(\w+)/) {
$allkeywords.=','.$1;	$allkeywords.=','.$1;
}	}
} keys %ENV;	}
$allkeywords=~s/\W+/\,/;	$allkeywords=~s/\W+/\,/;
$allkeywords=~s/^\,//;	$allkeywords=~s/^\,//;
$metadatafields{'keywords'}=$allkeywords;	$metadatafields{'keywords'}=$allkeywords;
Line 574 sub phasetwo {	Line 687 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 '>'.$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 623 sub phasetwo {	Line 728 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 656 sub phasetwo {	Line 762 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 833 sub handler {	Line 943 sub handler {
return OK;	return OK;
}	}

	# Get query string for limited number of parameters

	foreach (split(/&/,$ENV{'QUERY_STRING'})) {
	my ($name, $value) = split(/=/,$_);
	$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

my $fn=$ENV{'form.filename'};	my $fn=$ENV{'form.filename'};
Line 864 sub handler {	Line 988 sub handler {
return HTTP_NOT_ACCEPTABLE;	return HTTP_NOT_ACCEPTABLE;
}	}

$fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;	$fn=~s/^http\:\/\/[^\/]+//;
	$fn=~s/^\/\~(\w+)/\/home\/$1\/public_html/;

my $targetdir='';	my $targetdir='';
$docroot=$r->dir_config('lonDocRoot');	$docroot=$r->dir_config('lonDocRoot');
Line 904 unless ($ENV{'form.phase'} eq 'two') {	Line 1029 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 947 unless ($ENV{'form.phase'} eq 'two') {	Line 1052 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 961 unless ($ENV{'form.phase'} eq 'two') {	Line 1066 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 969 unless ($ENV{'form.phase'} eq 'two') {	Line 1074 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 994 unless ($ENV{'form.phase'} eq 'two') {	Line 1099 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.41
changed lines
	Added in v.1.68