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.145.2.2 and 1.177

version 1.145.2.2, 2004/02/10 19:23:11	version 1.177, 2004/07/07 21:23:31
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 144 use Apache::loncommon();	Line 126 use Apache::loncommon();
use Apache::lonmysql;	use Apache::lonmysql;
use Apache::lonlocal;	use Apache::lonlocal;
use Apache::loncfile;	use Apache::loncfile;
	use LONCAPA::lonmetadata;
	use Apache::lonmsg;
use vars qw(%metadatafields %metadatakeys);	use vars qw(%metadatafields %metadatakeys);

my %addid;	my %addid;
Line 215 sub metaeval {	Line 199 sub metaeval {
}	}
}	}
my $newentry=$parser->get_text('/'.$entry);	my $newentry=$parser->get_text('/'.$entry);
if ($entry eq 'customdistributionfile') {	if (($entry eq 'customdistributionfile') \|\|
	($entry eq 'sourcerights')) {
$newentry=~s/^\s*//;	$newentry=~s/^\s*//;
if ($newentry !~m\|^/res\|) { $newentry=$prefix.$newentry; }	if ($newentry !~m\|^/res\|) { $newentry=$prefix.$newentry; }
}	}
Line 270 sub metaread {	Line 255 sub metaread {
my ($logfile,$fn,$prefix)=@_;	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>'.	return '<br /><b>'.&mt('No file').':</b> <tt>'.
&Apache::loncfile::display($fn).'</tt>';	&Apache::loncfile::display($fn).'</tt>';
}	}
print($logfile 'Processing '.$fn."\n");	print($logfile 'Processing '.$fn."\n");
Line 280 sub metaread {	Line 265 sub metaread {
$metastring=join('',<$metafh>);	$metastring=join('',<$metafh>);
}	}
&metaeval($metastring,$prefix);	&metaeval($metastring,$prefix);
return '<br /><b>Processed file:</b> <tt>'.	return '<br /><b>'.&mt('Processed file').':</b> <tt>'.
&Apache::loncfile::display($fn).'</tt>';	&Apache::loncfile::display($fn).'</tt>';
}	}

Line 338 sub textfield {	Line 323 sub textfield {
$value=~s/\s+$//gs;	$value=~s/\s+$//gs;
$value=~s/\s+/ /gs;	$value=~s/\s+/ /gs;
$title=&mt($title);	$title=&mt($title);
my $uctitle=uc($title);	$ENV{'form.'.$name}=$value;
return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".	return "\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".
"</b></font></p><br />".	"</b></font></p><br />".
'<input type="text" name="'.$name.'" size=80 value="'.$value.'" />';	'<input type="text" name="'.$name.'" size=80 value="'.$value.'" />';
}	}

sub hiddenfield {	sub hiddenfield {
my ($name,$value)=@_;	my ($name,$value)=@_;
	$ENV{'form.'.$name}=$value;
return "\n".'<input type="hidden" name="'.$name.'" value="'.$value.'" />';	return "\n".'<input type="hidden" name="'.$name.'" value="'.$value.'" />';
}	}

sub selectbox {	sub selectbox {
my ($title,$name,$value,$functionref,@idlist)=@_;	my ($title,$name,$value,$functionref,@idlist)=@_;
$title=&mt($title);	$title=&mt($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:".	if (defined($value)) {
	$ENV{'form.'.$name}=$value;
	} else {
	$ENV{'form.'.$name}=$idlist[0];
	}
	my $selout="\n<p><font color=\"#800000\" face=\"helvetica\"><b>$title:".
'</b></font></p><br /><select name="'.$name.'">';	'</b></font></p><br /><select name="'.$name.'">';
foreach (@idlist) {	foreach (@idlist) {
$selout.='<option value=\''.$_.'\'';	$selout.='<option value=\''.$_.'\'';
Line 366 sub selectbox {	Line 356 sub selectbox {
return $selout.'</select>';	return $selout.'</select>';
}	}

	sub select_level_form {
	my ($value,$name)=@_;
	$ENV{'form.'.$name}=$value;
	if (!defined($value)) { $ENV{'form.'.$name}=0; }
	return &Apache::loncommon::select_level_form($value,$name);
	}
#########################################	#########################################
#########################################	#########################################

Line 587 sub get_all_text_unbalanced {	Line 583 sub get_all_text_unbalanced {
} elsif ($token->[0] eq 'E') {	} elsif ($token->[0] eq 'E') {
$result.=$token->[2];	$result.=$token->[2];
}	}
if ($result =~ /(.)\Q$tag\E(.)/s) {	if ($result =~ /\Q$tag\E/s) {
	($result,my $redo)=$result =~ /(.)\Q$tag\E(.)/is;
#&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2);	#&Apache::lonnet::logthis('Got a winner with leftovers ::'.$2);
#&Apache::lonnet::logthis('Result is :'.$1);	#&Apache::lonnet::logthis('Result is :'.$1);
$result=$1;	$redo=$tag.$redo;
my $redo=$tag.$2;
push (@$pars,HTML::LCParser->new(\$redo));	push (@$pars,HTML::LCParser->new(\$redo));
$$pars[-1]->xml_mode('1');	$$pars[-1]->xml_mode('1');
last;	last;
Line 631 sub fix_ids_and_indices {	Line 627 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 696 sub fix_ids_and_indices {	Line 692 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 711 sub fix_ids_and_indices {	Line 714 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 783 Returns: (error,status). error is undef	Line 785 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 800 sub store_metadata {	Line 802 sub store_metadata {
&Apache::lonnet::logthis($error);	&Apache::lonnet::logthis($error);
return ($error,undef);	return ($error,undef);
}	}
# Remove old value from table	my $dbh = &Apache::lonmysql::get_dbh();
$status = &Apache::lonmysql::remove_from_table	if (($metadata{'obsolete'}) \|\| ($metadata{'copyright'} eq 'priv') \|\|
('metadata','url',$metadata{'url'});	($metadata{'copyright'} eq 'custom')) {
if (! defined($status)) {	# remove this entry
$error = '<font color="red">Error when removing old values from '.	$status=&LONCAPA::lonmetadata::delete_metadata($dbh,undef,
'metadata table in LON-CAPA database.</font>';	$metadata{'url'});
&Apache::lonnet::logthis($error);	} else {
return ($error,undef);	$status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,
	\%metadata);
}	}
# Store data in table.	if (defined($status) && $status ne '') {
$status = &Apache::lonmysql::store_row('metadata',\%metadata);
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>';
&Apache::lonnet::logthis($error);	&Apache::lonnet::logthis($error);
	&Apache::lonnet::logthis($status);
return ($error,undef);	return ($error,undef);
}	}
return (undef,$status);	return (undef,$status);
Line 871 sub publish {	Line 873 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 895 sub publish {	Line 897 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 904 sub publish {	Line 906 sub publish {
$allowstr.="\n".'<allow src="'.$thisdep.'" />';	$allowstr.="\n".'<allow src="'.$thisdep.'" />';
}	}
$scrout.='<br />';	$scrout.='<br />';
unless ($thisdep=~/\*/) {	if ($thisdep!~/\*/ && $thisdep!~m\|^/adm/\|) {
$scrout.='<a href="'.$thisdep.'">';	$scrout.='<a href="'.$thisdep.'">';
}	}
$scrout.='<tt>'.$thisdep.'</tt>';	$scrout.='<tt>'.$thisdep.'</tt>';
unless ($thisdep=~/\*/) {	if ($thisdep!~/\*/ && $thisdep!~m\|^/adm/\|) {
$scrout.='</a>';	$scrout.='</a>';
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 927 sub publish {	Line 929 sub publish {
}	}
}	}
}	}
$outstring=~s/\n(\<\/[^\>]+\>)\s$/$allowstr\n$1\n/s;	$outstring=~s/\n(\<\/[^\>]+\>[^<])$/$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
#$outstring=&HTML::Entities::encode($outstring,"\200-\377");
# ------------------------------------------------------------- Write modified.	# ------------------------------------------------------------- Write modified.

{	{
Line 974 sub publish {	Line 971 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;

# ----------------------------------------------------------- Parse file itself
# read %metadatafields from file itself

$allmeta=&parseformeta($source,$style);
# ------------------------------------------------ Check out directory hierachy	# ------------------------------------------------ Check out directory hierachy

my $thisdisfn=$source;	my $thisdisfn=$source;
Line 998 sub publish {	Line 988 sub publish {
$scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);	$scrout.=&metaread($logfile,$currentpath.'default.meta',$prefix);
$prefix=~s\|^\.\./\|\|;	$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 1021 sub publish {	Line 1015 sub publish {
# ------------------------------------------ See if anything new in file itself	# ------------------------------------------ See if anything new in file itself

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

}	}


Line 1080 sub publish {	Line 1075 sub publish {
}	}


foreach (split(/\W+/,$metadatafields{'keywords'})) {	foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {
$keywords{$_}=1;	$addkey=~s/\s+/ /g;
	$addkey=~s/^\s//;
	$addkey=~s/\s$//;
	if ($addkey=~/\w/) {
	$keywords{$addkey}=1;
	}
}	}
# --------------------------------------------------- Now we also have keywords	# --------------------------------------------------- Now we also have keywords
# =============================================================================	# =============================================================================
# INTERACTIVE MODE	# interactive mode html goes into $intr_scrout
#	# batch mode throws away this HTML
unless ($batch) {	# additionally all of the field functions have a by product of setting
$scrout.=	# $ENV{'from.'..} so that it can be used by the phase two handler in
'<form name="pubform" action="/adm/publish" method="post">'.	# batch mode
'<p><input type="submit" value="Finalize Publication" /></p>'.
&hiddenfield('phase','two').	my $intr_scrout.=
&hiddenfield('filename',$ENV{'form.filename'}).	'<form name="pubform" action="/adm/publish" method="post">'.
&hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).	'<p><input type="submit" value="'.&mt('Finalize Publication').'" /></p>'.
&hiddenfield('dependencies',join(',',keys %allow)).	&hiddenfield('phase','two').
&textfield('Title','title',$metadatafields{'title'}).	&hiddenfield('filename',$ENV{'form.filename'}).
&textfield('Author(s)','author',$metadatafields{'author'}).	&hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).
&textfield('Subject','subject',$metadatafields{'subject'});	&hiddenfield('dependencies',join(',',keys %allow)).
	&textfield('Title','title',$metadatafields{'title'}).
	&textfield('Author(s)','author',$metadatafields{'author'}).
	&textfield('Subject','subject',$metadatafields{'subject'});

# --------------------------------------------------- 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 $keywordout=<<"END";	my $KEYWORDS=&mt('Keywords');
	my $CheckAll=&mt('check all');
	my $UncheckAll=&mt('uncheck all');
	my $keywordout=<<"END";
<script>	<script>
function checkAll(field) {	function checkAll(field) {
for (i = 0; i < field.length; i++)	for (i = 0; i < field.length; i++)
Line 1114 function uncheckAll(field) {	Line 1120 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
$keywordout.='<table border="2"><tr>';	$keywordout.='<table border="2"><tr>';
my $colcount=0;	my $colcount=0;

foreach (sort keys %keywords) {	foreach (sort keys %keywords) {
$keywordout.='<td><input type="checkbox" name="keywords" value="'.$_.'"';	$keywordout.='<td><input type="checkbox" name="keywords" value="'.$_.'"';
if ($metadatafields{'keywords'}) {	if ($metadatafields{'keywords'}) {
if ($metadatafields{'keywords'}=~/\Q$_\E/) {	if ($metadatafields{'keywords'}=~/\Q$_\E/) {
$keywordout.=' checked="on"';
}
} elsif (&Apache::loncommon::keyword($_)) {
$keywordout.=' checked="on"';	$keywordout.=' checked="on"';
	$ENV{'form.keywords'}.=$_.',';
}	}
$keywordout.=' />'.$_.'</td>';	} elsif (&Apache::loncommon::keyword($_)) {
if ($colcount>10) {	$keywordout.=' checked="on"';
$keywordout.="</tr><tr>\n";	$ENV{'form.keywords'}.=$_.',';
$colcount=0;	}
}	$keywordout.=' />'.$_.'</td>';
$colcount++;	if ($colcount>10) {
	$keywordout.="</tr><tr>\n";
	$colcount=0;
}	}
	$colcount++;
	}
	$ENV{'form.keywords'}=~s/\,$//;

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

$scrout.=$keywordout;	$intr_scrout.=$keywordout;

$scrout.=&textfield('Additional Keywords','addkey','');	$intr_scrout.=&textfield('Additional Keywords','addkey','');

$scrout.=&textfield('Notes','notes',$metadatafields{'notes'});	$intr_scrout.=&textfield('Notes','notes',$metadatafields{'notes'});

$scrout.=	$intr_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.=&hiddenfield('mime',$1);

my $defaultlanguage=$metadatafields{'language'};	$intr_scrout.=
$defaultlanguage =~ s/\snotset\s//g;	"\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
$defaultlanguage =~ s/^,\s*//g;	&mt('Lowest Grade Level').':'.
$defaultlanguage =~ s/,\s*$//g;	"</b></font></p><br />".
	&select_level_form($metadatafields{'lowestgradelevel'},'lowestgradelevel').
	"\n<p><font color=\"#800000\" face=\"helvetica\"><b>".
	&mt('Highest Grade Level').':'.
	"</b></font></p><br />".
	&select_level_form($metadatafields{'highestgradelevel'},'highestgradelevel').
	&textfield('Standards','standards',$metadatafields{'standards'});

$scrout.=&selectbox('Language','language',
$defaultlanguage,
\&Apache::loncommon::languagedescription,
(&Apache::loncommon::languageids),
);

unless ($metadatafields{'creationdate'}) {
$metadatafields{'creationdate'}=time;
}
$scrout.=&hiddenfield('creationdate',
&Apache::loncommon::unsqltime($metadatafields{'creationdate'}));

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

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

	my $defaultlanguage=$metadatafields{'language'};
	$defaultlanguage =~ s/\snotset\s//g;
	$defaultlanguage =~ s/^,\s*//g;
	$defaultlanguage =~ s/,\s*$//g;

	$intr_scrout.=&selectbox('Language','language',
	$defaultlanguage,
	\&Apache::loncommon::languagedescription,
	(&Apache::loncommon::languageids),
	);

	unless ($metadatafields{'creationdate'}) {
	$metadatafields{'creationdate'}=time;
	}
	$intr_scrout.=&hiddenfield('creationdate',
	&Apache::lonmysql::unsqltime($metadatafields{'creationdate'}));

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

$scrout.=&textfield('Publisher/Owner','owner',
$metadatafields{'owner'});

	$intr_scrout.=&textfield('Publisher/Owner','owner',
	$metadatafields{'owner'});

	# ---------------------------------------------- Retrofix for unused copyright
	if ($metadatafields{'copyright'} eq 'free') {
	$metadatafields{'copyright'}='default';
	$metadatafields{'sourceavail'}='open';
	}
	# ------------------------------------------------ Dial in reasonable defaults
	my $defaultoption=$metadatafields{'copyright'};
	unless ($defaultoption) { $defaultoption='default'; }
	my $defaultsourceoption=$metadatafields{'sourceavail'};
	unless ($defaultsourceoption) { $defaultsourceoption='closed'; }
	unless ($style eq 'prv') {
# -------------------------------------------------- Correct copyright for rat.	# -------------------------------------------------- Correct copyright for rat.
my $defaultoption=$metadatafields{'copyright'};	if ($style eq 'rat') {
unless ($defaultoption) { $defaultoption='default'; }	# -------------------------------------- Retrofix for non-applicable copyright
unless ($style eq 'prv') {	if ($metadatafields{'copyright'} eq 'public') {
if ($style eq 'rat') {	delete $metadatafields{'copyright'};
if ($metadatafields{'copyright'} eq 'public') {	$defaultoption='default';
delete $metadatafields{'copyright'};	}
$defaultoption='default';	$intr_scrout.=&selectbox('Copyright/Distribution','copyright',
}	$defaultoption,
$scrout.=&selectbox('Copyright/Distribution','copyright',	\&Apache::loncommon::copyrightdescription,
$defaultoption,
\&Apache::loncommon::copyrightdescription,
(grep !/^public$/,(&Apache::loncommon::copyrightids)));	(grep !/^public$/,(&Apache::loncommon::copyrightids)));
} else {
$scrout.=&selectbox('Copyright/Distribution','copyright',
$defaultoption,
\&Apache::loncommon::copyrightdescription,
(&Apache::loncommon::copyrightids));
}

my $copyright_help =
Apache::loncommon::help_open_topic('Publishing_Copyright');
$scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;
$scrout.=&textfield('Custom Distribution File','customdistributionfile',
$metadatafields{'customdistributionfile'}).
$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');	$intr_scrout.=&selectbox('Copyright/Distribution','copyright',
}	$defaultoption,
return ($scrout.'<p><input type="submit" value="'.	\&Apache::loncommon::copyrightdescription,
&mt('Finalize Publication').'" /></p></form>',0);	(&Apache::loncommon::copyrightids));
# =============================================================================	}
# BATCH MODE	my $copyright_help =
#	Apache::loncommon::help_open_topic('Publishing_Copyright');
	$intr_scrout =~ s/DISTRIBUTION:/'DISTRIBUTION: ' . $copyright_help/ge;
	$intr_scrout.=&textfield('Custom Distribution File','customdistributionfile',
	$metadatafields{'customdistributionfile'}).
	$copyright_help;
	$intr_scrout.=&selectbox('Source Distribution','sourceavail',
	$defaultsourceoption,
	\&Apache::loncommon::source_copyrightdescription,
	(&Apache::loncommon::source_copyrightids));
	$intr_scrout.=&textfield('Source Custom Distribution File','sourcerights',
	$metadatafields{'sourcerights'});
	my $uctitle=&mt('Obsolete');
	$intr_scrout.=
	"\n<p><font color=\"#800000\" face=\"helvetica\"><b>$uctitle:".
	'</b></font> <input type="checkbox" name="obsolete" ';
	if ($metadatafields{'obsolete'}) {
	$intr_scrout.=' checked="1" ';
	}
	$intr_scrout.='/ ></p>'.
	&textfield('Suggested Replacement for Obsolete File',
	'obsoletereplacement',
	$metadatafields{'obsoletereplacement'});
} else {	} else {
# Transfer metadata directly to environment for stage 2	$intr_scrout.=&hiddenfield('copyright','private');
foreach (keys %metadatafields) {	}
$ENV{'form.'.$_}=$metadatafields{$_};	if (!$batch) {
}	$scrout.=$intr_scrout.'<p><input type="submit" value="'.
$ENV{'form.addkey'}='';	&mt('Finalize Publication').'" /></p></form>';
$ENV{'form.keywords'}='';
foreach (keys %keywords) {
if ($metadatafields{'keywords'}) {
if ($metadatafields{'keywords'}=~/\Q$_\E/) {
$ENV{'form.keywords'}.=$_.',';
}
} elsif (&Apache::loncommon::keyword($_)) {
$ENV{'form.keywords'}.=$_.',';
}
}
$ENV{'form.keywords'}=~s/\,$//;
unless ($ENV{'form.creationdate'}) { $ENV{'form.creationdate'}=time; }
$ENV{'form.lastrevisiondate'}=time;
if ((($style eq 'rat') && ($ENV{'form.copyright'} eq 'public')) \|\|
(!$ENV{'form.copyright'})) {
$ENV{'form.copyright'}='default';
}
$ENV{'form.allmeta'}=&Apache::lonnet::escape($allmeta);
return ($scrout,0);
}	}
	return($scrout,0);
}	}

#########################################	#########################################
Line 1318 sub phasetwo {	Line 1330 sub phasetwo {

%metadatafields=();	%metadatafields=();
%metadatakeys=();	%metadatakeys=();

&metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));	&metaeval(&Apache::lonnet::unescape($ENV{'form.allmeta'}));

$metadatafields{'title'}=$ENV{'form.title'};	$metadatafields{'title'}=$ENV{'form.title'};
Line 1332 sub phasetwo {	Line 1344 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{'sourceavail'}=$ENV{'form.sourceavail'};
$metadatafields{'obsolete'}=$ENV{'form.obsolete'};	$metadatafields{'obsolete'}=$ENV{'form.obsolete'};
$metadatafields{'obsoletereplacement'}=	$metadatafields{'obsoletereplacement'}=
$ENV{'form.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 1347 sub phasetwo {	Line 1366 sub phasetwo {
$allkeywords .= ','.$ENV{'form.keywords'};	$allkeywords .= ','.$ENV{'form.keywords'};
}	}
}	}
$allkeywords=~s/\W+/\,/;	$allkeywords=~s/[\"\']//g;
$allkeywords=~s/^\,//;	$allkeywords=~s/\s[\;\,]\s/\,/g;
	$allkeywords=~s/\s+/ /g;
	$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 1372 sub phasetwo {	Line 1403 sub phasetwo {
print $mfh ' '.$_.'="'.$value.'"';	print $mfh ' '.$_.'="'.$value.'"';
}	}
print $mfh '>'.	print $mfh '>'.
&HTML::Entities::encode($metadatafields{$unikey})	&HTML::Entities::encode($metadatafields{$unikey},'<>&"')
.'</'.$tag.'>';	.'</'.$tag.'>';
}	}
}	}
Line 1384 sub phasetwo {	Line 1415 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";
}	}
	# --------------------------------------------- Delete author resource messages
	my $delresult=&Apache::lonmsg::del_url_author_res_msg($target);
	$r->print('<p>'.&mt('Removing error messages:').' '.$delresult.'</p>');
	print $logfile "\nRemoving error messages: $delresult";
# ----------------------------------------------------------- Copy old versions	# ----------------------------------------------------------- Copy old versions

if (-e $target) {	if (-e $target) {
Line 1556 sub phasetwo {	Line 1585 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 1610 sub publishdirectory {	Line 1640 sub publishdirectory {
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>'.&mt('Directory').' <tt>'.$thisdisfn.'</tt></h1>'.
'Target: <tt>'.$resdir.'</tt><br />');	&mt('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.

Line 1649 sub publishdirectory {	Line 1679 sub publishdirectory {
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 />'.&mt('Skipping').' '.$filename.'<br />');
}	}
$r->rflush();	$r->rflush();
}	}
}	}
closedir(DIR);	closedir(DIR);
}	}

	#########################################
	# publish a default.meta file

	sub defaultmetapublish {
	my ($r,$fn,$cuname,$cudom)=@_;
	$fn=~s/^\/\~$cuname\//\/home\/$cuname\/public_html\//;
	unless (-e $fn) {
	return HTTP_NOT_FOUND;
	}
	my $target=$fn;
	$target=~s/^\/home\/$cuname\/public_html\//$Apache::lonnet::perlvar{'lonDocRoot'}\/res\/$cudom\/$cuname\//;


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

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

	# ---------------------------------------------------------------- Write Source
	my $copyfile=$target;

	my @parts=split(/\//,$copyfile);
	my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";

	my $count;
	for ($count=5;$count<$#parts;$count++) {
	$path.="/$parts[$count]";
	if ((-e $path)!=1) {
	$r->print('<p>'.&mt('Created directory').' '.$parts[$count].'</p>');
	mkdir($path,0777);
	}
	}

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

	# --------------------------------------------------- Send update notifications

	my @subscribed=&get_subscribed_hosts($target);
	foreach my $subhost (@subscribed) {
	$r->print('<p>'.&mt('Notifying host').' '.$subhost.':');$r->rflush;
	my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
	$r->print($reply.'</p><br />');$r->rflush;
	}
	# ------------------------------------------------------------------- Link back
	my $link=$fn;
	$link=~s/^\/home\/$cuname\/public_html\//\/priv\/$cuname\//;
	$r->print("<a href='$link'>".&mt('Back to Catalog Information').'</a>');
	$r->print('</body></html>');
	return OK;
	}
#########################################	#########################################

=pod	=pod
Line 1714 sub handler {	Line 1801 sub handler {

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

	($cuname,$cudom)=
	&Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain'));

	# special publication: default.meta file
	if ($fn=~/\/default.meta$/) {
	return &defaultmetapublish($r,$fn,$cuname,$cudom);
	}
	$fn=~s/\.meta$//;

unless ($fn) {	unless ($fn) {
$r->log_reason($cuname.' at '.$cudom.	$r->log_reason($cuname.' at '.$cudom.
Line 1721 sub handler {	Line 1816 sub handler {
return HTTP_NOT_FOUND;	return HTTP_NOT_FOUND;
}	}

($cuname,$cudom)=
&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'}.
Line 1857 ENDDIFF	Line 1950 ENDDIFF
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>');

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

Removed from v.1.145.2.2
changed lines
	Added in v.1.177