--- loncom/publisher/lonpublisher.pm 2011/10/31 17:27:10 1.275 +++ loncom/publisher/lonpublisher.pm 2016/03/22 16:41:10 1.295 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.275 2011/10/31 17:27:10 raeburn Exp $ +# $Id: lonpublisher.pm,v 1.295 2016/03/22 16:41:10 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -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 @@ -201,12 +200,12 @@ sub metaeval { if (defined($token->[2]->{'name'})) { $unikey.="\0".$token->[2]->{'name'}; } - foreach (@{$token->[3]}) { - $metadatafields{$unikey.'.'.$_}=$token->[2]->{$_}; + foreach my $item (@{$token->[3]}) { + $metadatafields{$unikey.'.'.$item}=$token->[2]->{$item}; if ($metadatakeys{$unikey}) { - $metadatakeys{$unikey}.=','.$_; + $metadatakeys{$unikey}.=','.$item; } else { - $metadatakeys{$unikey}=$_; + $metadatakeys{$unikey}=$item; } } my $newentry=$parser->get_text('/'.$entry); @@ -294,8 +293,8 @@ sub coursedependencies { my %evaldata=&Apache::lonnet::dump('nohist_resevaldata',$adomain, $aauthor,$regexp); my %courses=(); - foreach (keys %evaldata) { - if ($_=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) { + foreach my $item (keys(%evaldata)) { + if ($item=~/^([a-zA-Z0-9]+_[a-zA-Z0-9]+)___.+___course$/) { $courses{$1}=1; } } @@ -319,8 +318,12 @@ string which presents the form field (fo =item B +=item B + =item B +=item B + =item B =back @@ -383,12 +386,12 @@ sub selectbox { } my $selout="\n".&Apache::lonhtmlcommon::row_title($title) .''.&Apache::lonhtmlcommon::row_closure(); return $selout; @@ -400,6 +403,59 @@ sub select_level_form { if (!defined($value)) { $env{'form.'.$name}=0; } return &Apache::loncommon::select_level_form($value,$name); } + +sub common_access { + my ($name,$text,$options)=@_; + return unless (ref($options) eq 'ARRAY'); + my $formname = 'pubdirpref'; + my $chkname = 'common'.$name; + my $chkid = 'LC_'.$chkname; + my $divid = $chkid.'div'; + my $customdivid = 'LC_customfile'; + my $selname = $chkname.'select'; + my $selid = $chkid.'select'; + my $selonchange; + if ($name eq 'dist') { + $selonchange = ' onchange="showHideCustom(this,'."'$customdivid'".');"'; + } + my %lt = &Apache::lonlocal::texthash( + 'default' => 'System wide - can be used for any courses system wide', + 'domain' => 'Domain only - use limited to courses in the domai', + 'custom' => 'Customized right of use ...', + 'public' => 'Public - no authentication or authorization required for use', + 'closed' => 'Closed - XML source is closed to everyone', + 'open' => 'Open - XML source is open to people who want to use it', + 'sel' => 'Select', + ); + my $output = <<"END"; +
+ + + +'; +} + ######################################### ######################################### @@ -469,7 +525,7 @@ Currently undocumented ######################################### ######################################### sub set_allow { - my ($allow,$logfile,$target,$tag,$oldurl)=@_; + my ($allow,$logfile,$target,$tag,$oldurl,$type)=@_; my $newurl=&urlfixup($oldurl,$target); my $return_url=$oldurl; print $logfile 'GUYURL: '.$tag.':'.$oldurl.' - '.$newurl."\n"; @@ -481,6 +537,11 @@ sub set_allow { ($newurl !~ /^mailto:/i) && ($newurl !~ /^(?:http|https|ftp):/i) && ($newurl !~ /^\#/)) { + if (($type eq 'src') || ($type eq 'href')) { + if ($newurl =~ /^([^?]+)\?[^?]*$/) { + $newurl = $1; + } + } $$allow{&absoluteurl($newurl,$target)}=1; } return $return_url; @@ -722,9 +783,11 @@ sub fix_ids_and_indices { foreach my $type ('src','href','background','bgimg') { foreach my $key (keys(%parms)) { if ($key =~ /^$type$/i) { + next if (($lctag eq 'img') && ($type eq 'src') && + ($parms{$key} =~ m{^data\:image/gif;base64,})); $parms{$key}=&set_allow(\%allow,$logfile, $target,$tag, - $parms{$key}); + $parms{$key},$type); } } } @@ -781,20 +844,105 @@ sub fix_ids_and_indices { } my $newparmstring=''; my $endtag=''; - foreach (keys %parms) { - if ($_ eq '/') { + foreach my $parkey (keys(%parms)) { + if ($parkey eq '/') { $endtag=' /'; } else { - my $quote=($parms{$_}=~/\"/?"'":'"'); - $newparmstring.=' '.$_.'='.$quote.$parms{$_}.$quote; + my $quote=($parms{$parkey}=~/\"/?"'":'"'); + $newparmstring.=' '.$parkey.'='.$quote.$parms{$parkey}.$quote; } } 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; + +# +# Camtasia 8.4: skins/express_show/spritesheet.min.css 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 $spritecss = $1.'express_show/spritesheet.min.css'; + $allow{&absoluteurl($spritecss,$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; + } + } + } + } + } + } + } + if ($script =~ m{\.addMediaSrc\((["'])((?!\1).+)\1\);}) { + my $src = $2; + if ($src) { + my $url = &urlfixup($src); + unless ($url=~m{^(?:http|https|ftp)://}) { + $allow{&absoluteurl($url,$target)}=1; + } + } + } + if ($script =~ /\(document,\s*(['"])script\1,\s*\[([^\]]+)\]\);/s) { + my $scriptslist = $2; + my @srcs = split(/\s*,\s*/,$scriptslist); + foreach my $src (@srcs) { + if ($src =~ /(["'])(?:(?!\1).)+\.js\1/) { + my $quote = $1; + my ($url) = ($src =~ m/\Q$quote\E([^$quote]+)\Q$quote\E/); + $url = &urlfixup($url); + unless ($url=~m{^(?:http|https|ftp)://}) { + $allow{&absoluteurl($url,$target)}=1; + } + } + } + } + if ($script =~ m{loadScript\(\s*(['"])((?:(?!\1).)+\.js)\1,\s*function}is) { + my $src = $2; + if ($src) { + my $url = &urlfixup($src); + unless ($url=~m{^(?:http|https|ftp)://}) { + $allow{&absoluteurl($url,$target)}=1; + } + } + } + $outstring .= $script; + } + } } elsif ($token->[0] eq 'E') { if ($token->[2]) { unless ($token->[1] eq 'allow') { @@ -1017,6 +1165,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); @@ -1101,9 +1254,9 @@ sub publish { # ------------------- Clear out parameters and stores (there should not be any) - foreach (keys %metadatafields) { - if (($_=~/^parameter/) || ($_=~/^stores/)) { - delete $metadatafields{$_}; + foreach my $field (keys(%metadatafields)) { + if (($field=~/^parameter/) || ($field=~/^stores/)) { + delete $metadatafields{$field}; } } @@ -1112,23 +1265,21 @@ sub publish { $scrout.=&metaread($logfile,$source.'.meta'); - foreach (keys %metadatafields) { - if (($_=~/^parameter/) || ($_=~/^stores/)) { - $oldparmstores{$_}=1; - delete $metadatafields{$_}; + foreach my $field (keys(%metadatafields)) { + if (($field=~/^parameter/) || ($field=~/^stores/)) { + $oldparmstores{$field}=1; + delete $metadatafields{$field}; } } # ------------------------------------------------------------- Save some stuff my %savemeta=(); - foreach ('title') { - if ($metadatafields{$_}) { $savemeta{$_}=$metadatafields{$_}; } - } + if ($metadatafields{'title'}) { $savemeta{'title'}=$metadatafields{'title'}; } # ------------------------------------------ See if anything new in file itself $allmeta=&parseformeta($source,$style); # ----------------------------------------------------------- Restore the stuff - foreach (keys %savemeta) { - $metadatafields{$_}=$savemeta{$_}; + foreach my $item (keys(%savemeta)) { + $metadatafields{$item}=$savemeta{$item}; } } @@ -1136,11 +1287,11 @@ sub publish { # ---------------- Find and document discrepancies in the parameters and stores my $chparms=''; - foreach (sort keys %metadatafields) { - if (($_=~/^parameter/) || ($_=~/^stores/)) { - unless ($_=~/\.\w+$/) { - unless ($oldparmstores{$_}) { - my $disp_key = $_; + foreach my $field (sort(keys(%metadatafields))) { + if (($field=~/^parameter/) || ($field=~/^stores/)) { + unless ($field=~/\.\w+$/) { + unless ($oldparmstores{$field}) { + my $disp_key = $field; $disp_key =~ tr/\0/_/; print $logfile ('New: '.$disp_key."\n"); $chparms .= $disp_key.' '; @@ -1154,11 +1305,11 @@ sub publish { } $chparms=''; - foreach (sort keys %oldparmstores) { - if (($_=~/^parameter/) || ($_=~/^stores/)) { - unless (($metadatafields{$_.'.name'}) || - ($metadatafields{$_.'.package'}) || ($_=~/\.\w+$/)) { - my $disp_key = $_; + foreach my $olditem (sort(keys(%oldparmstores))) { + if (($olditem=~/^parameter/) || ($olditem=~/^stores/)) { + unless (($metadatafields{$olditem.'.name'}) || + ($metadatafields{$olditem.'.package'}) || ($olditem=~/\.\w+$/)) { + my $disp_key = $olditem; $disp_key =~ tr/\0/_/; print $logfile ('Obsolete: '.$disp_key."\n"); $chparms.=$disp_key.' '; @@ -1235,7 +1386,7 @@ sub publish { &hiddenfield('phase','two'). &hiddenfield('filename',$env{'form.filename'}). &hiddenfield('allmeta',&escape($allmeta)). - &hiddenfield('dependencies',join(',',keys %allow)); + &hiddenfield('dependencies',join(',',keys(%allow))); unless ($env{'form.makeobsolete'}) { $intr_scrout.= &textfield('Title','title',$metadatafields{'title'}). @@ -1480,6 +1631,8 @@ Returns: 0: fail 1: success +=back + =cut #'stupid emacs @@ -1533,7 +1686,33 @@ sub phasetwo { %metadatakeys=(); &metaeval(&unescape($env{'form.allmeta'})); - + + if ($batch) { + my %commonaccess; + map { $commonaccess{$_} = 1; } &Apache::loncommon::get_env_multiple('form.commonaccess'); + if ($commonaccess{'dist'}) { + unless ($style eq 'prv') { + if ($env{'form.commondistselect'} eq 'custom') { + unless ($source =~ /\.rights$/) { + if ($env{'form.commoncustomrights'} =~ m{^/res/.+\.rights$}) { + $env{'form.customdistributionfile'} = $env{'form.commoncustomrights'}; + $env{'form.copyright'} = $env{'form.commondistselect'}; + } + } + } elsif ($env{'form.commondistselect'} =~ /^default|domain|public$/) { + $env{'form.copyright'} = $env{'form.commondistselect'}; + } + } + } + unless ($style eq 'prv') { + if ($commonaccess{'source'}) { + if (($env{'form.commonsourceselect'} eq 'open') || ($env{'form.commonsourceselect'} eq 'closed')) { + $env{'form.sourceavail'} = $env{'form.commonsourceselect'}; + } + } + } + } + $metadatafields{'title'}=$env{'form.title'}; $metadatafields{'author'}=$env{'form.author'}; $metadatafields{'subject'}=$env{'form.subject'}; @@ -1594,17 +1773,17 @@ sub phasetwo { ''); return 0; } - foreach (sort keys %metadatafields) { - unless ($_=~/\./) { - my $unikey=$_; + foreach my $field (sort(keys(%metadatafields))) { + unless ($field=~/\./) { + my $unikey=$field; $unikey=~/^([A-Za-z]+)/; my $tag=$1; $tag=~tr/A-Z/a-z/; print $mfh "\n\<$tag"; - foreach (split(/\,/,$metadatakeys{$unikey})) { - my $value=$metadatafields{$unikey.'.'.$_}; + foreach my $item (split(/\,/,$metadatakeys{$unikey})) { + my $value=$metadatafields{$unikey.'.'.$item}; $value=~s/\"/\'\'/g; - print $mfh ' '.$_.'="'.$value.'"'; + print $mfh ' '.$item.'="'.$value.'"'; } print $mfh '>'. &HTML::Entities::encode($metadatafields{$unikey},'<>&"') @@ -1770,21 +1949,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; @@ -1814,9 +1989,9 @@ sub notify { # --------------------------------------------------- Notify subscribed courses my %courses=&coursedependencies($target); my $now=time; - foreach (keys %courses) { - print $logfile "\nNotifying course ".$_.':'; - my ($cdom,$cname)=split(/\_/,$_); + foreach my $course (keys(%courses)) { + print $logfile "\nNotifying course ".$course.':'; + my ($cdom,$cname)=split(/\_/,$course); my $reply=&Apache::lonnet::cput ('versionupdate',{$target => $now},$cdom,$cname); print $logfile $reply; @@ -1880,8 +2055,9 @@ sub publishdirectory { $thisdisfn=~s/\/+/\//g; my $thisdisresdir=$thisdisfn; $thisdisresdir=~s/^\/priv\//\/res\//; - my $resdir='/home/httpd/html'.$thisdisresdir; - $r->print(&Apache::lonhtmlcommon::start_pick_box() + 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() @@ -1895,16 +2071,20 @@ sub publishdirectory { $r->print(&Apache::lonhtmlcommon::row_closure() .&Apache::lonhtmlcommon::row_title(&mt('Options')) ); - $r->print(''. - &hiddenfield('phase','two'). + $r->print(&hiddenfield('phase','two'). &hiddenfield('filename',$env{'form.filename'}). &checkbox('pubrec','include subdirectories'). &checkbox('forcerepub','force republication of previously published files'). &checkbox('obsolete','make file(s) obsolete'). &checkbox('forceoverride','force directory level metadata over existing'). - '
'); + &common_access('dist',&mt('apply common copyright/distribution'), + ['default','domain','custom']). + &common_access('source',&mt('apply common source availability'), + ['closed','open']) + ); $r->print(&Apache::lonhtmlcommon::row_closure(1) .&Apache::lonhtmlcommon::end_pick_box() + .'
' ); $lock=0; } else { @@ -1925,7 +2105,7 @@ sub publishdirectory { if ($filename=~/\.(\w+)$/) { $extension=$1; } if ($cmode&$dirptr) { if (($filename!~/^\./) && ($env{'form.pubrec'})) { - &publishdirectory($r,$docroot.$fn.'/'.$filename,$thisdisfn.'/'.$filename); + &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename); } } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') && ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) { @@ -2014,7 +2194,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 +2258,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 +2323,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', @@ -2154,7 +2334,53 @@ sub handler { my $js=''; - $r->print(&Apache::loncommon::start_page('Resource Publication',$js) + my $startargs = {}; + if ($fn=~/\/$/) { + unless ($env{'form.phase'} eq 'two') { + $startargs->{'add_entries'} = { onload => 'javascript:setDefaultAccess();' }; + $js .= <<"END"; + + +END + } + } + $r->print(&Apache::loncommon::start_page('Resource Publication',$js,$startargs) .&Apache::lonhtmlcommon::breadcrumbs() .&Apache::loncommon::head_subbox( &Apache::loncommon::CSTR_pageheader($docroot.$fn)) @@ -2168,7 +2394,10 @@ sub handler { if ($fn=~/\/$/) { # -------------------------------------------------------- This is a directory &publishdirectory($r,$docroot.$fn,$thisdisfn); - $r->print('
'.&mt('Return to Directory').''); + $r->print( + '

'. + &Apache::lonhtmlcommon::actionbox([ + ''.&mt('Return to Directory').''])); } else { # ---------------------- Evaluate individual file, and then output information. $fn=~/\.(\w+)$/; @@ -2218,7 +2447,7 @@ ENDCAPTION $r->print(&Apache::lonhtmlcommon::row_closure() .&Apache::lonhtmlcommon::row_title(&mt('Diffs'))); $r->print(< + ENDDIFF $r->print(&mt('Diffs with Current Version').''); } @@ -2260,7 +2489,5 @@ __END__ =back -=back - =cut