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.55 and 1.83

version 1.55, 2001/12/04 18:10:37	version 1.83, 2002/06/24 14:25:38
Line 37	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 64 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 86 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 108 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 127 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 147 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 162 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 178 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 218 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 249 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) {
if ($token->[0] eq 'S') {	if ($token->[0] eq 'S') {
my $counter;	my $counter;
my $tag=$token->[1];	my $tag=$token->[1];
my $lctag=$tag;$lctag=~s/[A-Z]/[a-z]/g;	my $lctag=lc($tag);
unless ($lctag eq 'allow') {	unless ($lctag eq 'allow') {
my %parms=%{$token->[2]};	my %parms=%{$token->[2]};
$counter=$addid{$tag};	$counter=$addid{$tag};
Line 275 sub publish {	Line 332 sub publish {
print $logfile 'Index: '.$tag.':'.$maxindex."\n";	print $logfile 'Index: '.$tag.':'.$maxindex."\n";
}	}
}	}
}	}

map {
if (defined($parms{$_})) {
my $oldurl=$parms{$_};
my $newurl=&urlfixup($oldurl,$target);
if ($newurl ne $oldurl) {
$parms{$_}=$newurl;
print $logfile 'URL: '.$tag.':'.$oldurl.' - '.
$newurl."\n";
}
$allow{$newurl}=1;
}
} ('src','href','background');

	foreach my $type ('src','href','background','bgimg') {
	foreach my $key (keys(%parms)) {
	print $logfile "for $type, and $key\n";
	if ($key =~ /^$type$/i) {
	print $logfile "calling set_allow\n";
	$parms{$key}=&set_allow(\%allow,$logfile,
	$target,$tag,
	$parms{$key});
	}
	}
	}
	# 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 305 sub publish {	Line 370 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 315 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;
}	}
} ('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;	}
$outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;	$outstring=~s/\n(\<\/[^\>]+\>)\s$/$allowstr\n$1\n/s;
}
	#Encode any High ASCII characters
	$outstring=&HTML::Entities::encode($outstring,"\200-\377");
# ------------------------------------------------------------- Write modified	# ------------------------------------------------------------- Write modified

{	{
Line 413 sub publish {	Line 500 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 445 sub publish {	Line 532 sub publish {
my $oldenv=$ENV{'request.uri'};	my $oldenv=$ENV{'request.uri'};

$ENV{'request.uri'}=$target;	$ENV{'request.uri'}=$target;
$allmeta=Apache::lonxml::xmlparse('meta',$content);	$allmeta=Apache::lonxml::xmlparse(undef,'meta',$content);
$ENV{'request.uri'}=$oldenv;	$ENV{'request.uri'}=$oldenv;

&metaeval($allmeta);	&metaeval($allmeta);
Line 453 sub publish {	Line 540 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 462 sub publish {	Line 549 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 477 sub publish {	Line 564 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 486 sub publish {	Line 573 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;
Line 508 sub publish {	Line 617 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 553 sub publish {	Line 663 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 567 sub publish {	Line 680 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 587 sub phasetwo {	Line 705 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 611 sub phasetwo {	Line 728 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'}) && (ref($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 628 sub phasetwo {	Line 747 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 677 sub phasetwo {	Line 790 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 710 sub phasetwo {	Line 824 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 869 if (-e $target) {	Line 987 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 889 sub handler {	Line 1007 sub handler {

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

map {	&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;
}
}
} (split(/&/,$ENV{'QUERY_STRING'}));


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

Line 973 unless ($ENV{'form.phase'} eq 'two') {	Line 1082 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 1016 unless ($ENV{'form.phase'} eq 'two') {	Line 1105 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 1030 unless ($ENV{'form.phase'} eq 'two') {	Line 1119 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 1038 unless ($ENV{'form.phase'} eq 'two') {	Line 1127 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 1063 unless ($ENV{'form.phase'} eq 'two') {	Line 1152 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.55
changed lines
	Added in v.1.83