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.126.2.2 and 1.155

version 1.126.2.2, 2003/09/24 19:40:14	version 1.155, 2003/12/27 16:58:36
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 82 invocation by F<loncapa_apache.conf>:	Line 64 invocation by F<loncapa_apache.conf>:
ErrorDocument 500 /adm/errorhandler	ErrorDocument 500 /adm/errorhandler
</Location>	</Location>

	=head1 OVERVIEW

	Authors can only write-access the C</~authorname/> space. They can
	copy resources into the resource area through the publication step,
	and move them back through a recover step. Authors do not have direct
	write-access to their resource space.

	During the publication step, several events will be
	triggered. Metadata is gathered, where a wizard manages default
	entries on a hierarchical per-directory base: The wizard imports the
	metadata (including access privileges and royalty information) from
	the most recent published resource in the current directory, and if
	that is not available, from the next directory above, etc. The Network
	keeps all previous versions of a resource and makes them available by
	an explicit version number, which is inserted between the file name
	and extension, for example C<foo.2.html>, while the most recent
	version does not carry a version number (C<foo.html>). Servers
	subscribing to a changed resource are notified that a new version is
	available.

=head1 DESCRIPTION	=head1 DESCRIPTION

B<lonpublisher> takes the proper steps to add resources to the LON-CAPA	B<lonpublisher> takes the proper steps to add resources to the LON-CAPA
Line 122 use DBI;	Line 124 use DBI;
use Apache::lonnet();	use Apache::lonnet();
use Apache::loncommon();	use Apache::loncommon();
use Apache::lonmysql;	use Apache::lonmysql;
	use Apache::lonlocal;
	use Apache::loncfile;
use vars qw(%metadatafields %metadatakeys);	use vars qw(%metadatafields %metadatakeys);

my %addid;	my %addid;
Line 159 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 239 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 304 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);
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:".
"</b></font></p><br />".	"</b></font></p><br />".
Line 317 sub hiddenfield {	Line 329 sub hiddenfield {

sub selectbox {	sub selectbox {
my ($title,$name,$value,$functionref,@idlist)=@_;	my ($title,$name,$value,$functionref,@idlist)=@_;
	$title=&mt($title);
my $uctitle=uc($title);	my $uctitle=uc($title);
$value=(split(/\s,\s/,$value))[-1];	$value=(split(/\s,\s/,$value))[-1];
my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".	my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
Line 596 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 661 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 676 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 748 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 765 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);	# adjust some values to metadatadatabase (e.g., "usage" is a reserved word)
	$metadata{'creationdate'}=
	&Apache::lonmysql::sqltime($metadata{'creationdate'});
	$metadata{'lastrevisiondate'}=
	&Apache::lonmysql::sqltime($metadata{'lastrevisiondate'});
	$metadata{'sequsage'}=$metadata{'usage'};
	$metadata{'sequsage_list'}=$metadata{'usage_list'};
	my %newmetadata=();
	# retrieve current database column names
	my @columns=&Apache::lonmysql::col_order('metadata');
	# see if we have old entries
	my @oldmeta=&Apache::lonmysql::get_rows('metadata',
	"url LIKE BINARY '".
	$metadata{'url'}."'");
	if ($#oldmeta==0) {
	# there is an old value
	for (my $i=0; $i<=$#columns; $i++) {
	$newmetadata{$columns[$i]}=$oldmeta[0]->[$i];
	}
	# remove old entry
	$status=&Apache::lonmysql::remove_from_table
	('metadata','url',$metadata{'url'});
	} elsif ($#oldmeta>0) {
	# more than one entry fit - how did that happen?
	$error='<font color="red">Error occured retrieving old values in '.
	'metadata table in LON-CAPA database: '.$#oldmeta.
	' matches</font>';
	&Apache::lonnet::logthis($error);
	return ($error,undef);
	}
	# store new data on top of it
	foreach (keys %metadata) {
	$newmetadata{$_}=$metadata{$_};
	}
	$status = &Apache::lonmysql::store_row('metadata',\%newmetadata);
}	}
# 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 785 sub store_metadata {	Line 836 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 816 sub publish {	Line 887 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 840 sub publish {	Line 911 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 858 sub publish {	Line 929 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 874 sub publish {	Line 945 sub publish {
}	}
$outstring=~s/\n(\<\/[^\>]+\>)\s$/$allowstr\n$1\n/s;	$outstring=~s/\n(\<\/[^\>]+\>)\s$/$allowstr\n$1\n/s;

	### FIXME: is this really what we want?
	# I dont' think so, to will corrupt any UTF-8 resources at least,
	# and any encoding other than ISO-8859-1 will probably break
#Encode any High ASCII characters	#Encode any High ASCII characters
$outstring=&HTML::Entities::encode($outstring,"\200-\377");	#$outstring=&HTML::Entities::encode($outstring,"\200-\377");
# ------------------------------------------------------------- Write modified.	# ------------------------------------------------------------- Write modified.

{	{
my $org;	my $org;
unless ($org=Apache::File->new('>'.$source)) {	unless ($org=Apache::File->new('>'.$source)) {
print $logfile "No write permit to $source\n";	print $logfile "No write permit to $source\n";
return ('<font color="red">No write permission to '.$source.	return ('<font color="red">'.&mt('No write permission to').
', FAIL</font>',1);	' '.$source.
	', '.&mt('FAIL').'</font>',1);
}	}
print($org $outstring);	print($org $outstring);
}	}
Line 893 sub publish {	Line 968 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=();

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

unless ($batch) {	unless ($batch) {
$scrout.='<h3>Metadata Information ' .	$scrout.='<h3>'.&mt('Metadata Information').' ' .
Apache::loncommon::help_open_topic("Metadata_Description")	Apache::loncommon::help_open_topic("Metadata_Description")
. '</h3>';	. '</h3>';
}	}
Line 914 sub publish {	Line 990 sub publish {
$metadatafields{'author'}=~s/\s+/ /g;	$metadatafields{'author'}=~s/\s+/ /g;
$metadatafields{'author'}=~s/\s+$//;	$metadatafields{'author'}=~s/\s+$//;
$metadatafields{'owner'}=$cuname.'@'.$cudom;	$metadatafields{'owner'}=$cuname.'@'.$cudom;
$metadatafields{'modifyinguser'}=$ENV{'user.name'}.'@'.
$ENV{'user.domain'};
$metadatafields{'authorspace'}=$cuname.'@'.$cudom;

# ------------------------------------------------ Check out directory hierachy	# ------------------------------------------------ Check out directory hierachy

Line 928 sub publish {	Line 1001 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 952 sub publish {	Line 1031 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 $oldenv=$ENV{'request.uri'};

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

&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 979 sub publish {	Line 1051 sub publish {
}	}
}	}
if ($chparms) {	if ($chparms) {
$scrout.='<p><b>New parameters or stored values:</b> '.$chparms.'</p>';	$scrout.='<p><b>'.&mt('New parameters or stored values').
	':</b> '.$chparms.'</p>';
}	}

$chparms='';	$chparms='';
Line 993 sub publish {	Line 1066 sub publish {
}	}
}	}
if ($chparms) {	if ($chparms) {
$scrout.='<p><b>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 1028 sub publish {	Line 1103 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 1040 sub publish {	Line 1115 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 1052 function uncheckAll(field) {	Line 1130 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 1088 END	Line 1166 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 1112 END	Line 1205 END
$metadatafields{'creationdate'}=time;	$metadatafields{'creationdate'}=time;
}	}
$scrout.=&hiddenfield('creationdate',	$scrout.=&hiddenfield('creationdate',
&Apache::loncommon::unsqltime($metadatafields{'creationdate'}));	&Apache::lonmysql::unsqltime($metadatafields{'creationdate'}));

$scrout.=&hiddenfield('lastrevisiondate',time);	$scrout.=&hiddenfield('lastrevisiondate',time);

Line 1146 END	Line 1239 END
$scrout.=&textfield('Custom Distribution File','customdistributionfile',	$scrout.=&textfield('Custom Distribution File','customdistributionfile',
$metadatafields{'customdistributionfile'}).	$metadatafields{'customdistributionfile'}).
$copyright_help;	$copyright_help;
	my $uctitle=uc(&mt('Obsolete'));
	$scrout.=
	"\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
	'</b></font> <input type="checkbox" name="obsolete" ';
	if ($metadatafields{'obsolete'}) {
	$scrout.=' checked="1" ';
	}
	$scrout.='/ ></p>'.
	&textfield('Suggested Replacement for Obsolete File',
	'obsoletereplacement',
	$metadatafields{'obsoletereplacement'});
} else {	} else {
$scrout.=&hiddenfield('copyright','private');	$scrout.=&hiddenfield('copyright','private');
}	}
return ($scrout.'<p><input type="submit" value="Finalize Publication" /></p></form>',0);	return ($scrout.'<p><input type="submit" value="'.
	&mt('Finalize Publication').'" /></p></form>',0);
# =============================================================================	# =============================================================================
# BATCH MODE	# BATCH MODE
#	#
Line 1227 sub phasetwo {	Line 1332 sub phasetwo {

if ($target=~/\_\_\_/) {	if ($target=~/\_\_\_/) {
$r->print(	$r->print(
'<font color="red">Unsupported character combination "<tt>___</tt>" in filename, FAIL</font>');	'<font color="red">'.&mt('Unsupported character combination').
	' "<tt>___</tt>" '.&mt('in filename, FAIL').'</font>');
return 0;	return 0;
}	}
$distarget=~s/\/+/\//g;	$distarget=~s/\/+/\//g;
my $logfile;	my $logfile;
unless ($logfile=Apache::File->new('>>'.$source.'.log')) {	unless ($logfile=Apache::File->new('>>'.$source.'.log')) {
$r->print(	$r->print(
'<font color="red">No write permission to user directory, FAIL</font>');	'<font color="red">'.
	&mt('No write permission to user directory, FAIL').'</font>');
return 0;	return 0;
}	}
print $logfile	print $logfile
Line 1256 sub phasetwo {	Line 1363 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{'obsoletereplacement'}=
	$ENV{'form.obsoletereplacement'};
$metadatafields{'dependencies'}=$ENV{'form.dependencies'};	$metadatafields{'dependencies'}=$ENV{'form.dependencies'};
	$metadatafields{'modifyinguser'}=$ENV{'user.name'}.'@'.
	$ENV{'user.domain'};
	$metadatafields{'authorspace'}=$cuname.'@'.$cudom;

my $allkeywords=$ENV{'form.addkey'};	my $allkeywords=$ENV{'form.addkey'};
if (exists($ENV{'form.keywords'})) {	if (exists($ENV{'form.keywords'})) {
Line 1272 sub phasetwo {	Line 1388 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;
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">'.&mt('Could not write metadata, FAIL').
	'</font>';
}	}
foreach (sort keys %metadatafields) {	foreach (sort keys %metadatafields) {
unless ($_=~/\./) {	unless ($_=~/\./) {
Line 1296 sub phasetwo {	Line 1422 sub phasetwo {
.'</'.$tag.'>';	.'</'.$tag.'>';
}	}
}	}
$r->print('<p>Wrote Metadata</p>');	$r->print('<p>'.&mt('Wrote Metadata').'</p>');
print $logfile "\nWrote metadata";	print $logfile "\nWrote metadata";
}	}

Line 1304 sub phasetwo {	Line 1430 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>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>Private Publication - did not synchronize database</p>');	$r->print($error);
print $logfile "\nPrivate: Did not synchronize data into ".	print $logfile "\n".$error;
"SQL metadata database";
}	}

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

if (-e $target) {	if (-e $target) {
Line 1351 sub phasetwo {	Line 1473 sub phasetwo {

if (copy($target,$copyfile)) {	if (copy($target,$copyfile)) {
print $logfile "Copied old target to ".$copyfile."\n";	print $logfile "Copied old target to ".$copyfile."\n";
$r->print('<p>Copied old target file</p>');	$r->print('<p>'.&mt('Copied old target file').'</p>');
} else {	} else {
print $logfile "Unable to write ".$copyfile.':'.$!."\n";	print $logfile "Unable to write ".$copyfile.':'.$!."\n";
return "<font color=\"red\">Failed to copy old target, $!, FAIL</font>";	return "<font color=\"red\">".&mt('Failed to copy old target').
	", $!, ".&mt('FAIL')."</font>";
}	}

# --------------------------------------------------------------- Copy Metadata	# --------------------------------------------------------------- Copy Metadata
Line 1363 sub phasetwo {	Line 1486 sub phasetwo {

if (copy($target.'.meta',$copyfile)) {	if (copy($target.'.meta',$copyfile)) {
print $logfile "Copied old target metadata to ".$copyfile."\n";	print $logfile "Copied old target metadata to ".$copyfile."\n";
$r->print('<p>Copied old metadata</p>')	$r->print('<p>'.&mt('Copied old metadata').'</p>')
} else {	} else {
print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";	print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n";
if (-e $target.'.meta') {	if (-e $target.'.meta') {
return	return
"<font color=\"red\">Failed to write old metadata copy, $!, FAIL</font>";	"<font color=\"red\">".
	&mt('Failed to write old metadata copy').", $!, ".&mt('FAIL')."</font>";
}	}
}	}


} else {	} else {
$r->print('<p>Initial version</p>');	$r->print('<p>'.&mt('Initial version').'</p>');
print $logfile "\nInitial version";	print $logfile "\nInitial version";
}	}

Line 1389 sub phasetwo {	Line 1513 sub phasetwo {
$path.="/$parts[$count]";	$path.="/$parts[$count]";
if ((-e $path)!=1) {	if ((-e $path)!=1) {
print $logfile "\nCreating directory ".$path;	print $logfile "\nCreating directory ".$path;
$r->print('<p>Created directory '.$parts[$count].'</p>');	$r->print('<p>'.&mt('Created directory').' '.$parts[$count].'</p>');
mkdir($path,0777);	mkdir($path,0777);
}	}
}	}

if (copy($source,$copyfile)) {	if (copy($source,$copyfile)) {
print $logfile "\nCopied original source to ".$copyfile."\n";	print $logfile "\nCopied original source to ".$copyfile."\n";
$r->print('<p>Copied source file</p>');	$r->print('<p>'.&mt('Copied source file').'</p>');
} else {	} else {
print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";	print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
return "<font color=\"red\">Failed to copy source, $!, FAIL</font>";	return "<font color=\"red\">".
	&mt('Failed to copy source').", $!, ".&mt('FAIL')."</font>";
}	}

# --------------------------------------------------------------- Copy Metadata	# --------------------------------------------------------------- Copy Metadata
Line 1408 sub phasetwo {	Line 1533 sub phasetwo {

if (copy($source.'.meta',$copyfile)) {	if (copy($source.'.meta',$copyfile)) {
print $logfile "\nCopied original metadata to ".$copyfile."\n";	print $logfile "\nCopied original metadata to ".$copyfile."\n";
$r->print('<p>Copied metadata</p>');	$r->print('<p>'.&mt('Copied metadata').'</p>');
} else {	} else {
print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";	print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n";
return	return
"<font color=\"red\">Failed to write metadata copy, $!, FAIL</font>";	"<font color=\"red\">".&mt('Failed to write metadata copy').", $!, ".&mt('FAIL')."</font>";
}	}
$r->rflush;	$r->rflush;
# --------------------------------------------------- Send update notifications	# --------------------------------------------------- Send update notifications

my @subscribed=&get_subscribed_hosts($target);	my @subscribed=&get_subscribed_hosts($target);
foreach my $subhost (@subscribed) {	foreach my $subhost (@subscribed) {
$r->print('<p>Notifying host '.$subhost.':');$r->rflush;	$r->print('<p>'.&mt('Notifying host').' '.$subhost.':');$r->rflush;
print $logfile "\nNotifying host ".$subhost.':';	print $logfile "\nNotifying host ".$subhost.':';
my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);	my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
$r->print($reply.'</p><br />');$r->rflush;	$r->print($reply.'</p><br />');$r->rflush;
Line 1430 sub phasetwo {	Line 1555 sub phasetwo {

my @subscribedmeta=&get_subscribed_hosts("$target.meta");	my @subscribedmeta=&get_subscribed_hosts("$target.meta");
foreach my $subhost (@subscribedmeta) {	foreach my $subhost (@subscribedmeta) {
$r->print('<p>Notifying host for metadata only '.$subhost.':');$r->rflush;	$r->print('<p>'.
	&mt('Notifying host for metadata only').' '.$subhost.':');$r->rflush;
print $logfile "\nNotifying host for metadata only ".$subhost.':';	print $logfile "\nNotifying host for metadata only ".$subhost.':';
my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',	my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
$subhost);	$subhost);
Line 1442 sub phasetwo {	Line 1568 sub phasetwo {
my %courses=&coursedependencies($target);	my %courses=&coursedependencies($target);
my $now=time;	my $now=time;
foreach (keys %courses) {	foreach (keys %courses) {
$r->print('<p>Notifying course '.$_.':');$r->rflush;	$r->print('<p>'.&mt('Notifying course').' '.$_.':');$r->rflush;
print $logfile "\nNotifying host ".$_.':';	print $logfile "\nNotifying host ".$_.':';
my ($cdom,$cname)=split(/\_/,$_);	my ($cdom,$cname)=split(/\_/,$_);
my $reply=&Apache::lonnet::cput	my $reply=&Apache::lonnet::cput
Line 1464 sub phasetwo {	Line 1590 sub phasetwo {

$r->print(	$r->print(
'<hr /><a href="'.$thisdistarget.'"><font size="+2">'.	'<hr /><a href="'.$thisdistarget.'"><font size="+2">'.
'View Published Version</font></a>'.	&mt('View Published Version').'</font></a>'.
'<p><a href="'.$thissrc.'"><font size=+2>Back to Source</font></a></p>'.	'<p><a href="'.$thissrc.'"><font size=+2>'.
	&mt('Back to Source').'</font></a></p>'.
'<p><a href="'.$thissrcdir.	'<p><a href="'.$thissrcdir.
'"><font size="+2">Back to Source Directory</font></a></p>');	'"><font size="+2">'.
	&mt('Back to Source Directory').'</font></a></p>');
}	}
	return '<p><font color="green">'.&mt('Done').'</font></p>';
}	}

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

sub batchpublish {	sub batchpublish {
my ($r,$srcfile,$targetfile)=@_;	my ($r,$srcfile,$targetfile)=@_;
	#publication pollutes %ENV with form.* values
	my %oldENV=%ENV;
$srcfile=~s/\/+/\//g;	$srcfile=~s/\/+/\//g;
$targetfile=~s/\/+/\//g;	$targetfile=~s/\/+/\//g;
my $thisdisfn=$srcfile;	my $thisdisfn=$srcfile;
Line 1486 sub batchpublish {	Line 1617 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>Publishing <tt>'.$thisdisfn.'</tt></h2>');	$r->print('<h2>'.&mt('Publishing').' <tt>'.$thisdisfn.'</tt></h2>');

# phase one takes	# phase one takes
# my ($source,$target,$style,$batch)=@_;	# my ($source,$target,$style,$batch)=@_;
Line 1510 sub batchpublish {	Line 1639 sub batchpublish {
&phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);	&phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1);
$r->print('</p>');	$r->print('</p>');
}	}
	%ENV=%oldENV;
return '';	return '';
}	}

Line 1520 sub publishdirectory {	Line 1650 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 1609 Publishing from $thisfn to $thistarget w	Line 1739 Publishing from $thisfn to $thistarget w
#########################################	#########################################
#########################################	#########################################
sub handler {	sub handler {
my $r=shift;	my $r=shift;

if ($r->header_only) {	if ($r->header_only) {
$r->content_type('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 1624 sub handler {	Line 1754 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.

$r->content_type('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/'
	.$cuname.'/'.$thisdisfn
	.'">'.&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>Publishing '.	&Apache::loncommon::filedescription($thistype).' <tt>');
&Apache::loncommon::filedescription($thistype).' <tt>'.
'<a href="/~'.$cuname.'/'.$thisdisfn.'" target="cat">'.$thisdisfn.	$r->print(<<ENDCAPTION);
'</a></tt></h2><b>Target:</b> <tt>'.$thisdistarget.'</tt><br />');	<a href='javascript:void(window.open("/~$cuname/$thisdisfn","cat","height=300,width=500,scrollbars=1,resizable=1,menubar=0,location=1"))'>
	$thisdisfn</a>
	ENDCAPTION
	$r->print('</tt></h2><b>'.&mt('Target').':</b> <tt>'.
	$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">Co-Author: '.$cuname.' 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('<br /><a href="/adm/diff?filename=/~'.$cuname.'/'.	$r->print(<<ENDDIFF);
$thisdisfn.	<br />
'&versiontwo=priv" target="cat">Diffs with Current Version</a><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"))'>
}	ENDDIFF
	$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.126.2.2
changed lines
	Added in v.1.155