--- loncom/publisher/lonpublisher.pm 2001/12/15 18:15:27 1.65 +++ loncom/publisher/lonpublisher.pm 2002/04/10 15:28:45 1.76 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.65 2001/12/15 18:15:27 harris41 Exp $ +# $Id: lonpublisher.pm,v 1.76 2002/04/10 15:28:45 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -41,7 +41,11 @@ # 12/05 Gerd Kortemeyer # 12/05 Guy Albertelli # 12/06,12/07 Gerd Kortemeyer -# 12/15 Scott Harrison +# 12/15,12/16 Scott Harrison +# 12/25 Gerd Kortemeyer +# YEAR=2002 +# 1/16,1/17 Scott Harrison +# 1/17 Gerd Kortemeyer # ### @@ -64,7 +68,7 @@ use strict; use Apache::File; use File::Copy; use Apache::Constants qw(:common :http :methods); -use HTML::TokeParser; +use HTML::LCParser; use Apache::lonxml; use Apache::lonhomework; use Apache::loncacc; @@ -87,7 +91,7 @@ my $cudom; sub metaeval { my $metastring=shift; - my $parser=HTML::TokeParser->new(\$metastring); + my $parser=HTML::LCParser->new(\$metastring); my $token; while ($token=$parser->get_token) { if ($token->[0] eq 'S') { @@ -145,8 +149,9 @@ sub metaread { # ---------------------------- convert 'time' format into a datetime sql format sub sqltime { + my $timef=shift @_; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = - localtime(@_[0]); + localtime($timef); $mon++; $year+=1900; return "$year-$mon-$mday $hour:$min:$sec"; } @@ -184,6 +189,11 @@ sub selectbox { sub urlfixup { my ($url,$target)=@_; unless ($url) { return ''; } + #javascript code needs no fixing + if ($url =~ /^javascript:/i) { return $url; } + if ($url =~ /^mailto:/i) { return $url; } + #internal document links need no fixing + if ($url =~ /^\#/) { return $url; } my ($host)=($url=~/(?:http\:\/\/)*([^\/]+)/); foreach (values %Apache::lonnet::hostname) { if ($_ eq $host) { @@ -193,6 +203,13 @@ sub urlfixup { } if ($url=~/^http\:\/\//) { return $url; } $url=~s/\~$cuname/res\/$cudom\/$cuname/; + return $url; +} + + +sub absoluteurl { + my ($url,$target)=@_; + unless ($url) { return ''; } if ($target) { $target=~s/\/[^\/]+$//; $url=&Apache::lonnet::hreflocation($target,$url); @@ -240,7 +257,7 @@ sub publish { $content=join('',<$org>); } { - my $parser=HTML::TokeParser->new(\$content); + my $parser=HTML::LCParser->new(\$content); my $token; while ($token=$parser->get_token) { if ($token->[0] eq 'S') { @@ -271,7 +288,7 @@ sub publish { "Max Index: $maxindex (min 10)\n"; } my $outstring=''; - my $parser=HTML::TokeParser->new(\$content); + my $parser=HTML::LCParser->new(\$content); $parser->xml_mode(1); my $token; while ($token=$parser->get_token) { @@ -297,19 +314,27 @@ sub publish { print $logfile 'Index: '.$tag.':'.$maxindex."\n"; } } - } - - foreach ('src','href','background') { - if (defined($parms{$_})) { - my $oldurl=$parms{$_}; - my $newurl=&urlfixup($oldurl,$target); - if ($newurl ne $oldurl) { - $parms{$_}=$newurl; - print $logfile 'URL: '.$tag.':'.$oldurl.' - '. - $newurl."\n"; + } + + foreach my $type ('src','href','background','bgimg') { + foreach my $key (keys(%parms)) { + if ($key =~ /^$type$/i) { + my $oldurl=$parms{$key}; + my $newurl=&urlfixup($oldurl,$target); + if ($newurl ne $oldurl) { + $parms{$key}=$newurl; + print $logfile 'URL: '.$tag.':'.$oldurl.' - '. + $newurl."\n"; + } + if (($newurl !~ /^javascript:/i) && + ($newurl !~ /^mailto:/i) && + ($newurl !~ /^http:/i) && + ($newurl !~ /^\#/)) { + $allow{&absoluteurl($newurl,$target)}=1; + } } - $allow{$newurl}=1; - } + last; + } } if ($lctag eq 'applet') { @@ -327,7 +352,7 @@ sub publish { $oldcodebase.' - '. $codebase."\n"; } - $allow{$codebase.'/*'}=1; + $allow{&absoluteurl($codebase,$target).'/*'}=1; } else { foreach ('archive','code','object') { if (defined($parms{$_})) { @@ -337,7 +362,7 @@ sub publish { print $logfile 'Allow: applet '.$_.':'. $oldurl.' allows '. $newurl."\n"; - $allow{$newurl}=1; + $allow{&absoluteurl($newurl,$target)}=1; } } } @@ -372,8 +397,9 @@ sub publish { $scrout.='

Dependencies

'; my $allowstr=''; - foreach (keys %allow) { + foreach (sort(keys(%allow))) { my $thisdep=$_; + if ($thisdep !~ /[^\s]/) { next; } unless ($style eq 'rat') { $allowstr.="\n".''; } @@ -400,8 +426,11 @@ sub publish { } } } + $allowstr=~s/\n+/\n/g; $outstring=~s/(\<\/[^\>]+\>\s*)$/$allowstr$1/s; + #Encode any High ASCII characters + $outstring=&HTML::Entities::encode($outstring,"\200-\377"); # ------------------------------------------------------------- Write modified { @@ -509,7 +538,7 @@ sub publish { $chparms; } - my $chparms=''; + $chparms=''; foreach (sort keys %oldparmstores) { if (($_=~/^parameter/) || ($_=~/^stores/)) { unless (($metadatafields{$_.'.name'}) || @@ -541,6 +570,7 @@ sub publish { my $keywordout='

Keywords:
'; my $colcount=0; + my %keywords=(); if (length($content)<500000) { my $textonly=$content; @@ -551,22 +581,27 @@ sub publish { $textonly=~s/[\$\&][a-z]\w*//g; $textonly=~s/[^a-z\s]//g; - my %keywords=(); foreach ($textonly=~m/(\w+)/g) { unless ($nokey{$_}) { $keywords{$_}=1; } } + } + foreach (split(/\W+/,$metadatafields{'keywords'})) { $keywords{$_}=1; } foreach (sort keys %keywords) { $keywordout.='\n"; @@ -574,10 +609,6 @@ sub publish { } $colcount++; } - - } else { - $keywordout.=''; - } $keywordout.='
'; if ($colcount>10) { $keywordout.="
File too long for keyword analysis
'; @@ -597,7 +628,7 @@ sub publish { $scrout.=&selectbox('Language','language', $metadatafields{'language'}, - \&{Apache::loncommon::languagedescription}, + \&Apache::loncommon::languagedescription, (&Apache::loncommon::languageids), ); @@ -618,13 +649,13 @@ sub publish { } $scrout.=&selectbox('Copyright/Distribution','copyright', $metadatafields{'copyright'}, - \&{Apache::loncommon::copyrightdescription}, + \&Apache::loncommon::copyrightdescription, (grep !/^public$/,(&Apache::loncommon::copyrightids))); } else { $scrout.=&selectbox('Copyright/Distribution','copyright', $metadatafields{'copyright'}, - \&{Apache::loncommon::copyrightdescription}, + \&Apache::loncommon::copyrightdescription, (&Apache::loncommon::copyrightids)); } return $scrout. @@ -693,7 +724,9 @@ sub phasetwo { $value=~s/\"/\'\'/g; print $mfh ' '.$_.'="'.$value.'"'; } - print $mfh '>'.$metadatafields{$unikey}.''; + print $mfh '>'. + &HTML::Entities::encode($metadatafields{$unikey}) + .''; } } $scrout.='

Wrote Metadata'; @@ -757,7 +790,8 @@ sub phasetwo { } else { $scrout.='

Private Publication - did not synchronize database'; - print $logfile "\nPrivate: Did not ynchronized SQL metadata database"; + print $logfile "\nPrivate: Did not synchronize data into ". + "SQL metadata database"; } # ----------------------------------------------------------- Copy old versions @@ -917,7 +951,7 @@ if (-e $target) { return $warning.$scrout. - '

View Target'. + '
View Published Version'. '

Back to Source'. '

Back to Source Directory'; @@ -1058,7 +1092,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'})) { @@ -1091,9 +1125,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