--- loncom/publisher/lonpublisher.pm 2001/08/13 12:53:06 1.37
+++ loncom/publisher/lonpublisher.pm 2001/12/06 18:56:14 1.62
@@ -1,5 +1,30 @@
# The LearningOnline Network with CAPA
# Publication Handler
+#
+# $Id: lonpublisher.pm,v 1.62 2001/12/06 18:56:14 www Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
+#
#
# (TeX Content Handler
#
@@ -11,7 +36,11 @@
# 04/16/2001 Scott Harrison
# 05/03,05/05,05/07 Gerd Kortemeyer
# 05/28/2001 Scott Harrison
-# 06/23,08/07,08/11,8/13 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 Gerd Kortemeyer
package Apache::lonpublisher;
@@ -71,7 +100,8 @@ sub metaeval {
} @{$token->[3]};
if ($metadatafields{$unikey}) {
my $newentry=$parser->get_text('/'.$entry);
- unless ($metadatafields{$unikey}=~/$newentry/) {
+ unless (($metadatafields{$unikey}=~/$newentry/) ||
+ ($newentry eq '')) {
$metadatafields{$unikey}.=', '.$newentry;
}
} else {
@@ -135,6 +165,7 @@ sub selectbox {
sub urlfixup {
my ($url,$target)=@_;
+ unless ($url) { return ''; }
my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/);
map {
if ($_ eq $host) {
@@ -142,6 +173,7 @@ sub urlfixup {
$url=~s/^$host//;
}
} values %Apache::lonnet::hostname;
+ if ($url=~/^http\:\/\//) { return $url; }
$url=~s/\~$cuname/res\/$cudom\/$cuname/;
if ($target) {
$target=~s/\/[^\/]+$//;
@@ -222,14 +254,18 @@ sub publish {
}
my $outstring='';
my $parser=HTML::TokeParser->new(\$content);
+ $parser->xml_mode(1);
my $token;
while ($token=$parser->get_token) {
if ($token->[0] eq 'S') {
my $counter;
my $tag=$token->[1];
- unless ($tag eq 'allow') {
+ my $lctag=lc($tag);
+ unless ($lctag eq 'allow') {
my %parms=%{$token->[2]};
- if ($counter=$addid{$tag}) {
+ $counter=$addid{$tag};
+ if (!$counter) { $counter=$addid{$lctag}; }
+ if ($counter) {
if ($counter eq 'id') {
unless (defined($parms{'id'})) {
$maxid++;
@@ -256,7 +292,38 @@ sub publish {
}
$allow{$newurl}=1;
}
- } ('src','href','codebase');
+ } ('src','href','background');
+
+ if ($lctag eq 'applet') {
+ my $codebase='';
+ if (defined($parms{'codebase'})) {
+ my $oldcodebase=$parms{'codebase'};
+ unless ($oldcodebase=~/\/$/) {
+ $oldcodebase.='/';
+ }
+ $codebase=&urlfixup($oldcodebase,$target);
+ $codebase=~s/\/$//;
+ if ($codebase ne $oldcodebase) {
+ $parms{'codebase'}=$codebase;
+ print $logfile 'URL codebase: '.$tag.':'.
+ $oldcodebase.' - '.
+ $codebase."\n";
+ }
+ $allow{$codebase.'/*'}=1;
+ } else {
+ map {
+ if (defined($parms{$_})) {
+ my $oldurl=$parms{$_};
+ my $newurl=&urlfixup($oldurl,$target);
+ $newurl=~s/\/[^\/]+$/\/\*/;
+ print $logfile 'Allow: applet '.$_.':'.
+ $oldurl.' allows '.
+ $newurl."\n";
+ $allow{$newurl}=1;
+ }
+ } ('archive','code','object');
+ }
+ }
my $newparmstring='';
my $endtag='';
@@ -268,27 +335,55 @@ sub publish {
$newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote;
}
} keys %parms;
-
+ if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; }
$outstring.='<'.$tag.$newparmstring.$endtag.'>';
} else {
$allow{$token->[2]->{'src'}}=1;
}
} elsif ($token->[0] eq 'E') {
+ if ($token->[2]) {
unless ($token->[1] eq 'allow') {
- $outstring.=$token->[2];
+ $outstring.='[1].'>';
}
+ }
} else {
$outstring.=$token->[1];
}
}
# ------------------------------------------------------------ Construct Allows
- unless ($style eq 'rat') {
- my $allowstr="\n";
+
+ $scrout.='Dependencies
';
+ my $allowstr='';
map {
- $allowstr.=''."\n";
+ my $thisdep=$_;
+ unless ($style eq 'rat') {
+ $allowstr.="\n".'';
+ }
+ $scrout.='
';
+ unless ($thisdep=~/\*/) {
+ $scrout.='';
+ }
+ $scrout.=''.$thisdep.'';
+ unless ($thisdep=~/\*/) {
+ $scrout.='';
+ if (
+ &Apache::lonnet::getfile($Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
+ $thisdep.'.meta') eq '-1') {
+ $scrout.=
+ ' - Currently not available';
+ } else {
+ my %temphash=(&Apache::lonnet::declutter($target).'___'.
+ &Apache::lonnet::declutter($thisdep).'___usage'
+ => time);
+ $thisdep=~/^\/res\/(\w+)\/(\w+)\//;
+ if ((defined($1)) && (defined($2))) {
+ &Apache::lonnet::put('resevaldata',\%temphash,$1,$2);
+ }
+ }
+ }
} keys %allow;
$outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s;
- }
+
# ------------------------------------------------------------- Write modified
{
@@ -318,6 +413,8 @@ sub publish {
%metadatakeys=();
my %oldparmstores=();
+
+ $scrout.='Metadata Information
';
# ------------------------------------------------ First, check out environment
unless (-e $source.'.meta') {
@@ -368,7 +465,11 @@ sub publish {
# -------------------------------------------------- Parse content for metadata
if ($style eq 'ssi') {
+ my $oldenv=$ENV{'request.uri'};
+
+ $ENV{'request.uri'}=$target;
$allmeta=Apache::lonxml::xmlparse('meta',$content);
+ $ENV{'request.uri'}=$oldenv;
&metaeval($allmeta);
}
@@ -412,6 +513,7 @@ sub publish {
&hiddenfield('phase','two').
&hiddenfield('filename',$ENV{'form.filename'}).
&hiddenfield('allmeta',&Apache::lonnet::escape($allmeta)).
+ &hiddenfield('dependencies',join(',',keys %allow)).
&textfield('Title','title',$metadatafields{'title'}).
&textfield('Author(s)','author',$metadatafields{'author'}).
&textfield('Subject','subject',$metadatafields{'subject'});
@@ -421,7 +523,7 @@ sub publish {
my $keywordout='Keywords:
';
my $colcount=0;
- {
+ if (length($content)<500000) {
my $textonly=$content;
$textonly=~s/\//g;
$textonly=~s/\[^\<]+\<\/m\>//g;
@@ -453,11 +555,14 @@ sub publish {
}
$colcount++;
} sort keys %keywords;
- $keywordout.='
';
+ } else {
+ $keywordout.='File too long for keyword analysis | ';
}
- $scrout.=$keywordout;
+ $keywordout.='';
+
+ $scrout.=$keywordout;
$scrout.=&textfield('Additional Keywords','addkey','');
@@ -484,6 +589,13 @@ sub publish {
$scrout.=&textfield('Publisher/Owner','owner',
$metadatafields{'owner'});
+# --------------------------------------------------- Correct copyright for rat
+ if ($style eq 'rat') {
+ if ($metadatafields{'copyright'} eq 'public') {
+ delete $metadatafields{'copyright'};
+ }
+ delete $cprtag{'public'};
+ }
$scrout.=&selectbox('Copyright/Distribution','copyright',
$metadatafields{'copyright'},%cprtag);
@@ -523,6 +635,7 @@ sub phasetwo {
$metadatafields{'lastrevisiondate'}=$ENV{'form.lastrevisiondate'};
$metadatafields{'owner'}=$ENV{'form.owner'};
$metadatafields{'copyright'}=$ENV{'form.copyright'};
+ $metadatafields{'dependencies'}=$ENV{'form.dependencies'};
my $allkeywords=$ENV{'form.addkey'};
map {
@@ -799,6 +912,20 @@ sub handler {
return OK;
}
+# Get query string for limited number of parameters
+
+ map {
+ my ($name, $value) = split(/=/,$_);
+ $value =~ tr/+/ /;
+ $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
+ if ($name eq 'filename') {
+ unless ($ENV{'form.'.$name}) {
+ $ENV{'form.'.$name}=$value;
+ }
+ }
+ } (split(/&/,$ENV{'QUERY_STRING'}));
+
+
# -------------------------------------------------------------- Check filename
my $fn=$ENV{'form.filename'};
@@ -830,7 +957,8 @@ sub handler {
return HTTP_NOT_ACCEPTABLE;
}
- $fn=~s/^http\:\/\/[^\/]+\/\~(\w+)/\/home\/$1\/public_html/;
+ $fn=~s/^http\:\/\/[^\/]+//;
+ $fn=~s/^\/\~(\w+)/\/home\/$1\/public_html/;
my $targetdir='';
$docroot=$r->dir_config('lonDocRoot');