--- loncom/publisher/lonpublisher.pm 2011/11/14 00:20:31 1.277 +++ loncom/publisher/lonpublisher.pm 2016/06/19 01:08:01 1.296 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.277 2011/11/14 00:20:31 raeburn Exp $ +# $Id: lonpublisher.pm,v 1.296 2016/06/19 01:08:01 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(); @@ -131,13 +128,9 @@ use Apache::lonlocal; use Apache::loncfile; use LONCAPA::lonmetadata; use Apache::lonmsg; -use vars qw(%metadatafields %metadatakeys); +use vars qw(%metadatafields %metadatakeys %addid $readit); use LONCAPA qw(:DEFAULT :match); - -my %addid; -my %nokey; - my $docroot; my $cuname; @@ -150,6 +143,8 @@ my $lock; =pod +=over 4 + =item B Evaluates a string that contains metadata. This subroutine @@ -201,12 +196,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 +289,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 +314,12 @@ string which presents the form field (fo =item B +=item B + =item B +=item B + =item B =back @@ -383,12 +382,12 @@ sub selectbox { } my $selout="\n".&Apache::lonhtmlcommon::row_title($title) .''.&Apache::lonhtmlcommon::row_closure(); return $selout; @@ -400,6 +399,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 +521,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 +533,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 +779,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 +840,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') { @@ -959,7 +1103,7 @@ I ######################################### sub publish { - my ($source,$target,$style,$batch)=@_; + my ($source,$target,$style,$batch,$nokeyref)=@_; my $logfile; my $scrout=''; my $allmeta=''; @@ -1017,6 +1161,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 +1250,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 +1261,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 +1283,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 +1301,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.' '; @@ -1196,7 +1343,7 @@ sub publish { $textonly=~s/[^a-z^ü^ä^ö^ß\s]//g; #dont delete german "Umlaute" foreach ($textonly=~m/[^\s]+/g) { #match all but whitespaces - unless ($nokey{$_}) { + unless ($nokeyref->{$_}) { $keywords{$_}=1; } } @@ -1235,7 +1382,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'}). @@ -1447,6 +1594,18 @@ END return($scrout,0); } +sub getnokey { + my ($includedir) = @_; + my $nokey={}; + my $fh=Apache::File->new($includedir.'/un_keyword.tab'); + while (<$fh>) { + my $word=$_; + chomp($word); + $nokey->{$word}=1; + } + return $nokey; +} + ######################################### ######################################### @@ -1469,17 +1628,27 @@ Parameters: =item I<$distarget> +=item I<$batch> + +=item I<$usebuffer> + =back Returns: =over 4 -=item integer +=item integer or array + +if $userbuffer arg is true, and if caller wants an array +then the array ($output,$rtncode) will be returned, otherwise +just the $rtncode will be returned. $rtncode is an integer: 0: fail 1: success +=back + =cut #'stupid emacs @@ -1487,26 +1656,54 @@ Returns: ######################################### sub phasetwo { - my ($r,$source,$target,$style,$distarget,$batch)=@_; + my ($r,$source,$target,$style,$distarget,$batch,$usebuffer)=@_; $source=~s/\/+/\//g; $target=~s/\/+/\//g; # # Unless trying to get rid of something, check name validity # + my $output; unless ($env{'form.obsolete'}) { if ($target=~/(\_\_\_|\&\&\&|\:\:\:)/) { - $r->print(''. + $output = ''. &mt('Unsupported character combination [_1] in filename, FAIL.',"'.$1.'"). - ''); - return 0; + ''; + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } } unless ($target=~/\.(\w+)$/) { - $r->print(''.&mt('No valid extension found in filename, FAIL').''); - return 0; + $output = ''.&mt('No valid extension found in filename, FAIL').''; + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } } if ($target=~/\.(\d+)\.(\w+)$/) { - $r->print(''.&mt('Filename of resource contains internal version number. Cannot publish such resources, FAIL').''); - return 0; + $output = ''.&mt('Filename of resource contains internal version number. Cannot publish such resources, FAIL').''; + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } } } @@ -1516,14 +1713,25 @@ sub phasetwo { $distarget=~s/\/+/\//g; my $logfile; unless ($logfile=Apache::File->new('>>'.$source.'.log')) { - $r->print( - ''. - &mt('No write permission to user directory, FAIL').''); - return 0; + $output = ''. + &mt('No write permission to user directory, FAIL').''; + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + return 0; + } } if ($source =~ /\.rights$/) { - $r->print('

'.&mt('Warning: It can take up to 1 hour for rights changes to fully propagate.').'

'); + $output = '

'.&mt('Warning: It can take up to 1 hour for rights changes to fully propagate.').'

'; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } } print $logfile @@ -1533,7 +1741,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'}; @@ -1579,39 +1813,60 @@ sub phasetwo { if ($metadatafields{'copyright'} eq 'custom') { my $file=$metadatafields{'customdistributionfile'}; unless ($file=~/\.rights$/) { - $r->print( - ''.&mt('No valid custom distribution rights file specified, FAIL'). - ''); - return 0; + $output .= ''.&mt('No valid custom distribution rights file specified, FAIL'). + ''; + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } } } { print $logfile "\nWrite metadata file for ".$source; my $mfh; unless ($mfh=Apache::File->new('>'.$source.'.meta')) { - $r->print( - ''.&mt('Could not write metadata, FAIL'). - ''); - return 0; - } - foreach (sort keys %metadatafields) { - unless ($_=~/\./) { - my $unikey=$_; + $output .= ''.&mt('Could not write metadata, FAIL'). + ''; + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } + } + 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},'<>&"') .''; } } - $r->print('

'.&mt('Wrote Metadata').'

'); + + $output .= '

'.&mt('Wrote Metadata').'

'; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } print $logfile "\nWrote metadata"; } @@ -1622,15 +1877,23 @@ sub phasetwo { my ($error,$success) = &store_metadata(%metadatafields); if ($success) { - $r->print('

'.&mt('Synchronized SQL metadata database').'

'); + $output .= '

'.&mt('Synchronized SQL metadata database').'

'; print $logfile "\nSynchronized SQL metadata database"; } else { - $r->print($error); + $output .= $error; print $logfile "\n".$error; } + unless ($usebuffer) { + $r->print($output); + $output = ''; + } # --------------------------------------------- Delete author resource messages my $delresult=&Apache::lonmsg::del_url_author_res_msg($target); - $r->print('

'.&mt('Removing error messages:').' '.$delresult.'

'); + $output .= '

'.&mt('Removing error messages:').' '.$delresult.'

'; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } print $logfile "\nRemoving error messages: $delresult"; # ----------------------------------------------------------- Copy old versions @@ -1644,9 +1907,18 @@ sub phasetwo { my $docroot = $Apache::lonnet::perlvar{'lonDocRoot'}; unless ($srcd=~/^\Q$docroot\E\/res/) { print $logfile "\nPANIC: Target dir is ".$srcd; - $r->print( - "".&mt('Invalid target directory, FAIL').""); - return 0; + $output .= + "".&mt('Invalid target directory, FAIL').""; + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } } opendir(DIR,$srcd); while ($filename=readdir(DIR)) { @@ -1661,18 +1933,35 @@ sub phasetwo { } closedir(DIR); $maxversion++; - $r->print('

'.&mt('Creating old version [_1]',$maxversion).'

'); + $output .= '

'.&mt('Creating old version [_1]',$maxversion).'

'; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } print $logfile "\nCreating old version ".$maxversion."\n"; my $copyfile=$srcd.'/'.$srcf.'.'.$maxversion.'.'.$srct; if (copy($target,$copyfile)) { print $logfile "Copied old target to ".$copyfile."\n"; - $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old target file'))); + $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied old target file')); + unless ($usebuffer) { + $r->print($output); + $output = ''; + } } else { print $logfile "Unable to write ".$copyfile.':'.$!."\n"; - $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1)); - return 0; + $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Failed to copy old target').", $!",1); + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } } # --------------------------------------------------------------- Copy Metadata @@ -1681,19 +1970,34 @@ sub phasetwo { if (copy($target.'.meta',$copyfile)) { print $logfile "Copied old target metadata to ".$copyfile."\n"; - $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata'))); + $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied old metadata')); + unless ($usebuffer) { + $r->print($output); + $output = ''; + } } else { print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; if (-e $target.'.meta') { - $r->print(&Apache::lonhtmlcommon::confirm_success( - &mt('Failed to write old metadata copy').", $!",1)); - return 0; + $output .= &Apache::lonhtmlcommon::confirm_success( + &mt('Failed to write old metadata copy').", $!",1); + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } } } - - } else { - $r->print('

'.&mt('Initial version').'

'); + $output .= '

'.&mt('Initial version').'

'; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } print $logfile "\nInitial version"; } @@ -1709,22 +2013,38 @@ sub phasetwo { if ((-e $path)!=1) { print $logfile "\nCreating directory ".$path; mkdir($path,0777); - $r->print('

' - .&mt('Created directory [_1]' - ,''.$parts[$count].'') - .'

' - ); + $output .= '

' + .&mt('Created directory [_1]' + ,''.$parts[$count].'') + .'

'; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } } } if (copy($source,$copyfile)) { print $logfile "\nCopied original source to ".$copyfile."\n"; - $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied source file'))); + $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied source file')); + unless ($usebuffer) { + $r->print($output); + $output = ''; + } } else { print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; - $r->print(&Apache::lonhtmlcommon::confirm_success( - &mt('Failed to copy source').", $!",1)); - return 0; + $output .= &Apache::lonhtmlcommon::confirm_success( + &mt('Failed to copy source').", $!",1); + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } } # ---------------------------------------------- Delete local tmp-preview files @@ -1735,14 +2055,29 @@ sub phasetwo { if (copy($source.'.meta',$copyfile)) { print $logfile "\nCopied original metadata to ".$copyfile."\n"; - $r->print(&Apache::lonhtmlcommon::confirm_success(&mt('Copied metadata'))); + $output .= &Apache::lonhtmlcommon::confirm_success(&mt('Copied metadata')); + unless ($usebuffer) { + $r->print($output); + $output = ''; + } } else { print $logfile "\nUnable to write metadata ".$copyfile.':'.$!."\n"; - $r->print(&Apache::lonhtmlcommon::confirm_success( - &mt('Failed to write metadata copy').", $!",1)); - return 0; + $output .= &Apache::lonhtmlcommon::confirm_success( + &mt('Failed to write metadata copy').", $!",1); + if ($usebuffer) { + if (wantarray) { + return ($output,0); + } else { + return 0; + } + } else { + $r->print($output); + return 0; + } + } + unless ($usebuffer) { + $r->rflush; } - $r->rflush; # ------------------------------------------------------------- Trigger updates push(@{$modified_urls},[$target,$source]); @@ -1761,7 +2096,11 @@ sub phasetwo { # ------------------------------------------------------------- Everything done $logfile->close(); - $r->print('

'.&mt('Done').'

'); + $output .= '

'.&mt('Done').'

'; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } # ------------------------------------------------ Provide link to new resource unless ($batch) { @@ -1770,24 +2109,36 @@ sub phasetwo { my $thissrcdir=$thissrc; $thissrcdir=~s/\/[^\/]+$/\//; - $r->print(&Apache::loncommon::head_subbox( - &Apache::lonhtmlcommon::start_funclist(). - &Apache::lonhtmlcommon::add_item_funclist( + $output .= + &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()) - ); + '']); + unless ($usebuffer) { + $r->print($output); + $output = ''; + } + } + + if ($usebuffer) { + if (wantarray) { + return ($output,1); + } else { + return 1; + } + } else { + if (wantarray) { + return ('',1); + } else { + return 1; + } } - return 1; } # =============================================================== Notifications @@ -1814,9 +2165,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; @@ -1831,12 +2182,11 @@ sub notify { ######################################### sub batchpublish { - my ($r,$srcfile,$targetfile)=@_; + my ($r,$srcfile,$targetfile,$nokeyref,$usebuffer)=@_; #publication pollutes %env with form.* values my %oldenv=%env; $srcfile=~s/\/+/\//g; $targetfile=~s/\/+/\//g; - $srcfile=~s/\/+/\//g; my $docroot=$r->dir_config('lonDocRoot'); my $thisdistarget=$targetfile; @@ -1851,37 +2201,53 @@ sub batchpublish { my $thisembstyle=&Apache::loncommon::fileembstyle($thistype); - $r->print('

' + my $output = '

' .&mt('Publishing [_1]',&Apache::loncfile::display($srcfile)) - .'

' - ); + .''; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } # phase one takes # my ($source,$target,$style,$batch)=@_; - my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1); - $r->print('

'.$outstring.'

'); + my ($outstring,$error)=&publish($srcfile,$targetfile,$thisembstyle,1,$nokeyref); + + if ($usebuffer) { + $output .= '

'.$outstring.'

'; + } else { + $r->print('

'.$outstring.'

'); + } # phase two takes # my ($source,$target,$style,$distarget,batch)=@_; # $env{'form.allmeta'},$env{'form.title'},$env{'form.author'},... if (!$error) { - $r->print('

'); - &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1); - $r->print('

'); + if ($usebuffer) { + my ($result,$error) = &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1,$usebuffer); + $output .= '

'.$result.'

'; + } else { + &phasetwo($r,$srcfile,$targetfile,$thisembstyle,$thisdistarget,1); + } } %env=%oldenv; - return ''; + if ($usebuffer) { + return $output; + } else { + return ''; + } } ######################################### sub publishdirectory { - my ($r,$fn,$thisdisfn)=@_; + my ($r,$fn,$thisdisfn,$nokeyref)=@_; $fn=~s/\/+/\//g; $thisdisfn=~s/\/+/\//g; my $thisdisresdir=$thisdisfn; $thisdisresdir=~s/^\/priv\//\/res\//; my $resdir = $r->dir_config('lonDocRoot').$thisdisresdir; - $r->print(&Apache::lonhtmlcommon::start_pick_box() + $r->print('
' + .&Apache::lonhtmlcommon::start_pick_box() .&Apache::lonhtmlcommon::row_title(&mt('Directory')) .''.$thisdisfn.'' .&Apache::lonhtmlcommon::row_closure() @@ -1895,16 +2261,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 +2295,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,$nokeyref); } } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') && ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) { @@ -1951,7 +2321,7 @@ sub publishdirectory { } if ($publishthis) { - &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename); + &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename,$nokeyref); } else { $r->print('
'.&mt('Skipping').' '.$filename.'
'); } @@ -2014,7 +2384,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 +2448,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'}. @@ -2113,29 +2483,7 @@ sub handler { return HTTP_NOT_FOUND; } -# -------------------------------- File is there and owned, init lookup tables. - - %addid=(); - - { - my $fh=Apache::File->new($r->dir_config('lonTabDir').'/addid.tab'); - while (<$fh>=~/(\w+)\s+(\w+)/) { - $addid{$1}=$2; - } - } - - %nokey=(); - - { - my $fh=Apache::File->new($r->dir_config('lonIncludes').'/un_keyword.tab'); - while (<$fh>) { - my $word=$_; - chomp($word); - $nokey{$word}=1; - } - } - -# ---------------------------------------------------------- Start page output. +# --------------------------------- File is there and owned, start page output &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; @@ -2143,7 +2491,7 @@ sub handler { # Breadcrumbs &Apache::lonhtmlcommon::clear_breadcrumbs(); &Apache::lonhtmlcommon::add_breadcrumb({ - 'text' => 'Construction Space', + 'text' => 'Authoring Space', 'href' => &Apache::loncommon::authorspace($fn), }); &Apache::lonhtmlcommon::add_breadcrumb({ @@ -2154,8 +2502,53 @@ sub handler { my $js=''; - print STDERR "fn is ||$fn||\n"; - $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)) @@ -2165,11 +2558,15 @@ sub handler { my $thistarget=$fn; $thistarget=~s/^\/priv\//\/res\//; my $thisdistarget=&HTML::Entities::encode($thistarget,'<>&"'); + my $nokeyref = &getnokey($r->dir_config('lonIncludes')); if ($fn=~/\/$/) { # -------------------------------------------------------- This is a directory - &publishdirectory($r,$docroot.$fn,$thisdisfn); - $r->print('
'.&mt('Return to Directory').''); + &publishdirectory($r,$docroot.$fn,$thisdisfn,$nokeyref); + $r->print( + '

'. + &Apache::lonhtmlcommon::actionbox([ + ''.&mt('Return to Directory').''])); } else { # ---------------------- Evaluate individual file, and then output information. $fn=~/\.(\w+)$/; @@ -2219,7 +2616,7 @@ ENDCAPTION $r->print(&Apache::lonhtmlcommon::row_closure() .&Apache::lonhtmlcommon::row_title(&mt('Diffs'))); $r->print(< + ENDDIFF $r->print(&mt('Diffs with Current Version').''); } @@ -2238,7 +2635,7 @@ ENDDIFF } unless ($errorcount) { my ($outstring,$error)= - &publish($docroot.$fn,$docroot.$thistarget,$thisembstyle); + &publish($docroot.$fn,$docroot.$thistarget,$thisembstyle,undef,$nokeyref); $r->print($outstring); } else { $r->print('

'. @@ -2246,7 +2643,9 @@ ENDDIFF '

'); } } else { - &phasetwo($r,$docroot.$fn,$docroot.$thistarget,$thisembstyle,$thisdistarget); + my ($output,$error) = &phasetwo($r,$docroot.$fn,$docroot.$thistarget, + $thisembstyle,$thisdistarget); + $r->print($output); } } $r->print(&Apache::loncommon::end_page()); @@ -2254,6 +2653,24 @@ ENDDIFF return OK; } +BEGIN { + +# ----------------------------------- Read addid.tab + unless ($readit) { + %addid=(); + + { + my $tabdir = $Apache::lonnet::perlvar{'lonTabDir'}; + my $fh=Apache::File->new($tabdir.'/addid.tab'); + while (<$fh>=~/(\w+)\s+(\w+)/) { + $addid{$1}=$2; + } + } + } + $readit=1; +} + + 1; __END__ @@ -2261,7 +2678,5 @@ __END__ =back -=back - =cut