--- loncom/publisher/lonpublisher.pm 2011/10/22 23:09:44 1.271 +++ loncom/publisher/lonpublisher.pm 2013/12/01 21:50:30 1.288 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.271 2011/10/22 23:09:44 www Exp $ +# $Id: lonpublisher.pm,v 1.288 2013/12/01 21:50:30 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -66,10 +66,10 @@ invocation by F: =head1 OVERVIEW -Authors can only write-access the C space. They can -copy resources into the resource area through the publication step, -and move them back through a recover step. Authors do not have direct -write-access to their resource space. +Authors can only write-access the C space. +They can copy resources into the resource area through the +publication step, and move them back through a recover step. +Authors do not have direct write-access to their resource space. During the publication step, several events will be triggered. Metadata is gathered, where a wizard manages default @@ -102,8 +102,6 @@ to publication space. Many of the undocumented subroutines implement various magical parsing shortcuts. -=over 4 - =cut ###################################################################### @@ -121,7 +119,6 @@ use HTML::LCParser; use HTML::Entities; use Encode::Encoder; use Apache::lonxml; -use Apache::loncacc; use DBI; use Apache::lonnet; use Apache::loncommon(); @@ -150,6 +147,8 @@ my $lock; =pod +=over 4 + =item B Evaluates a string that contains metadata. This subroutine @@ -791,10 +790,55 @@ sub fix_ids_and_indices { } if (!$endtag) { if ($token->[4]=~m:/>$:) { $endtag=' /'; }; } $outstring.='<'.$tag.$newparmstring.$endtag.'>'; - if ($lctag eq 'm' || $lctag eq 'script' || $lctag eq 'answer' - || $lctag eq 'display' || $lctag eq 'tex') { + if ($lctag eq 'm' || $lctag eq 'answer' || $lctag eq 'display' || + $lctag eq 'tex') { $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser); - } + } elsif ($lctag eq 'script') { + if ($parms{'type'} eq 'loncapa/perl') { + $outstring.=&get_all_text_unbalanced('/'.$lctag,\@parser); + } else { + my $script = &get_all_text_unbalanced('/'.$lctag,\@parser); + if ($script =~ m{\.set\w+(Src|Swf)\(["']}i) { + my @srcs = split(/\.set/i,$script); + if (scalar(@srcs) > 1) { + foreach my $item (@srcs) { + if ($item =~ m{^(FlashPlayerSwf|MediaSrc|XMPSrc|ConfigurationSrc|PosterImageSrc)\((['"])(?:(?!\2).)+\2\)}is) { + my $srctype = $1; + my $quote = $2; + my ($url) = ($item =~ m{^\Q$srctype($quote\E([^$quote]+)\Q$quote)\E}); + $url = &urlfixup($url); + unless ($url=~m{^(?:http|https|ftp)://}) { + $allow{&absoluteurl($url,$target)}=1; + if ($srctype eq 'ConfigurationSrc') { + if ($url =~ m{^(.+/)configuration_express\.xml$}) { +# +# Camtasia 8.1: express_show/spritesheet.png needed, and included in zip archive. +# Not referenced directly in
.html or
_player.html files, +# so add this file to %allow (where
is name user gave to file/archive). +# + my $spritesheet = $1.'express_show/spritesheet.png'; + $allow{&absoluteurl($spritesheet,$target)}=1; + } + } elsif ($srctype eq 'PosterImageSrc') { + if ($url =~ m{^(.+)_First_Frame\.png$}) { + my $prefix = $1; +# +# Camtasia 8.1:
_Thumbnails.png needed, and included in zip archive. +# Not referenced directly in
.html or
_player.html files, +# so add this file to %allow (where
is name user gave to file/archive). +# + my $thumbnail = $prefix.'_Thumbnails.png'; + $allow{&absoluteurl($thumbnail,$target)}=1; + } + } + } + } + } + } + } + $outstring .= $script + } + } } elsif ($token->[0] eq 'E') { if ($token->[2]) { unless ($token->[1] eq 'allow') { @@ -1017,6 +1061,11 @@ sub publish { $outdep.= ' - '.&mt('Currently not available'). ''; } else { +# +# Store the fact that the dependency has been used by the target file +# Unfortunately, usage is erroneously named sequsage in lonmeta.pm +# The translation happens in lonmetadata.pm +# my %temphash=(&Apache::lonnet::declutter($target).'___'. &Apache::lonnet::declutter($thisdep).'___usage' => time); @@ -1480,6 +1529,8 @@ Returns: 0: fail 1: success +=back + =cut #'stupid emacs @@ -1770,21 +1821,17 @@ sub phasetwo { my $thissrcdir=$thissrc; $thissrcdir=~s/\/[^\/]+$/\//; - $r->print(&Apache::loncommon::head_subbox( - &Apache::lonhtmlcommon::start_funclist(). - &Apache::lonhtmlcommon::add_item_funclist( + $r->print( + &Apache::lonhtmlcommon::actionbox([ ''. &mt('View Published Version'). - ''). - &Apache::lonhtmlcommon::add_item_funclist( + '', ''. &mt('Back to Source'). - ''). - &Apache::lonhtmlcommon::add_item_funclist( + '', ''. &mt('Back to Source Directory'). - ''). - &Apache::lonhtmlcommon::end_funclist()) + '']) ); } return 1; @@ -1878,15 +1925,15 @@ sub publishdirectory { my ($r,$fn,$thisdisfn)=@_; $fn=~s/\/+/\//g; $thisdisfn=~s/\/+/\//g; - my $resdir= - $Apache::lonnet::perlvar{'lonDocRoot'}.'/res/'.$cudom.'/'.$cuname.'/'. - $thisdisfn; + my $thisdisresdir=$thisdisfn; + $thisdisresdir=~s/^\/priv\//\/res\//; + my $resdir = $r->dir_config('lonDocRoot').$thisdisresdir; $r->print(&Apache::lonhtmlcommon::start_pick_box() .&Apache::lonhtmlcommon::row_title(&mt('Directory')) .''.$thisdisfn.'' .&Apache::lonhtmlcommon::row_closure() .&Apache::lonhtmlcommon::row_title(&mt('Target')) - .''.$resdir.'' + .''.$thisdisresdir.'' ); my $dirptr=16384; # Mask indicating a directory in stat.cmode. @@ -1895,7 +1942,7 @@ sub publishdirectory { $r->print(&Apache::lonhtmlcommon::row_closure() .&Apache::lonhtmlcommon::row_title(&mt('Options')) ); - $r->print('
'. + $r->print(''. &hiddenfield('phase','two'). &hiddenfield('filename',$env{'form.filename'}). &checkbox('pubrec','include subdirectories'). @@ -2014,7 +2061,7 @@ sub defaultmetapublish { $r->print($reply.'


');$r->rflush; } # ------------------------------------------------------------------- Link back - $r->print("".&mt('Back to Metadata').''); + $r->print("".&mt('Back to Metadata').''); $r->print(&Apache::loncommon::end_page()); return OK; } @@ -2078,7 +2125,7 @@ sub handler { # -------------------------------------------------------------- Check filename my $fn=&unescape($env{'form.filename'}); - ($cuname,$cudom)=&Apache::loncacc::constructaccess($fn); + ($cuname,$cudom)=&Apache::lonnet::constructaccess($fn); # ----------------------------------------------------- Do we have permissions? unless (($cuname) && ($cudom)) { $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}. @@ -2143,8 +2190,8 @@ sub handler { # Breadcrumbs &Apache::lonhtmlcommon::clear_breadcrumbs(); &Apache::lonhtmlcommon::add_breadcrumb({ - 'text' => 'Construction Space', - 'href' => &Apache::loncommon::authorspace(), + 'text' => 'Authoring Space', + 'href' => &Apache::loncommon::authorspace($fn), }); &Apache::lonhtmlcommon::add_breadcrumb({ 'text' => 'Resource Publication', @@ -2157,7 +2204,7 @@ sub handler { $r->print(&Apache::loncommon::start_page('Resource Publication',$js) .&Apache::lonhtmlcommon::breadcrumbs() .&Apache::loncommon::head_subbox( - &Apache::loncommon::CSTR_pageheader()) # FIXME crumbs broken? + &Apache::loncommon::CSTR_pageheader($docroot.$fn)) ); my $thisdisfn=&HTML::Entities::encode($fn,'<>&"'); @@ -2167,7 +2214,7 @@ sub handler { if ($fn=~/\/$/) { # -------------------------------------------------------- This is a directory - &publishdirectory($r,$fn,$thisdisfn); + &publishdirectory($r,$docroot.$fn,$thisdisfn); $r->print('
'.&mt('Return to Directory').''); } else { # ---------------------- Evaluate individual file, and then output information. @@ -2218,7 +2265,7 @@ ENDCAPTION $r->print(&Apache::lonhtmlcommon::row_closure() .&Apache::lonhtmlcommon::row_title(&mt('Diffs'))); $r->print(< + ENDDIFF $r->print(&mt('Diffs with Current Version').''); } @@ -2237,7 +2284,7 @@ ENDDIFF } unless ($errorcount) { my ($outstring,$error)= - &publish($docroot.$fn,$thistarget,$thisembstyle); + &publish($docroot.$fn,$docroot.$thistarget,$thisembstyle); $r->print($outstring); } else { $r->print('

'. @@ -2245,7 +2292,7 @@ ENDDIFF '

'); } } else { - &phasetwo($r,$fn,$thistarget,$thisembstyle,$thisdistarget); + &phasetwo($r,$docroot.$fn,$docroot.$thistarget,$thisembstyle,$thisdistarget); } } $r->print(&Apache::loncommon::end_page()); @@ -2260,7 +2307,5 @@ __END__ =back -=back - =cut