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.56 and 1.70

version 1.56, 2001/12/05 15:40:31	version 1.70, 2002/01/16 19:09:31
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
	#
	###

	###############################################################################
	## ##
	## 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 49 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 64 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 86 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 108 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 127 sub metaread {	Line 146 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 167 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 186 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/;
if ($target) {	if ($target) {
Line 277 sub publish {	Line 306 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 288 sub publish {	Line 317 sub publish {
}	}
$allow{$newurl}=1;	$allow{$newurl}=1;
}	}
} ('src','href','background');	}

if ($lctag eq 'applet') {	if ($lctag eq 'applet') {
my $codebase='';	my $codebase='';
Line 307 sub publish {	Line 336 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 317 sub publish {	Line 346 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') {
$scrout.='<h3>Dependencies</h3>';	$scrout.='<h3>Dependencies</h3>';
my $allowstr="\n";	my $allowstr='';
map {	foreach (keys %allow) {
$allowstr.='<allow src="'.$_.'" />'."\n";	my $thisdep=$_;
	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/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;
}
# ------------------------------------------------------------- Write modified	# ------------------------------------------------------------- Write modified

{	{
Line 413 sub publish {	Line 461 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 453 sub publish {	Line 501 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 510 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 525 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 487 sub publish {	Line 535 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 498 sub publish {	Line 548 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) {	if (length($content)<500000) {
my $textonly=$content;	my $textonly=$content;
Line 508 sub publish {	Line 559 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;	}

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

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

Line 553 sub publish {	Line 605 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 622 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 611 sub phasetwo {	Line 671 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 628 sub phasetwo {	Line 689 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 677 sub phasetwo {	Line 730 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 764 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 889 sub handler {	Line 947 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 898 sub handler {	Line 956 sub handler {
$ENV{'form.'.$name}=$value;	$ENV{'form.'.$name}=$value;
}	}
}	}
} (split(/&/,$ENV{'QUERY_STRING'}));	}


# -------------------------------------------------------------- Check filename	# -------------------------------------------------------------- Check filename
Line 973 unless ($ENV{'form.phase'} eq 'two') {	Line 1031 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 1054 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 1068 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 1076 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 1101 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.56
changed lines
	Added in v.1.70