--- loncom/publisher/lonpublisher.pm 2006/09/27 20:34:26 1.213
+++ loncom/publisher/lonpublisher.pm 2007/02/21 21:01:59 1.220
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Publication Handler
#
-# $Id: lonpublisher.pm,v 1.213 2006/09/27 20:34:26 albertel Exp $
+# $Id: lonpublisher.pm,v 1.220 2007/02/21 21:01:59 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -129,8 +129,7 @@ use Apache::loncfile;
use LONCAPA::lonmetadata;
use Apache::lonmsg;
use vars qw(%metadatafields %metadatakeys);
-use lib '/home/httpd/lib/perl/';
-use LONCAPA;
+use LONCAPA qw(:DEFAULT :match);
my %addid;
@@ -184,17 +183,18 @@ sub metaeval {
if ($token->[0] eq 'S') {
my $entry=$token->[1];
my $unikey=$entry;
+ next if ($entry =~ m/^(?:parameter|stores)_/);
if (defined($token->[2]->{'package'})) {
- $unikey.='_package_'.$token->[2]->{'package'};
+ $unikey.="\0package\0".$token->[2]->{'package'};
}
if (defined($token->[2]->{'part'})) {
- $unikey.='_'.$token->[2]->{'part'};
+ $unikey.="\0".$token->[2]->{'part'};
}
if (defined($token->[2]->{'id'})) {
- $unikey.='_'.$token->[2]->{'id'};
+ $unikey.="\0".$token->[2]->{'id'};
}
if (defined($token->[2]->{'name'})) {
- $unikey.='_'.$token->[2]->{'name'};
+ $unikey.="\0".$token->[2]->{'name'};
}
foreach (@{$token->[3]}) {
$metadatafields{$unikey.'.'.$_}=$token->[2]->{$_};
@@ -281,9 +281,8 @@ sub metaread {
sub coursedependencies {
my $url=&Apache::lonnet::declutter(shift);
$url=~s/\.meta$//;
- my ($adomain,$aauthor)=($url=~/^(\w+)\/(\w+)\//);
- my $regexp=$url;
- $regexp=~s/(\W)/\\$1/g;
+ my ($adomain,$aauthor)=($url=~ m{^($match_domain)/($match_username)/});
+ my $regexp=quotemeta($url);
$regexp='___'.$regexp.'___course';
my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain,
$aauthor,$regexp);
@@ -410,14 +409,14 @@ sub urlfixup {
if ($url =~ /^mailto:/i) { return $url; }
#internal document links need no fixing
if ($url =~ /^\#/) { return $url; }
- my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);
+ my ($host)=($url=~/(?:(?:http|https|ftp)\:\/\/)*([^\/]+)/);
foreach (values %Apache::lonnet::hostname) {
if ($_ eq $host) {
- $url=~s/^http\:\/\///;
+ $url=~s/^(?:http|https|ftp)\:\/\///;
$url=~s/^$host//;
}
}
- if ($url=~/^http\:\/\//) { return $url; }
+ if ($url=~/^(?:http|https|ftp)\:\/\//) { return $url; }
$url=~s/\~$cuname/res\/$cudom\/$cuname/;
return $url;
}
@@ -469,11 +468,11 @@ sub set_allow {
}
if (($newurl !~ /^javascript:/i) &&
($newurl !~ /^mailto:/i) &&
- ($newurl !~ /^http:/i) &&
+ ($newurl !~ /^(?:http|https|ftp):/i) &&
($newurl !~ /^\#/)) {
$$allow{&absoluteurl($newurl,$target)}=1;
}
- return $return_url
+ return $return_url;
}
#########################################
@@ -497,7 +496,7 @@ sub get_subscribed_hosts {
my $srcf=$2;
opendir(DIR,$1);
while ($filename=readdir(DIR)) {
- if ($filename=~/\Q$srcf\E\.(\w+)$/) {
+ if ($filename=~/\Q$srcf\E\.($match_lonid)$/) {
my $subhost=$1;
if (($subhost ne 'meta' && $subhost ne 'subscription' &&
$subhost ne 'tmp') &&
@@ -509,18 +508,13 @@ sub get_subscribed_hosts {
closedir(DIR);
my $sh;
if ( $sh=Apache::File->new("$target.subscription") ) {
- &Apache::lonnet::logthis("opened $target.subscription");
while (my $subline=<$sh>) {
- if ($subline =~ /(^\w+):/) {
+ if ($subline =~ /^($match_lonid):/) {
if ($1 ne $Apache::lonnet::perlvar{'lonHostID'}) {
push(@subscribed,$1);
}
- } else {
- &Apache::lonnet::logthis("No Match for $subline");
}
}
- } else {
- &Apache::lonnet::logthis("Unable to open $target.subscription");
}
return @subscribed;
}
@@ -721,6 +715,7 @@ sub fix_ids_and_indices {
($lctag eq 'image')) {
my $next_token=$parser[-1]->get_token();
if ($next_token->[0] eq 'T') {
+ $next_token->[1] =~ s/[\n\r\f]+//g;
$next_token->[1]=&set_allow(\%allow,$logfile,
$target,$tag,
$next_token->[1]);
@@ -987,7 +982,7 @@ sub publish {
my %temphash=(&Apache::lonnet::declutter($target).'___'.
&Apache::lonnet::declutter($thisdep).'___usage'
=> time);
- $thisdep=~/^\/res\/(\w+)\/(\w+)\//;
+ $thisdep=~m{^/res/($match_domain)/($match_username)/};
if ((defined($1)) && (defined($2))) {
&Apache::lonnet::put('nohist_resevaldata',\%temphash,
$1,$2);
@@ -1101,8 +1096,10 @@ sub publish {
if (($_=~/^parameter/) || ($_=~/^stores/)) {
unless ($_=~/\.\w+$/) {
unless ($oldparmstores{$_}) {
- print $logfile 'New: '.$_."\n";
- $chparms.=$_.' ';
+ my $disp_key = $_;
+ $disp_key =~ tr/\0/_/;
+ print $logfile ('New: '.$disp_key."\n");
+ $chparms .= $disp_key.' ';
}
}
}
@@ -1117,16 +1114,18 @@ sub publish {
if (($_=~/^parameter/) || ($_=~/^stores/)) {
unless (($metadatafields{$_.'.name'}) ||
($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) {
- print $logfile 'Obsolete: '.$_."\n";
- $chparms.=$_.' ';
+ my $disp_key = $_;
+ $disp_key =~ tr/\0/_/;
+ print $logfile ('Obsolete: '.$disp_key."\n");
+ $chparms.=$disp_key.' ';
}
}
}
if ($chparms) {
$scrout.=''.&mt('Obsolete parameters or stored values').': '.
- $chparms.'
'.&mt('Warning!').
- '
'.
- &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'
';
+ $chparms.''.&mt('Warning!').
+ '
'.
+ &mt('If this resource is in active use, student performance data from the previous version may become inaccessible.').'
';
}
# ------------------------------------------------------- Now have all metadata
@@ -1470,6 +1469,7 @@ sub phasetwo {
$metadatafields{'modifyinguser'}=$env{'user.name'}.':'.
$env{'user.domain'};
$metadatafields{'authorspace'}=$cuname.':'.$cudom;
+ $metadatafields{'domain'}=$cudom;
my $allkeywords=$env{'form.addkey'};
if (exists($env{'form.keywords'})) {
@@ -1668,7 +1668,7 @@ sub phasetwo {
unless ($batch) {
my $thissrc=$source;
- $thissrc=~s/^\/home\/(\w+)\/public_html/\/priv\/$1/;
+ $thissrc=~s{^/home/($match_username)/public_html}{/priv/$1};
my $thissrcdir=$thissrc;
$thissrcdir=~s/\/[^\/]+$/\//;
@@ -1993,8 +1993,8 @@ sub handler {
return HTTP_NOT_ACCEPTABLE;
}
- $fn=~s/^http\:\/\/[^\/]+//;
- $fn=~s/^\/\~(\w+)/\/home\/$1\/public_html/;
+ $fn=~s{^http://[^/]+}{};
+ $fn=~s{^/~($match_username)}{/home/$1/public_html};
my $targetdir='';
$docroot=$r->dir_config('lonDocRoot');