--- loncom/publisher/lonpublisher.pm 2001/05/08 01:26:48 1.27 +++ loncom/publisher/lonpublisher.pm 2001/12/05 21:12:04 1.59 @@ -1,5 +1,30 @@ # The LearningOnline Network with CAPA # Publication Handler +# +# $Id: lonpublisher.pm,v 1.59 2001/12/05 21:12:04 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 # @@ -10,6 +35,10 @@ # 03/24,03/29,04/03 Gerd Kortemeyer # 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,8/17,8/18,8/24,9/26,10/16 Gerd Kortemeyer +# 12/04,12/05 Guy Albertelli +# 12/05 Gerd Kortemeyer package Apache::lonpublisher; @@ -47,9 +76,15 @@ sub metaeval { if ($token->[0] eq 'S') { my $entry=$token->[1]; my $unikey=$entry; + if (defined($token->[2]->{'package'})) { + $unikey.='_package_'.$token->[2]->{'package'}; + } if (defined($token->[2]->{'part'})) { $unikey.='_'.$token->[2]->{'part'}; } + if (defined($token->[2]->{'id'})) { + $unikey.='_'.$token->[2]->{'id'}; + } if (defined($token->[2]->{'name'})) { $unikey.='_'.$token->[2]->{'name'}; } @@ -63,7 +98,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 { @@ -125,6 +161,25 @@ sub selectbox { # -------------------------------------------------------- Publication Step One +sub urlfixup { + my ($url,$target)=@_; + unless ($url) { return ''; } + my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/); + map { + if ($_ eq $host) { + $url=~s/^http\:\/\///; + $url=~s/^$host//; + } + } values %Apache::lonnet::hostname; + if ($url=~/^http\:\/\//) { return $url; } + $url=~s/\~$cuname/res\/$cudom\/$cuname/; + if ($target) { + $target=~s/\/[^\/]+$//; + $url=&Apache::lonnet::hreflocation($target,$url); + } + return $url; +} + sub publish { my ($source,$target,$style)=@_; @@ -132,6 +187,8 @@ sub publish { my $scrout=''; my $allmeta=''; my $content=''; + my %allow=(); + undef %allow; unless ($logfile=Apache::File->new('>>'.$source.'.log')) { return @@ -192,46 +249,139 @@ sub publish { print $logfile "Needs ID and/or index fixup\n". "Max ID : $maxid (min 10)\n". "Max Index: $maxindex (min 10)\n"; - + } 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; - if ($counter=$addid{$token->[1]}) { + my $counter; + my $tag=$token->[1]; + my $lctag=lc($tag); + unless ($lctag eq 'allow') { + my %parms=%{$token->[2]}; + $counter=$addid{$tag}; + if (!$counter) { $counter=$addid{$lctag}; } + if ($counter) { if ($counter eq 'id') { - if (defined($token->[2]->{'id'})) { - $outstring.=$token->[4]; - } else { + unless (defined($parms{'id'})) { $maxid++; - my $thisid=' id="'.$maxid.'"'; - my $fixup=$token->[4]; - $fixup=~s/(\<\w+)/$1$thisid/; - $outstring.=$fixup; - print $logfile 'ID: '.$fixup."\n"; + $parms{'id'}=$maxid; + print $logfile 'ID: '.$tag.':'.$maxid."\n"; } - } else { - if (defined($token->[2]->{'index'})) { - $outstring.=$token->[4]; - } else { + } elsif ($counter eq 'index') { + unless (defined($parms{'index'})) { $maxindex++; - my $thisindex=' index="'.$maxindex.'"'; - my $fixup=$token->[4]; - $fixup=~s/(\<\w+)/$1$thisindex/; - $outstring.=$fixup; - print $logfile 'Index: '.$fixup."\n"; + $parms{'index'}=$maxindex; + print $logfile 'Index: '.$tag.':'.$maxindex."\n"; } } - } else { - $outstring.=$token->[4]; + } + + map { + if (defined($parms{$_})) { + my $oldurl=$parms{$_}; + my $newurl=&urlfixup($oldurl,$target); + if ($newurl ne $oldurl) { + $parms{$_}=$newurl; + print $logfile 'URL: '.$tag.':'.$oldurl.' - '. + $newurl."\n"; + } + $allow{$newurl}=1; + } + } ('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=''; + map { + if ($_ eq '/') { + $endtag=' /'; + } else { + my $quote=($parms{$_}=~/\"/?"'":'"'); + $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') { - $outstring.=$token->[2]; + if ($token->[2]) { + unless ($token->[1] eq 'allow') { + $outstring.='[1].'>'; + } + } } else { $outstring.=$token->[1]; } } +# ------------------------------------------------------------ Construct Allows + unless ($style eq 'rat') { + $scrout.='

Dependencies

'; + my $allowstr="\n"; + map { + my $thisdep=$_; + $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 + { my $org; unless ($org=Apache::File->new('>'.$source)) { @@ -242,13 +392,15 @@ sub publish { print $org $outstring; } $content=$outstring; + + if ($needsfixup) { print $logfile "End of ID and/or index fixup\n". "Max ID : $maxid (min 10)\n". "Max Index: $maxindex (min 10)\n"; } else { print $logfile "Does not need ID and/or index fixup\n"; } - + } # --------------------------------------------- Initial step done, now metadata # ---------------------------------------- Storage for metadata keys and fields @@ -257,6 +409,8 @@ sub publish { %metadatakeys=(); my %oldparmstores=(); + + $scrout.='

Metadata Information

'; # ------------------------------------------------ First, check out environment unless (-e $source.'.meta') { @@ -306,10 +460,15 @@ 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); - &metaeval($allmeta); + $ENV{'request.uri'}=$oldenv; + &metaeval($allmeta); + } # ---------------- Find and document discrepancies in the parameters and stores my $chparms=''; @@ -331,7 +490,8 @@ sub publish { my $chparms=''; map { if (($_=~/^parameter/) || ($_=~/^stores/)) { - unless (($metadatafields{$_.'.name'}) || ($_=~/\.\w+$/)) { + unless (($metadatafields{$_.'.name'}) || + ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) { print $logfile 'Obsolete: '.$_."\n"; $chparms.=$_.' '; } @@ -341,7 +501,7 @@ sub publish { $scrout.='

Obsolete parameters or stored values: '. $chparms; } - } + # ------------------------------------------------------- Now have all metadata $scrout.= @@ -349,6 +509,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'}); @@ -358,7 +519,7 @@ sub publish { my $keywordout='

Keywords:
'; my $colcount=0; - { + if (length($content)<500000) { my $textonly=$content; $textonly=~s/\//g; $textonly=~s/\[^\<]+\<\/m\>//g; @@ -390,11 +551,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',''); @@ -421,6 +585,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); @@ -510,44 +681,55 @@ sub phasetwo { } close(CONFIG); + my $warning; my $dbh; { unless ( $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0}) ) { - return 'Cannot connect to database!'; + $warning='WARNING: Cannot connect to '. + 'database!'; + } + else { + my %sqldatafields; + $sqldatafields{'url'}=$distarget; + my $sth=$dbh->prepare( + 'delete from metadata where url like binary'. + '"'.$sqldatafields{'url'}.'"'); + $sth->execute(); + map {my $field=$metadatafields{$_}; $field=~s/\"/\'\'/g; + $sqldatafields{$_}=$field;} + ('title','author','subject','keywords','notes','abstract', + 'mime','language','creationdate','lastrevisiondate','owner', + 'copyright'); + + $sth=$dbh->prepare('insert into metadata values ('. + '"'.delete($sqldatafields{'title'}).'"'.','. + '"'.delete($sqldatafields{'author'}).'"'.','. + '"'.delete($sqldatafields{'subject'}).'"'.','. + '"'.delete($sqldatafields{'url'}).'"'.','. + '"'.delete($sqldatafields{'keywords'}).'"'.','. + '"'.'current'.'"'.','. + '"'.delete($sqldatafields{'notes'}).'"'.','. + '"'.delete($sqldatafields{'abstract'}).'"'.','. + '"'.delete($sqldatafields{'mime'}).'"'.','. + '"'.delete($sqldatafields{'language'}).'"'.','. + '"'. + sqltime(delete($sqldatafields{'creationdate'})) + .'"'.','. + '"'. + sqltime(delete( + $sqldatafields{'lastrevisiondate'})).'"'.','. + '"'.delete($sqldatafields{'owner'}).'"'.','. + '"'.delete( + $sqldatafields{'copyright'}).'"'.')'); + $sth->execute(); + $dbh->disconnect; + $scrout.='

Synchronized SQL metadata database'; + print $logfile "\nSynchronized SQL metadata database"; } } - my %sqldatafields; - $sqldatafields{'url'}=$distarget; - my $sth=$dbh->prepare("delete from metadata where url like binary \"". - $sqldatafields{'url'}."\""); - $sth->execute(); - map {my $field=$metadatafields{$_}; $field=~s/\"/\'\'/g; - $sqldatafields{$_}=$field;} - ('title','author','subject','keywords','notes','abstract', - 'mime','language','creationdate','lastrevisiondate','owner','copyright'); - - $sth=$dbh->prepare('insert into metadata values ('. - '"'.delete($sqldatafields{'title'}).'"'.','. - '"'.delete($sqldatafields{'author'}).'"'.','. - '"'.delete($sqldatafields{'subject'}).'"'.','. - '"'.delete($sqldatafields{'url'}).'"'.','. - '"'.delete($sqldatafields{'keywords'}).'"'.','. - '"'.'current'.'"'.','. - '"'.delete($sqldatafields{'notes'}).'"'.','. - '"'.delete($sqldatafields{'abstract'}).'"'.','. - '"'.delete($sqldatafields{'mime'}).'"'.','. - '"'.delete($sqldatafields{'language'}).'"'.','. - '"'.sqltime(delete($sqldatafields{'creationdate'})).'"'.','. - '"'.sqltime(delete($sqldatafields{'lastrevisiondate'})).'"'.','. - '"'.delete($sqldatafields{'owner'}).'"'.','. - '"'.delete($sqldatafields{'copyright'}).'"'.')'); - $sth->execute(); - $dbh->disconnect; - $scrout.='

Synchronized SQL metadata database'; - print $logfile "\nSynchronized SQL metadata database"; # ----------------------------------------------------------- Copy old versions @@ -706,7 +888,7 @@ if (-e $target) { $thissrcdir=~s/\/[^\/]+$/\//; - return $scrout. + return $warning.$scrout. '


View Target'. '

Back to Source'. '

dir_config('lonDefDomain'))) { + ($cuname,$cudom)= + &Apache::loncacc::constructaccess($fn,$r->dir_config('lonDefDomain')); + unless (($cuname) && ($cudom)) { $r->log_reason($cuname.' at '.$cudom. ' trying to publish file '.$ENV{'form.filename'}. ' ('.$fn.') - not authorized', @@ -755,7 +952,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'); @@ -861,7 +1059,8 @@ unless ($ENV{'form.phase'} eq 'two') { } if (&Apache::lonnet::fileembstyle($thistype) eq 'ssi') { - $r->print('
Diffs with Current Version

'); }