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.60 and 1.72

version 1.60, 2001/12/05 21:17:56	version 1.72, 2002/01/18 16:48:14
Line 39	Line 39
# 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/04,12/05 Guy Albertelli
# 12/05 Gerd Kortemeyer	# 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;
Line 51 use Apache::lonxml;	Line 73 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 66 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;

Line 88 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 110 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 129 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 149 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 164 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 277 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";
	}
	$allow{&absoluteurl($newurl,$target)}=1;
}	}
$allow{$newurl}=1;	last;
}	}
} ('src','href','background');	}

if ($lctag eq 'applet') {	if ($lctag eq 'applet') {
my $codebase='';	my $codebase='';
Line 307 sub publish {	Line 347 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 317 sub publish {	Line 357 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=' /'; }; }	if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
$outstring.='<'.$tag.$newparmstring.$endtag.'>';	$outstring.='<'.$tag.$newparmstring.$endtag.'>';
} else {	} else {
Line 349 sub publish {	Line 389 sub publish {
}	}
}	}
# ------------------------------------------------------------ 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) {
my $thisdep=$_;	my $thisdep=$_;
$allowstr.='<allow src="'.$thisdep.'" />'."\n";	unless ($style eq 'rat') {
	$allowstr.="\n".'<allow src="'.$thisdep.'" />';
	}
$scrout.='<br>';	$scrout.='<br>';
unless ($thisdep=~/\*/) {	unless ($thisdep=~/\*/) {
$scrout.='<a href="'.$thisdep.'">';	$scrout.='<a href="'.$thisdep.'">';
Line 377 sub publish {	Line 419 sub publish {
}	}
}	}
}	}
} keys %allow;	}
	$allowstr=~s/\n+/\n/g;
$outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;	$outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;
}
# ------------------------------------------------------------- Write modified	# ------------------------------------------------------------- Write modified

{	{
Line 432 sub publish {	Line 475 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 472 sub publish {	Line 515 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 481 sub publish {	Line 524 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 496 sub publish {	Line 539 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 506 sub publish {	Line 549 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)).
Line 518 sub publish {	Line 562 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 528 sub publish {	Line 573 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 573 sub publish {	Line 619 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 587 sub publish {	Line 636 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 634 sub phasetwo {	Line 688 sub phasetwo {
$metadatafields{'dependencies'}=$ENV{'form.dependencies'};	$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 649 sub phasetwo {	Line 703 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 698 sub phasetwo {	Line 744 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 731 sub phasetwo {	Line 778 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 910 sub handler {	Line 961 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 919 sub handler {	Line 970 sub handler {
$ENV{'form.'.$name}=$value;	$ENV{'form.'.$name}=$value;
}	}
}	}
} (split(/&/,$ENV{'QUERY_STRING'}));	}


# -------------------------------------------------------------- Check filename	# -------------------------------------------------------------- Check filename
Line 994 unless ($ENV{'form.phase'} eq 'two') {	Line 1045 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 1037 unless ($ENV{'form.phase'} eq 'two') {	Line 1068 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 1051 unless ($ENV{'form.phase'} eq 'two') {	Line 1082 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 1059 unless ($ENV{'form.phase'} eq 'two') {	Line 1090 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 1084 unless ($ENV{'form.phase'} eq 'two') {	Line 1115 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.60
changed lines
	Added in v.1.72