--- loncom/publisher/lonpublisher.pm 2014/08/03 14:20:38 1.293 +++ 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.293 2014/08/03 14:20:38 raeburn Exp $ +# $Id: lonpublisher.pm,v 1.296 2016/06/19 01:08:01 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -128,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; @@ -200,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); @@ -293,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; } } @@ -318,8 +314,12 @@ string which presents the form field (fo =item B +=item B + =item B +=item B + =item B =back @@ -382,12 +382,12 @@ sub selectbox { } my $selout="\n".&Apache::lonhtmlcommon::row_title($title) .''.&Apache::lonhtmlcommon::row_closure(); return $selout; @@ -399,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"; +
+ + + +'; +} + ######################################### ######################################### @@ -787,12 +840,12 @@ 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=' /'; }; } @@ -1050,7 +1103,7 @@ I ######################################### sub publish { - my ($source,$target,$style,$batch)=@_; + my ($source,$target,$style,$batch,$nokeyref)=@_; my $logfile; my $scrout=''; my $allmeta=''; @@ -1197,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}; } } @@ -1208,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}; } } @@ -1232,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.' '; @@ -1250,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.' '; @@ -1292,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; } } @@ -1331,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'}). @@ -1543,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; +} + ######################################### ######################################### @@ -1565,13 +1628,21 @@ 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 @@ -1585,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; + } } } @@ -1614,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 @@ -1631,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'}; @@ -1677,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"; } @@ -1720,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 @@ -1742,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)) { @@ -1759,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 @@ -1779,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"; } @@ -1807,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 @@ -1833,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]); @@ -1859,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) { @@ -1868,7 +2109,7 @@ sub phasetwo { my $thissrcdir=$thissrc; $thissrcdir=~s/\/[^\/]+$/\//; - $r->print( + $output .= &Apache::lonhtmlcommon::actionbox([ ''. &mt('View Published Version'). @@ -1878,10 +2119,26 @@ sub phasetwo { '', ''. &mt('Back to Source Directory'). - '']) - ); + '']); + 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 @@ -1908,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; @@ -1925,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; @@ -1945,31 +2201,46 @@ 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; @@ -1995,7 +2266,11 @@ sub publishdirectory { &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') + &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() @@ -2020,7 +2295,7 @@ sub publishdirectory { if ($filename=~/\.(\w+)$/) { $extension=$1; } if ($cmode&$dirptr) { if (($filename!~/^\./) && ($env{'form.pubrec'})) { - &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename); + &publishdirectory($r,$fn.'/'.$filename,$thisdisfn.'/'.$filename,$nokeyref); } } elsif ((&Apache::loncommon::fileembstyle($extension) ne 'hdn') && ($filename!~/^[\#\.]/) && ($filename!~/\~$/)) { @@ -2046,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.'
'); } @@ -2208,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; @@ -2249,7 +2502,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)) @@ -2259,10 +2558,11 @@ 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); + &publishdirectory($r,$docroot.$fn,$thisdisfn,$nokeyref); $r->print( '

'. &Apache::lonhtmlcommon::actionbox([ @@ -2335,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('

'. @@ -2343,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()); @@ -2351,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__