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.138 and 1.152

version 1.138, 2003/09/25 22:30:06	version 1.152, 2003/12/26 19:12:51
Line 25	Line 25
#	#
# http://www.lon-capa.org/	# http://www.lon-capa.org/
#	#
#
# (TeX Content Handler
#
# 05/29/00,05/30,10/11 Gerd Kortemeyer)
#
# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
# 03/23 Guy Albertelli
# 03/24,03/29,04/03 Gerd Kortemeyer
# 05/03,05/05,05/07 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/25 Gerd Kortemeyer
# YEAR=2002
# 1/17 Gerd Kortemeyer
#
###	###

###############################################################################	###############################################################################
Line 143 use Apache::lonnet();	Line 125 use Apache::lonnet();
use Apache::loncommon();	use Apache::loncommon();
use Apache::lonmysql;	use Apache::lonmysql;
use Apache::lonlocal;	use Apache::lonlocal;
	use Apache::loncfile;
use vars qw(%metadatafields %metadatakeys);	use vars qw(%metadatafields %metadatakeys);

my %addid;	my %addid;
Line 180 nothing	Line 163 nothing

#########################################	#########################################
#########################################	#########################################
	#
	# Modifies global %metadatafields %metadatakeys
	#

sub metaeval {	sub metaeval {
my $metastring=shift;	my ($metastring,$prefix)=@_;

my $parser=HTML::LCParser->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') {
my $entry=$token->[1];	my $entry=$token->[1];
my $unikey=$entry;	my $unikey=$entry;
if (defined($token->[2]->{'package'})) {	if (defined($token->[2]->{'package'})) {
$unikey.='_package_'.$token->[2]->{'package'};	$unikey.='_package_'.$token->[2]->{'package'};
}	}
if (defined($token->[2]->{'part'})) {	if (defined($token->[2]->{'part'})) {
$unikey.='_'.$token->[2]->{'part'};	$unikey.='_'.$token->[2]->{'part'};
}	}
if (defined($token->[2]->{'id'})) {	if (defined($token->[2]->{'id'})) {
$unikey.='_'.$token->[2]->{'id'};	$unikey.='_'.$token->[2]->{'id'};
}	}
if (defined($token->[2]->{'name'})) {	if (defined($token->[2]->{'name'})) {
$unikey.='_'.$token->[2]->{'name'};	$unikey.='_'.$token->[2]->{'name'};
}	}
foreach (@{$token->[3]}) {	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}=$_;
}	}
}	}
if ($metadatafields{$unikey}) {	my $newentry=$parser->get_text('/'.$entry);
my $newentry=$parser->get_text('/'.$entry);	if ($entry eq 'customdistributionfile') {
unless (($metadatafields{$unikey}=~/\Q$newentry\E/) \|\|	$newentry=~s/^\s*//;
($newentry eq '')) {	if ($newentry !~m\|^/res\|) { $newentry=$prefix.$newentry; }
$metadatafields{$unikey}.=', '.$newentry;	}
}	# actually store
} else {	$metadatafields{$unikey}=$newentry;
$metadatafields{$unikey}=$parser->get_text('/'.$entry);	}
}	}
}
}
}	}

#########################################	#########################################
Line 260 XHTML text that indicates successful rea	Line 245 XHTML text that indicates successful rea
#########################################	#########################################
#########################################	#########################################
sub metaread {	sub metaread {
my ($logfile,$fn)=@_;	my ($logfile,$fn,$prefix)=@_;
unless (-e $fn) {	unless (-e $fn) {
print($logfile 'No file '.$fn."\n");	print($logfile 'No file '.$fn."\n");
return '<br /><b>No file:</b> <tt>'.$fn.'</tt>';	return '<br /><b>'.&mt('No file').':</b> <tt>'.
	&Apache::loncfile::display($fn).'</tt>';
}	}
print($logfile 'Processing '.$fn."\n");	print($logfile 'Processing '.$fn."\n");
my $metastring;	my $metastring;
{	{
my $metafh=Apache::File->new($fn);	my $metafh=Apache::File->new($fn);
$metastring=join('',<$metafh>);	$metastring=join('',<$metafh>);
}	}
&metaeval($metastring);	&metaeval($metastring,$prefix);
return '<br /><b>Processed file:</b> <tt>'.$fn.'</tt>';	return '<br /><b>'.&mt('Processed file').':</b> <tt>'.
	&Apache::loncfile::display($fn).'</tt>';
}	}

#########################################	#########################################
Line 325 string which presents the form field (fo	Line 312 string which presents the form field (fo
#########################################	#########################################
sub textfield {	sub textfield {
my ($title,$name,$value)=@_;	my ($title,$name,$value)=@_;
	$value=~s/^\s+//gs;
	$value=~s/\s+$//gs;
	$value=~s/\s+/ /gs;
$title=&mt($title);	$title=&mt($title);
my $uctitle=uc($title);	my $uctitle=uc($title);
return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".	return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
Line 619 sub fix_ids_and_indices {	Line 609 sub fix_ids_and_indices {
join(', ',@duplicatedids));	join(', ',@duplicatedids));
if ($duplicateids) {	if ($duplicateids) {
print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n";	print $logfile "Duplicate ID(s) exist, ".join(', ',@duplicatedids)."\n";
my $outstring='<font color="red">Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are: '.join(', ',@duplicatedids).'</font>';	my $outstring='<font color="red">'.&mt('Unable to publish file, it contains duplicated ID(s), ID(s) need to be unique. The duplicated ID(s) are').': '.join(', ',@duplicatedids).'</font>';
return ($outstring,1);	return ($outstring,1);
}	}
if ($needsfixup) {	if ($needsfixup) {
Line 684 sub fix_ids_and_indices {	Line 674 sub fix_ids_and_indices {
}	}
if ($lctag eq 'applet') {	if ($lctag eq 'applet') {
my $codebase='';	my $codebase='';
if (defined($parms{'codebase'})) {	my $havecodebase=0;
my $oldcodebase=$parms{'codebase'};	foreach my $key (keys(%parms)) {
	if (lc($key) eq 'codebase') {
	$codebase=$parms{$key};
	$havecodebase=1;
	}
	}
	if ($havecodebase) {
	my $oldcodebase=$codebase;
unless ($oldcodebase=~/\/$/) {	unless ($oldcodebase=~/\/$/) {
$oldcodebase.='/';	$oldcodebase.='/';
}	}
Line 699 sub fix_ids_and_indices {	Line 696 sub fix_ids_and_indices {
}	}
$allow{&absoluteurl($codebase,$target).'/*'}=1;	$allow{&absoluteurl($codebase,$target).'/*'}=1;
} else {	} else {
foreach ('archive','code','object') {	foreach my $key (keys(%parms)) {
if (defined($parms{$_})) {	if ($key =~ /(archive\|code\|object)/i) {
my $oldurl=$parms{$_};	my $oldurl=$parms{$key};
my $newurl=&urlfixup($oldurl,$target);	my $newurl=&urlfixup($oldurl,$target);
$newurl=~s/\/[^\/]+$/\/\*/;	$newurl=~s/\/[^\/]+$/\/\*/;
print $logfile 'Allow: applet '.$_.':'.	print $logfile 'Allow: applet '.lc($key).':'.
$oldurl.' allows '.	$oldurl.' allows '.$newurl."\n";
$newurl."\n";
$allow{&absoluteurl($newurl,$target)}=1;	$allow{&absoluteurl($newurl,$target)}=1;
}	}
}	}
Line 771 Returns: (error,status). error is undef	Line 767 Returns: (error,status). error is undef
#########################################	#########################################
#########################################	#########################################
sub store_metadata {	sub store_metadata {
my %metadata = %{shift()};	my %metadata = @_;
my $error;	my $error;
# Determine if the table exists	# Determine if the table exists
my $status = &Apache::lonmysql::check_table('metadata');	my $status = &Apache::lonmysql::check_table('metadata');
Line 788 sub store_metadata {	Line 784 sub store_metadata {
&Apache::lonnet::logthis($error);	&Apache::lonnet::logthis($error);
return ($error,undef);	return ($error,undef);
}	}
# Remove old value from table	if (($metadata{'obsolete'}) \|\| ($metadata{'copyright'} eq 'priv') \|\|
$status = &Apache::lonmysql::remove_from_table	($metadata{'copyright'} eq 'custom')) {
('metadata','url',$metadata{'url'});	# remove this entry
if (! defined($status)) {	$status=&Apache::lonmysql::remove_from_table
$error = '<font color="red">Error when removing old values from '.	('metadata','url',$metadata{'url'});
'metadata table in LON-CAPA database.</font>';	} else {
&Apache::lonnet::logthis($error);	# store new data
return ($error,undef);	$metadata{'creationdate'}=
	&Apache::lonmysql::sqltime($metadata{'creationdate'});
	$metadata{'lastrevisiondate'}=
	&Apache::lonmysql::sqltime($metadata{'lastrevisiondate'});
	$status = &Apache::lonmysql::store_row('metadata',\%metadata);
}	}
# Store data in table.
$status = &Apache::lonmysql::store_row('metadata',\%metadata);
if (! defined($status)) {	if (! defined($status)) {
$error='<font color="red">Error occured storing new values in '.	$error='<font color="red">Error occured storing new values in '.
'metadata table in LON-CAPA database</font>';	'metadata table in LON-CAPA database</font>';
Line 808 sub store_metadata {	Line 806 sub store_metadata {
return (undef,$status);	return (undef,$status);
}	}


	# ============================================== Parse file itself for metadata
	#
	# parses a file with target meta, sets global %metadatafields %metadatakeys

	sub parseformeta {
	my ($source,$style)=@_;
	my $allmeta='';
	if (($style eq 'ssi') \|\| ($style eq 'prv')) {
	my $dir=$source;
	$dir=~s-/[^/]*$--;
	my $file=$source;
	$file=(split('/',$file))[-1];
	$source=&Apache::lonnet::hreflocation($dir,$file);
	$allmeta=&Apache::lonnet::ssi_body($source,('grade_target' => 'meta'));
	&metaeval($allmeta);
	}
	return $allmeta;
	}

#########################################	#########################################
#########################################	#########################################

Line 839 sub publish {	Line 857 sub publish {
my %allow=();	my %allow=();

unless ($logfile=Apache::File->new('>>'.$source.'.log')) {	unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
return ('<font color="red">No write permission to user directory, FAIL</font>',1);	return ('<font color="red">'.&mt('No write permission to user directory, FAIL').'</font>',1);
}	}
print $logfile	print $logfile
"\n\n================= Publish ".localtime()." Phase One ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n";	"\n\n================= Publish ".localtime()." Phase One ================\n".$ENV{'user.name'}.'@'.$ENV{'user.domain'}."\n";
Line 863 sub publish {	Line 881 sub publish {
if ($error) { return ($outstring,$error); }	if ($error) { return ($outstring,$error); }
# ------------------------------------------------------------ Construct Allows	# ------------------------------------------------------------ Construct Allows

$scrout.='<h3>Dependencies</h3>';	$scrout.='<h3>'.&mt('Dependencies').'</h3>';
my $allowstr='';	my $allowstr='';
foreach (sort(keys(%allow))) {	foreach (sort(keys(%allow))) {
my $thisdep=$_;	my $thisdep=$_;
Line 881 sub publish {	Line 899 sub publish {
if (	if (
&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.	&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
$thisdep.'.meta') eq '-1') {	$thisdep.'.meta') eq '-1') {
$scrout.= ' - <font color="red">Currently not available'.	$scrout.= ' - <font color="red">'.&mt('Currently not available').
'</font>';	'</font>';
} else {	} else {
my %temphash=(&Apache::lonnet::declutter($target).'___'.	my %temphash=(&Apache::lonnet::declutter($target).'___'.
Line 920 sub publish {	Line 938 sub publish {
# -------------------------------------------- Initial step done, now metadata.	# -------------------------------------------- Initial step done, now metadata.

# --------------------------------------- Storage for metadata keys and fields.	# --------------------------------------- Storage for metadata keys and fields.
	# these are globals
	#
%metadatafields=();	%metadatafields=();
%metadatakeys=();	%metadatakeys=();

Line 955 sub publish {	Line 974 sub publish {

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

	my $prefix='../'x($#urlparts);
foreach (@urlparts) {	foreach (@urlparts) {
$currentpath.=$_.'/';	$currentpath.=$_.'/';
$scrout.=&metaread($logfile,$currentpath.'default.meta');	$scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);
	$prefix=~s\|^\.\./\|\|;
}	}
	# ----------------------------------------------------------- Parse file itself
	# read %metadatafields from file itself

	$allmeta=&parseformeta($source,$style);

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

Line 979 sub publish {	Line 1004 sub publish {
delete $metadatafields{$_};	delete $metadatafields{$_};
}	}
}	}
	# ------------------------------------------ See if anything new in file itself
}
	$allmeta=&parseformeta($source,$style);
# -------------------------------------------------- Parse content for metadata	}
if (($style eq 'ssi') \|\| ($style eq 'prv')) {
my $dir=$source;
$dir=~s-/[^/]*$--;
my $file=$source;
$file=(split('/',$file))[-1];
$source=&Apache::lonnet::hreflocation($dir,$file);
$allmeta=&Apache::lonnet::ssi_body($source,('grade_target' => 'meta'));

&metaeval($allmeta);
}
# ---------------- Find and document discrepancies in the parameters and stores	# ---------------- Find and document discrepancies in the parameters and stores

my $chparms='';	my $chparms='';
Line 1023 sub publish {	Line 1040 sub publish {
}	}
if ($chparms) {	if ($chparms) {
$scrout.='<p><b>'.&mt('Obsolete parameters or stored values').':</b> '.	$scrout.='<p><b>'.&mt('Obsolete parameters or stored values').':</b> '.
$chparms.'</p>';	$chparms.'</p><h1><font color="red">'.&mt('Warning!').
	'</font></h1><p><font color="red" size="+1">'.
	&mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'</font></p><hr />';
}	}

# ------------------------------------------------------- Now have all metadata	# ------------------------------------------------------- Now have all metadata
Line 1057 sub publish {	Line 1076 sub publish {
unless ($batch) {	unless ($batch) {
$scrout.=	$scrout.=
'<form name="pubform" action="/adm/publish" method="post">'.	'<form name="pubform" action="/adm/publish" method="post">'.
'<p><input type="submit" value="Finalize Publication" /></p>'.	'<p><input type="submit" value="'.&mt('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 1069 sub publish {	Line 1088 sub publish {
# --------------------------------------------------- Scan content for keywords	# --------------------------------------------------- Scan content for keywords

my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");	my $keywords_help = Apache::loncommon::help_open_topic("Publishing_Keywords");
	my $KEYWORDS=&mt('KEYWORDS');
	my $CheckAll=&mt('check all');
	my $UncheckAll=&mt('uncheck all');
my $keywordout=<<"END";	my $keywordout=<<"END";
<script>	<script>
function checkAll(field) {	function checkAll(field) {
Line 1081 function uncheckAll(field) {	Line 1103 function uncheckAll(field) {
field[i].checked = false ;	field[i].checked = false ;
}	}
</script>	</script>
<p><font color="#800000" face="helvetica"><b>KEYWORDS:</b></font>	<p><font color="#800000" face="helvetica"><b>$KEYWORDS:</b></font>
$keywords_help</b>	$keywords_help</b>
<input type="button" value="check all" onclick="javascript:checkAll(document.pubform.keywords)" />	<input type="button" value="$CheckAll" onclick="javascript:checkAll(document.pubform.keywords)" />
<input type="button" value="uncheck all" onclick="javascript:uncheckAll(document.pubform.keywords)" />	<input type="button" value="$UncheckAll" onclick="javascript:uncheckAll(document.pubform.keywords)" />
</p>	</p>
<br />	<br />
END	END
Line 1117 END	Line 1139 END
$scrout.=&textfield('Notes','notes',$metadatafields{'notes'});	$scrout.=&textfield('Notes','notes',$metadatafields{'notes'});

$scrout.=	$scrout.=
"\n<p><font color=\"#800000\" face=\"helvetica\"><b>ABSTRACT:".	"\n<p><font color=\"#800000\" face=\"helvetica\"><b>".&mt('ABSTRACT').":".
"</b></font></p><br />".	"</b></font></p><br />".
'<textarea cols="80" rows="5" name="abstract">'.	'<textarea cols="80" rows="5" name="abstract">'.
$metadatafields{'abstract'}.'</textarea></p>';	$metadatafields{'abstract'}.'</textarea></p>';

$source=~/\.(\w+)$/;	$source=~/\.(\w+)$/;


	$scrout.=
	"\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
	uc(&mt('Lowest Grade Level:')).
	"</b></font></p><br />".
	&Apache::loncommon::select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel').
	"\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
	uc(&mt('Highest Grade Level:')).
	"</b></font></p><br />".
	&Apache::loncommon::select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel').
	&textfield('Standards','standards',$metadatafields{'standards'});




$scrout.=&hiddenfield('mime',$1);	$scrout.=&hiddenfield('mime',$1);

my $defaultlanguage=$metadatafields{'language'};	my $defaultlanguage=$metadatafields{'language'};
Line 1299 sub phasetwo {	Line 1336 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{'standards'}=$ENV{'form.standards'};
	$metadatafields{'lowestgradelevel'}=$ENV{'form.lowestgradelevel'};
	$metadatafields{'highestgradelevel'}=$ENV{'form.highestgradelevel'};
$metadatafields{'customdistributionfile'}=	$metadatafields{'customdistributionfile'}=
$ENV{'form.customdistributionfile'};	$ENV{'form.customdistributionfile'};
$metadatafields{'obsolete'}=$ENV{'form.obsolete'};	$metadatafields{'obsolete'}=$ENV{'form.obsolete'};
Line 1318 sub phasetwo {	Line 1358 sub phasetwo {
$allkeywords=~s/^\,//;	$allkeywords=~s/^\,//;
$metadatafields{'keywords'}=$allkeywords;	$metadatafields{'keywords'}=$allkeywords;

	# check if custom distribution file is specified
	if ($metadatafields{'copyright'} eq 'custom') {
	my $file=$metadatafields{'customdistributionfile'};
	unless ($file=~/\.rights$/) {
	return
	'<font color="red">'.&mt('No valid custom distribution rights file specified, FAIL').
	'</font>';
	}
	}
{	{
print $logfile "\nWrite metadata file for ".$source;	print $logfile "\nWrite metadata file for ".$source;
my $mfh;	my $mfh;
Line 1351 sub phasetwo {	Line 1400 sub phasetwo {

$metadatafields{'url'} = $distarget;	$metadatafields{'url'} = $distarget;
$metadatafields{'version'} = 'current';	$metadatafields{'version'} = 'current';
unless ($metadatafields{'copyright'} eq 'priv') {
my ($error,$success) = &store_metadata(\%metadatafields);	my ($error,$success) = &store_metadata(%metadatafields);
if ($success) {	if ($success) {
$r->print('<p>'.&mt('Synchronized SQL metadata database').'</p>');	$r->print('<p>'.&mt('Synchronized SQL metadata database').'</p>');
print $logfile "\nSynchronized SQL metadata database";	print $logfile "\nSynchronized SQL metadata database";
} else {
$r->print($error);
print $logfile "\n".$error;
}
} else {	} else {
$r->print('<p>'.	$r->print($error);
&mt('Private Publication - did not synchronize database').'</p>');	print $logfile "\n".$error;
print $logfile "\nPrivate: Did not synchronize data into ".
"SQL metadata database";
}	}

# ----------------------------------------------------------- Copy old versions	# ----------------------------------------------------------- Copy old versions

if (-e $target) {	if (-e $target) {
Line 1523 sub phasetwo {	Line 1567 sub phasetwo {
'"><font size="+2">'.	'"><font size="+2">'.
&mt('Back to Source Directory').'</font></a></p>');	&mt('Back to Source Directory').'</font></a></p>');
}	}
	return '<p><font color="green">'.&mt('Done').'</font></p>';
}	}

#########################################	#########################################
Line 1542 sub batchpublish {	Line 1587 sub batchpublish {
$thisdistarget=~s/^\Q$docroot\E//;	$thisdistarget=~s/^\Q$docroot\E//;


undef %metadatafields;	%metadatafields=();
undef %metadatakeys;	%metadatakeys=();
%metadatafields=();	$srcfile=~/\.(\w+)$/;
%metadatakeys=();	my $thistype=$1;
$srcfile=~/\.(\w+)$/;
my $thistype=$1;


my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);	my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);

$r->print('<h2>'.&mt('Publishing').' <tt>'.$thisdisfn.'</tt></h2>');	$r->print('<h2>'.&mt('Publishing').' <tt>'.$thisdisfn.'</tt></h2>');

Line 1577 sub publishdirectory {	Line 1620 sub publishdirectory {
$fn=~s/\/+/\//g;	$fn=~s/\/+/\//g;
$thisdisfn=~s/\/+/\//g;	$thisdisfn=~s/\/+/\//g;
my $resdir=	my $resdir=
$Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'.	$Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'.
$thisdisfn;	$thisdisfn;
$r->print('<h1>Directory <tt>'.$thisdisfn.'</tt></h1>'.	$r->print('<h1>Directory <tt>'.$thisdisfn.'</tt></h1>'.
'Target: <tt>'.$resdir.'</tt><br />');	'Target: <tt>'.$resdir.'</tt><br />');

my $dirptr=16384; # Mask indicating a directory in stat.cmode.	my $dirptr=16384; # Mask indicating a directory in stat.cmode.

opendir(DIR,$fn);	opendir(DIR,$fn);
my @files=sort(readdir(DIR));	my @files=sort(readdir(DIR));
foreach my $filename (@files) {	foreach my $filename (@files) {
my ($cdev,$cino,$cmode,$cnlink,	my ($cdev,$cino,$cmode,$cnlink,
$cuid,$cgid,$crdev,$csize,	$cuid,$cgid,$crdev,$csize,
$catime,$cmtime,$cctime,	$catime,$cmtime,$cctime,
$cblksize,$cblocks)=stat($fn.'/'.$filename);	$cblksize,$cblocks)=stat($fn.'/'.$filename);

my $extension='';	my $extension='';
if ($filename=~/\.(\w+)$/) { $extension=$1; }	if ($filename=~/\.(\w+)$/) { $extension=$1; }
if ($cmode&$dirptr) {	if ($cmode&$dirptr) {
if (($filename!~/^\./) && ($ENV{'form.pubrec'})) {	if (($filename!~/^\./) && ($ENV{'form.pubrec'})) {
&publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);	&publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename);
}	}
} elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&	} elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') &&
($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {	($filename!~/^[\#\.]/) && ($filename!~/\~$/)) {
# find out publication status and/or exiting metadata	# find out publication status and/or exiting metadata
my $publishthis=0;	my $publishthis=0;
if (-e $resdir.'/'.$filename) {	if (-e $resdir.'/'.$filename) {
my ($rdev,$rino,$rmode,$rnlink,	my ($rdev,$rino,$rmode,$rnlink,
$ruid,$rgid,$rrdev,$rsize,	$ruid,$rgid,$rrdev,$rsize,
$ratime,$rmtime,$rctime,	$ratime,$rmtime,$rctime,
$rblksize,$rblocks)=stat($resdir.'/'.$filename);	$rblksize,$rblocks)=stat($resdir.'/'.$filename);
if (($rmtime<$cmtime) \|\| ($ENV{'form.forcerepub'})) {	if (($rmtime<$cmtime) \|\| ($ENV{'form.forcerepub'})) {
# previously published, modified now	# previously published, modified now
$publishthis=1;	$publishthis=1;
}	}
} else {	} else {
# never published	# never published
$publishthis=1;	$publishthis=1;
}	}
if ($publishthis) {	if ($publishthis) {
&batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);	&batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename);
} else {	} else {
$r->print('<br />Skipping '.$filename.'<br />');	$r->print('<br />Skipping '.$filename.'<br />');
}	}
$r->rflush();	$r->rflush();
}	}
}	}
closedir(DIR);	closedir(DIR);
}	}
#########################################	#########################################

Line 1666 Publishing from $thisfn to $thistarget w	Line 1709 Publishing from $thisfn to $thistarget w
#########################################	#########################################
#########################################	#########################################
sub handler {	sub handler {
my $r=shift;	my $r=shift;

if ($r->header_only) {	if ($r->header_only) {
&Apache::loncommon::content_type($r,'text/html');	&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;	$r->send_http_header;
return OK;	return OK;
}	}

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

Line 1681 sub handler {	Line 1724 sub handler {

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

my $fn=&Apache::lonnet::unescape($ENV{'form.filename'});	my $fn=&Apache::lonnet::unescape($ENV{'form.filename'});


unless ($fn) {	unless ($fn) {
$r->log_reason($cuname.' at '.$cudom.	$r->log_reason($cuname.' at '.$cudom.
' trying to publish empty filename', $r->filename);	' trying to publish empty filename', $r->filename);
return HTTP_NOT_FOUND;	return HTTP_NOT_FOUND;
}	}

($cuname,$cudom)=	($cuname,$cudom)=
&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));	&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));
unless (($cuname) && ($cudom)) {	unless (($cuname) && ($cudom)) {
$r->log_reason($cuname.' at '.$cudom.	$r->log_reason($cuname.' at '.$cudom.
' trying to publish file '.$ENV{'form.filename'}.	' trying to publish file '.$ENV{'form.filename'}.
' ('.$fn.') - not authorized',	' ('.$fn.') - not authorized',
$r->filename);	$r->filename);
return HTTP_NOT_ACCEPTABLE;	return HTTP_NOT_ACCEPTABLE;
}	}

unless (&Apache::lonnet::homeserver($cuname,$cudom)	unless (&Apache::lonnet::homeserver($cuname,$cudom)
eq $r->dir_config('lonHostID')) {	eq $r->dir_config('lonHostID')) {
$r->log_reason($cuname.' at '.$cudom.	$r->log_reason($cuname.' at '.$cudom.
' trying to publish file '.$ENV{'form.filename'}.	' trying to publish file '.$ENV{'form.filename'}.
' ('.$fn.') - not homeserver ('.	' ('.$fn.') - not homeserver ('.
&Apache::lonnet::homeserver($cuname,$cudom).')',	&Apache::lonnet::homeserver($cuname,$cudom).')',
$r->filename);	$r->filename);
return HTTP_NOT_ACCEPTABLE;	return HTTP_NOT_ACCEPTABLE;
}	}

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

my $targetdir='';	my $targetdir='';
$docroot=$r->dir_config('lonDocRoot');	$docroot=$r->dir_config('lonDocRoot');
if ($1 ne $cuname) {	if ($1 ne $cuname) {
$r->log_reason($cuname.' at '.$cudom.	$r->log_reason($cuname.' at '.$cudom.
' trying to publish unowned file '.$ENV{'form.filename'}.	' trying to publish unowned file '.
' ('.$fn.')',	$ENV{'form.filename'}.' ('.$fn.')',
$r->filename);	$r->filename);
return HTTP_NOT_ACCEPTABLE;	return HTTP_NOT_ACCEPTABLE;
} else {	} else {
$targetdir=$docroot.'/res/'.$cudom;	$targetdir=$docroot.'/res/'.$cudom;
}	}


unless (-e $fn) {	unless (-e $fn) {
$r->log_reason($cuname.' at '.$cudom.	$r->log_reason($cuname.' at '.$cudom.
' trying to publish non-existing file '.$ENV{'form.filename'}.	' trying to publish non-existing file '.
' ('.$fn.')',	$ENV{'form.filename'}.' ('.$fn.')',
$r->filename);	$r->filename);
return HTTP_NOT_FOUND;	return HTTP_NOT_FOUND;
}	}

unless ($ENV{'form.phase'} eq 'two') {	unless ($ENV{'form.phase'} eq 'two') {

# -------------------------------- File is there and owned, init lookup tables.	# -------------------------------- File is there and owned, init lookup tables.

%addid=();	%addid=();

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

%nokey=();

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

}	%nokey=();

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

	}

# ---------------------------------------------------------- Start page output.	# ---------------------------------------------------------- Start page output.

&Apache::loncommon::content_type($r,'text/html');	&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;	$r->send_http_header;

$r->print('<html><head><title>LON-CAPA Publishing</title></head>');	$r->print('<html><head><title>LON-CAPA Publishing</title></head>');
$r->print(&Apache::loncommon::bodytag('Resource Publication'));	$r->print(&Apache::loncommon::bodytag('Resource Publication'));


my $thisfn=$fn;	my $thisfn=$fn;

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

$thistarget=~s/^\/home/$targetdir/;	$thistarget=~s/^\/home/$targetdir/;
$thistarget=~s/\/public\_html//;	$thistarget=~s/\/public\_html//;

my $thisdistarget=$thistarget;	my $thisdistarget=$thistarget;
$thisdistarget=~s/^\Q$docroot\E//;	$thisdistarget=~s/^\Q$docroot\E//;

my $thisdisfn=$thisfn;	my $thisdisfn=$thisfn;
$thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///;	$thisdisfn=~s/^\/home\/\Q$cuname\E\/public_html\///;

if ($fn=~/\/$/) {	if ($fn=~/\/$/) {
# -------------------------------------------------------- This is a directory	# -------------------------------------------------------- This is a directory
&publishdirectory($r,$fn,$thisdisfn);	&publishdirectory($r,$fn,$thisdisfn);
$r->print('<hr><font size="+2">'.&mt('Done').'</font><br><a href="/priv/'	$r->print('<hr><font size="+2">'.&mt('Done').'</font><br><a href="/priv/'
.$cuname.'/'.$thisdisfn	.$cuname.'/'.$thisdisfn
.'">'.&mt('Return to Directory').'</a>');	.'">'.&mt('Return to Directory').'</a>');


} else {	} else {
# ---------------------- Evaluate individual file, and then output information.	# ---------------------- Evaluate individual file, and then output information.
$thisfn=~/\.(\w+)$/;	$thisfn=~/\.(\w+)$/;
my $thistype=$1;	my $thistype=$1;
my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);	my $thisembstyle=&Apache::loncommon::fileembstyle($thistype);
$r->print('<h2>'.&mt('Publishing').' '.	$r->print('<h2>'.&mt('Publishing').' '.
&Apache::loncommon::filedescription($thistype).' <tt>');	&Apache::loncommon::filedescription($thistype).' <tt>');

$r->print(<<ENDCAPTION);	$r->print(<<ENDCAPTION);
<a href='javascript:void(window.open("/~$cuname/$thisdisfn","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>	<a href='javascript:void(window.open("/~$cuname/$thisdisfn","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>
$thisdisfn</a>	$thisdisfn</a>
ENDCAPTION	ENDCAPTION
$r->print(	$r->print('</tt></h2><b>'.&mt('Target').':</b> <tt>'.
'</tt></h2><b>'.&mt('Target').':</b> <tt>'.$thisdistarget.'</tt><br />');	$thisdistarget.'</tt><br />');

if (($cuname ne $ENV{'user.name'}) \|\| ($cudom ne $ENV{'user.domain'})) {	if (($cuname ne $ENV{'user.name'})\|\|($cudom ne $ENV{'user.domain'})) {
$r->print('<h3><font color="red">'.&mt('Co-Author').': '.$cuname.&mt(' at ').$cudom.	$r->print('<h3><font color="red">'.&mt('Co-Author').': '.
'</font></h3>');	$cuname.&mt(' at ').$cudom.'</font></h3>');
}	}

if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {	if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') {
$r->print(<<ENDDIFF);	$r->print(<<ENDDIFF);
<br />	<br />
<a href='javascript:void(window.open("/adm/diff?filename=/~$cuname/$thisdisfn&versiontwo=priv","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>	<a href='javascript:void(window.open("/adm/diff?filename=/~$cuname/$thisdisfn&versiontwo=priv","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>
ENDDIFF	ENDDIFF
$r->print(&mt('Diffs with Current Version').'</a><br />');	$r->print(&mt('Diffs with Current Version').'</a><br />');
}	}

# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.	# ------------------ Publishing from $thisfn to $thistarget with $thisembstyle.

unless ($ENV{'form.phase'} eq 'two') {	unless ($ENV{'form.phase'} eq 'two') {
my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle);	my ($outstring,$error)=&publish($thisfn,$thistarget,$thisembstyle);
$r->print('<hr />'.$outstring);	$r->print('<hr />'.$outstring);
} else {	} else {
$r->print('<hr />');	$r->print('<hr />'.
&phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget);	&phasetwo($r,$thisfn,$thistarget,$thisembstyle,$thisdistarget));
}	}
}	}
$r->print('</body></html>');	$r->print('</body></html>');

return OK;	return OK;
}	}

1;	1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.138
changed lines
	Added in v.1.152