--- loncom/publisher/lonpublisher.pm 2001/10/16 18:46:10 1.49 +++ loncom/publisher/lonpublisher.pm 2002/01/08 21:14:53 1.68 @@ -1,5 +1,30 @@ # The LearningOnline Network with CAPA # Publication Handler +# +# $Id: lonpublisher.pm,v 1.68 2002/01/08 21:14:53 albertel 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,11 +36,31 @@ # 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 Gerd Kortemeyer -# 10/3,10/8 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 +# 12/05 Guy Albertelli +# 12/06,12/07 Gerd Kortemeyer +# 12/15,12/16 Scott Harrison +# 12/25 Gerd Kortemeyer +# +### + +############################################################################### +## ## +## ORGANIZATION OF THIS PERL MODULE ## +## ## +## 1. Modules used by this module ## +## 2. Various subroutines ## +## 3. Publication Step One ## +## 4. Phase Two ## +## 5. Main Handler ## +## ## +############################################################################### package Apache::lonpublisher; +# ------------------------------------------------- modules used by this module use strict; use Apache::File; use File::Copy; @@ -25,11 +70,11 @@ use Apache::lonxml; use Apache::lonhomework; use Apache::loncacc; use DBI; +use Apache::lonnet(); +use Apache::loncommon(); my %addid; my %nokey; -my %language; -my %cprtag; my %metadatafields; my %metadatakeys; @@ -40,7 +85,6 @@ my $cuname; my $cudom; # ----------------------------------------------- Evaluate string with metadata - sub metaeval { my $metastring=shift; @@ -62,14 +106,14 @@ sub metaeval { if (defined($token->[2]->{'name'})) { $unikey.='_'.$token->[2]->{'name'}; } - map { + foreach (@{$token->[3]}) { $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_}; if ($metadatakeys{$unikey}) { $metadatakeys{$unikey}.=','.$_; } else { $metadatakeys{$unikey}=$_; } - } @{$token->[3]}; + } if ($metadatafields{$unikey}) { my $newentry=$parser->get_text('/'.$entry); unless (($metadatafields{$unikey}=~/$newentry/) || @@ -84,7 +128,6 @@ sub metaeval { } # -------------------------------------------------------- Read a metadata file - sub metaread { my ($logfile,$fn)=@_; unless (-e $fn) { @@ -123,13 +166,17 @@ sub hiddenfield { } sub selectbox { - my ($title,$name,$value,%options)=@_; - my $selout="\n

$title:
".''; + foreach (@idlist) { + $selout.='';} + } return $selout.''; } @@ -138,13 +185,17 @@ sub selectbox { sub urlfixup { my ($url,$target)=@_; unless ($url) { return ''; } + #javascript code needs no fixing + if ($url =~ /^javascript:/i) { return $url; } + #internal document links need no fixing + if ($url =~ /^\#/) { return $url; } my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/); - map { + foreach (values %Apache::lonnet::hostname) { 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) { @@ -155,6 +206,7 @@ sub urlfixup { } sub publish { + my ($source,$target,$style)=@_; my $logfile; my $scrout=''; @@ -225,14 +277,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++; @@ -248,7 +304,7 @@ sub publish { } } - map { + foreach ('src','href','background') { if (defined($parms{$_})) { my $oldurl=$parms{$_}; my $newurl=&urlfixup($oldurl,$target); @@ -259,9 +315,9 @@ sub publish { } $allow{$newurl}=1; } - } ('src','href','background'); + } - if ($tag eq 'applet') { + if ($lctag eq 'applet') { my $codebase=''; if (defined($parms{'codebase'})) { my $oldcodebase=$parms{'codebase'}; @@ -278,7 +334,7 @@ sub publish { } $allow{$codebase.'/*'}=1; } else { - map { + foreach ('archive','code','object') { if (defined($parms{$_})) { my $oldurl=$parms{$_}; my $newurl=&urlfixup($oldurl,$target); @@ -288,50 +344,69 @@ sub publish { $newurl."\n"; $allow{$newurl}=1; } - } ('archive','code','object'); + } } } my $newparmstring=''; my $endtag=''; - map { + foreach (keys %parms) { 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') { + 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 { - $allowstr.=''."\n"; + my $allowstr=''; + foreach (keys %allow) { + my $thisdep=$_; + unless ($style eq 'rat') { + $allowstr.="\n".''; + } $scrout.='
'; - unless ($_=~/\*/) { - $scrout.=''; + unless ($thisdep=~/\*/) { + $scrout.=''; } - $scrout.=''.$_.''; - unless ($_=~/\*/) { + $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 { @@ -384,30 +459,30 @@ sub publish { my $currentpath='/home/'.$cuname.'/'; - map { + foreach (@urlparts) { $currentpath.=$_.'/'; $scrout.=&metaread($logfile,$currentpath.'default.meta'); - } @urlparts; + } # ------------------- Clear out parameters and stores (there should not be any) - map { + foreach (keys %metadatafields) { if (($_=~/^parameter/) || ($_=~/^stores/)) { delete $metadatafields{$_}; } - } keys %metadatafields; + } } else { # ---------------------- Read previous metafile, remember parameters and stores $scrout.=&metaread($logfile,$source.'.meta'); - map { + foreach (keys %metadatafields) { if (($_=~/^parameter/) || ($_=~/^stores/)) { $oldparmstores{$_}=1; delete $metadatafields{$_}; } - } keys %metadatafields; + } } @@ -424,7 +499,7 @@ sub publish { # ---------------- Find and document discrepancies in the parameters and stores my $chparms=''; - map { + foreach (sort keys %metadatafields) { if (($_=~/^parameter/) || ($_=~/^stores/)) { unless ($_=~/\.\w+$/) { unless ($oldparmstores{$_}) { @@ -433,14 +508,14 @@ sub publish { } } } - } sort keys %metadatafields; + } if ($chparms) { $scrout.='

New parameters or stored values: '. $chparms; } my $chparms=''; - map { + foreach (sort keys %oldparmstores) { if (($_=~/^parameter/) || ($_=~/^stores/)) { unless (($metadatafields{$_.'.name'}) || ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) { @@ -448,7 +523,7 @@ sub publish { $chparms.=$_.' '; } } - } sort keys %oldparmstores; + } if ($chparms) { $scrout.='

Obsolete parameters or stored values: '. $chparms; @@ -458,9 +533,11 @@ sub publish { $scrout.= '

'. + '

'. &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'}); @@ -469,8 +546,9 @@ sub publish { my $keywordout='

Keywords:
'; my $colcount=0; + my %keywords=(); - { + if (length($content)<500000) { my $textonly=$content; $textonly=~s/\//g; $textonly=~s/\[^\<]+\<\/m\>//g; @@ -479,52 +557,38 @@ sub publish { $textonly=~s/[\$\&][a-z]\w*//g; $textonly=~s/[^a-z\s]//g; - my %keywords=(); - my $j=0; - my $word; - for (my $i=0; $i'; if ($colcount>10) { $keywordout.="\n"; $colcount=0; } - else { - $colcount++; - } - } sort keys %keywords; - $keywordout.='
'; + $colcount++; + } + + $keywordout.=''; - } - $scrout.=$keywordout; + $scrout.=$keywordout; $scrout.=&textfield('Additional Keywords','addkey',''); @@ -539,7 +603,10 @@ sub publish { $scrout.=&hiddenfield('mime',$1); $scrout.=&selectbox('Language','language', - $metadatafields{'language'},%language); + $metadatafields{'language'}, + \&{Apache::loncommon::languagedescription}, + (&Apache::loncommon::languageids), + ); unless ($metadatafields{'creationdate'}) { $metadatafields{'creationdate'}=time; @@ -553,17 +620,22 @@ sub publish { $metadatafields{'owner'}); # --------------------------------------------------- Correct copyright for rat if ($style eq 'rat') { - if ($metadatafields{'copyright'} eq 'public') { - delete $metadatafields{'copyright'}; - } - delete $cprtag{'public'}; - } - + if ($metadatafields{'copyright'} eq 'public') { + delete $metadatafields{'copyright'}; + } $scrout.=&selectbox('Copyright/Distribution','copyright', - $metadatafields{'copyright'},%cprtag); - + $metadatafields{'copyright'}, + \&{Apache::loncommon::copyrightdescription}, + (grep !/^public$/,(&Apache::loncommon::copyrightids))); + } + else { + $scrout.=&selectbox('Copyright/Distribution','copyright', + $metadatafields{'copyright'}, + \&{Apache::loncommon::copyrightdescription}, + (&Apache::loncommon::copyrightids)); + } return $scrout. - '

'; + '

'; } # -------------------------------------------------------- Publication Step Two @@ -597,13 +669,14 @@ 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 { + foreach (keys %ENV) { if ($_=~/^form\.key\.(\w+)/) { $allkeywords.=','.$1; } - } keys %ENV; + } $allkeywords=~s/\W+/\,/; $allkeywords=~s/^\,//; $metadatafields{'keywords'}=$allkeywords; @@ -614,44 +687,36 @@ sub phasetwo { unless ($mfh=Apache::File->new('>'.$source.'.meta')) { return 'Could not write metadata, FAIL'; - } - map { + } + foreach (sort keys %metadatafields) { unless ($_=~/\./) { my $unikey=$_; $unikey=~/^([A-Za-z]+)/; my $tag=$1; $tag=~tr/A-Z/a-z/; print $mfh "\n\<$tag"; - map { + foreach (split(/\,/,$metadatakeys{$unikey})) { my $value=$metadatafields{$unikey.'.'.$_}; $value=~s/\"/\'\'/g; print $mfh ' '.$_.'="'.$value.'"'; - } split(/\,/,$metadatakeys{$unikey}); + } print $mfh '>'.$metadatafields{$unikey}.''; } - } sort keys %metadatafields; + } $scrout.='

Wrote Metadata'; print $logfile "\nWrote metadata"; } # -------------------------------- Synchronize entry with SQL metadata database - my %perlvar; - open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; - my $configline; - while ($configline=) { - if ($configline =~ /PerlSetVar/) { - my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); - chomp($varvalue); - $perlvar{$varname}=$varvalue; - } - } - close(CONFIG); + my $warning; + + unless ($metadatafields{'copyright'} eq 'priv') { - my $warning; my $dbh; { unless ( - $dbh = DBI->connect("DBI:mysql:loncapa","www",$perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0}) + $dbh = DBI->connect("DBI:mysql:loncapa","www", + $Apache::lonnet::perlvar{'lonSqlAccess'},{ RaiseError =>0,PrintError=>0}) ) { $warning='WARNING: Cannot connect to '. 'database!'; @@ -663,11 +728,12 @@ sub phasetwo { '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', + foreach ('title','author','subject','keywords','notes','abstract', 'mime','language','creationdate','lastrevisiondate','owner', - 'copyright'); + 'copyright') { + my $field=$metadatafields{$_}; $field=~s/\"/\'\'/g; + $sqldatafields{$_}=$field; + } $sth=$dbh->prepare('insert into metadata values ('. '"'.delete($sqldatafields{'title'}).'"'.','. @@ -696,7 +762,11 @@ sub phasetwo { } } - +} else { + $scrout.='

Private Publication - did not synchronize database'; + print $logfile "\nPrivate: Did not synchronize data into ". + "SQL metadata database"; +} # ----------------------------------------------------------- Copy old versions if (-e $target) { @@ -875,7 +945,7 @@ sub handler { # Get query string for limited number of parameters - map { + foreach (split(/&/,$ENV{'QUERY_STRING'})) { my ($name, $value) = split(/=/,$_); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; @@ -884,7 +954,7 @@ sub handler { $ENV{'form.'.$name}=$value; } } - } (split(/&/,$ENV{'QUERY_STRING'})); + } # -------------------------------------------------------------- Check filename @@ -959,31 +1029,11 @@ unless ($ENV{'form.phase'} eq 'two') { { my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab'); - map { + while (<$fh>) { my $word=$_; chomp($word); $nokey{$word}=1; - } <$fh>; - } - - %language=(); - - { - my $fh=Apache::File->new($r->dir_config('lonTabDir').'/language.tab'); - map { - $_=~/(\w+)\s+([\w\s\-]+)/; - $language{$1}=$2; - } <$fh>; - } - - %cprtag=(); - - { - my $fh=Apache::File->new($r->dir_config('lonIncludes').'/copyright.tab'); - map { - $_=~/(\w+)\s+([\w\s\-]+)/; - $cprtag{$1}=$2; - } <$fh>; + } } } @@ -1002,7 +1052,7 @@ unless ($ENV{'form.phase'} eq 'two') { { $thisfn=~/\.(\w+)$/; my $thistype=$1; - my $thisembstyle=&Apache::lonnet::fileembstyle($thistype); + my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); my $thistarget=$thisfn; @@ -1016,7 +1066,7 @@ unless ($ENV{'form.phase'} eq 'two') { $thisdisfn=~s/^\/home\/$cuname\/public_html\///; $r->print('

Publishing '. - &Apache::lonnet::filedescription($thistype).' '. + &Apache::loncommon::filedescription($thistype).' '. $thisdisfn.'

Target: '.$thisdistarget.'

'); if (($cuname ne $ENV{'user.name'}) || ($cudom ne $ENV{'user.domain'})) { @@ -1024,7 +1074,7 @@ unless ($ENV{'form.phase'} eq 'two') { ''); } - if (&Apache::lonnet::fileembstyle($thistype) eq 'ssi') { + if (&Apache::loncommon::fileembstyle($thistype) eq 'ssi') { $r->print('
Diffs with Current Version

'); @@ -1049,9 +1099,107 @@ unless ($ENV{'form.phase'} eq 'two') { 1; __END__ +=head1 NAME + +Apache::lonpublisher - Publication Handler + +=head1 SYNOPSIS + +Invoked by /etc/httpd/conf/srm.conf: + + + PerlAccessHandler Apache::lonacc + SetHandler perl-script + PerlHandler Apache::lonpublisher + ErrorDocument 403 /adm/login + ErrorDocument 404 /adm/notfound.html + ErrorDocument 406 /adm/unauthorized.html + ErrorDocument 500 /adm/errorhandler + + +=head1 INTRODUCTION + +This module publishes a file. This involves gathering metadata, +versioning the file, copying file from construction space to +publication space, and copying metadata from construction space +to publication space. + +This is part of the LearningOnline Network with CAPA project +described at http://www.lon-capa.org. + +=head1 HANDLER SUBROUTINE + +This routine is called by Apache and mod_perl. + +=over 4 + +=item * + +Get query string for limited number of parameters + +=item * + +Check filename + +=item * + +File is there and owned, init lookup tables + +=item * + +Start page output + +=item * + +Individual file + +=item * + +publish from $thisfn to $thistarget with $thisembstyle + +=back + +=head1 OTHER SUBROUTINES + +=over 4 + +=item * + +metaeval() : Evaluate string with metadata + +=item * + +metaread() : Read a metadata file + +=item * + +sqltime() : convert 'time' format into a datetime sql format + +=item * + +textfield() : form field + +=item * + +hiddenfield() : form field + +=item * + +selectbox() : form field + +=item * + +urlfixup() : fixup URL (Publication Step One) +=item * +publish() : publish (Publication Step One) +=item * +phasetwo() : render second interface showing status of publication steps +(Publication Step Two) +=back +=cut