--- loncom/publisher/lonpublisher.pm 2003/12/22 21:57:25 1.148
+++ loncom/publisher/lonpublisher.pm 2004/09/02 19:34:46 1.178
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Publication Handler
#
-# $Id: lonpublisher.pm,v 1.148 2003/12/22 21:57:25 albertel Exp $
+# $Id: lonpublisher.pm,v 1.178 2004/09/02 19:34:46 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,24 +25,6 @@
#
# 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
-#
###
###############################################################################
@@ -144,6 +126,8 @@ use Apache::loncommon();
use Apache::lonmysql;
use Apache::lonlocal;
use Apache::loncfile;
+use LONCAPA::lonmetadata;
+use Apache::lonmsg;
use vars qw(%metadatafields %metadatakeys);
my %addid;
@@ -215,11 +199,15 @@ sub metaeval {
}
}
my $newentry=$parser->get_text('/'.$entry);
- if ($entry eq 'customdistributionfile') {
+ if (($entry eq 'customdistributionfile') ||
+ ($entry eq 'sourcerights')) {
$newentry=~s/^\s*//;
if ($newentry !~m|^/res|) { $newentry=$prefix.$newentry; }
}
- unless ($metadatafields{$unikey}=~/\w/) {
+# actually store
+ if ( $entry eq 'rule' && exists($metadatafields{$unikey})) {
+ $metadatafields{$unikey}.=','.$newentry;
+ } else {
$metadatafields{$unikey}=$newentry;
}
}
@@ -335,23 +323,28 @@ sub textfield {
$value=~s/\s+$//gs;
$value=~s/\s+/ /gs;
$title=&mt($title);
- my $uctitle=uc($title);
- return "\n
$uctitle:".
+ $ENV{'form.'.$name}=$value;
+ return "\n $title:".
"
".
' ';
}
sub hiddenfield {
my ($name,$value)=@_;
+ $ENV{'form.'.$name}=$value;
return "\n".' ';
}
sub selectbox {
my ($title,$name,$value,$functionref,@idlist)=@_;
$title=&mt($title);
- my $uctitle=uc($title);
$value=(split(/\s*,\s*/,$value))[-1];
- my $selout="\n$uctitle:".
+ if (defined($value)) {
+ $ENV{'form.'.$name}=$value;
+ } else {
+ $ENV{'form.'.$name}=$idlist[0];
+ }
+ my $selout="\n $title:".
'
';
foreach (@idlist) {
$selout.='';
}
+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);
+}
#########################################
#########################################
@@ -473,7 +472,8 @@ sub get_subscribed_hosts {
while ($filename=readdir(DIR)) {
if ($filename=~/\Q$srcf\E\.(\w+)$/) {
my $subhost=$1;
- if (($subhost ne 'meta' && $subhost ne 'subscription') &&
+ if (($subhost ne 'meta' && $subhost ne 'subscription' &&
+ $subhost ne 'tmp') &&
($subhost ne $Apache::lonnet::perlvar{'lonHostID'})) {
push(@subscribed,$subhost);
}
@@ -584,11 +584,11 @@ sub get_all_text_unbalanced {
} elsif ($token->[0] eq 'E') {
$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('Result is :'.$1);
- $result=$1;
- my $redo=$tag.$2;
+ $redo=$tag.$redo;
push (@$pars,HTML::LCParser->new(\$redo));
$$pars[-1]->xml_mode('1');
last;
@@ -786,7 +786,7 @@ Returns: (error,status). error is undef
#########################################
#########################################
sub store_metadata {
- my %metadata = %{shift()};
+ my %metadata = @_;
my $error;
# Determine if the table exists
my $status = &Apache::lonmysql::check_table('metadata');
@@ -803,21 +803,21 @@ sub store_metadata {
&Apache::lonnet::logthis($error);
return ($error,undef);
}
- # Remove old value from table
- $status = &Apache::lonmysql::remove_from_table
- ('metadata','url',$metadata{'url'});
- if (! defined($status)) {
- $error = 'Error when removing old values from '.
- 'metadata table in LON-CAPA database. ';
- &Apache::lonnet::logthis($error);
- return ($error,undef);
+ my $dbh = &Apache::lonmysql::get_dbh();
+ if (($metadata{'obsolete'}) || ($metadata{'copyright'} eq 'priv') ||
+ ($metadata{'copyright'} eq 'custom')) {
+ # remove this entry
+ $status=&LONCAPA::lonmetadata::delete_metadata($dbh,undef,
+ $metadata{'url'});
+ } else {
+ $status = &LONCAPA::lonmetadata::update_metadata($dbh,undef,
+ \%metadata);
}
- # Store data in table.
- $status = &Apache::lonmysql::store_row('metadata',\%metadata);
- if (! defined($status)) {
+ if (defined($status) && $status ne '') {
$error='Error occured storing new values in '.
'metadata table in LON-CAPA database ';
&Apache::lonnet::logthis($error);
+ &Apache::lonnet::logthis($status);
return ($error,undef);
}
return (undef,$status);
@@ -907,11 +907,11 @@ sub publish {
$allowstr.="\n".' ';
}
$scrout.=' ';
- unless ($thisdep=~/\*/) {
+ if ($thisdep!~/\*/ && $thisdep!~m|^/adm/|) {
$scrout.='';
}
$scrout.=''.$thisdep.' ';
- unless ($thisdep=~/\*/) {
+ if ($thisdep!~/\*/ && $thisdep!~m|^/adm/|) {
$scrout.=' ';
if (
&Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
@@ -930,13 +930,8 @@ 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.
{
@@ -977,14 +972,7 @@ sub publish {
$metadatafields{'author'}=~s/\s+/ /g;
$metadatafields{'author'}=~s/\s+$//;
$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
my $thisdisfn=$source;
@@ -1001,6 +989,10 @@ sub publish {
$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)
@@ -1024,6 +1016,7 @@ sub publish {
# ------------------------------------------ See if anything new in file itself
$allmeta=&parseformeta($source,$style);
+
}
@@ -1083,32 +1076,40 @@ sub publish {
}
- foreach (split(/\W+/,$metadatafields{'keywords'})) {
- $keywords{$_}=1;
+ foreach my $addkey (split(/[\"\'\,\;]/,$metadatafields{'keywords'})) {
+ $addkey=~s/\s+/ /g;
+ $addkey=~s/^\s//;
+ $addkey=~s/\s$//;
+ if ($addkey=~/\w/) {
+ $keywords{$addkey}=1;
+ }
}
# --------------------------------------------------- Now we also have keywords
# =============================================================================
-# INTERACTIVE MODE
-#
- unless ($batch) {
- $scrout.=
- '