--- loncom/publisher/lonpublisher.pm 2014/12/12 18:27:34 1.294 +++ loncom/publisher/lonpublisher.pm 2016/06/19 04:27:57 1.297 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Publication Handler # -# $Id: lonpublisher.pm,v 1.294 2014/12/12 18:27:34 raeburn Exp $ +# $Id: lonpublisher.pm,v 1.297 2016/06/19 04:27:57 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; @@ -318,8 +314,12 @@ string which presents the form field (fo =item B +=item B + =item B +=item B + =item B =back @@ -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"; +
+ + + +'; +} + ######################################### ######################################### @@ -1050,7 +1103,7 @@ I ######################################### sub publish { - my ($source,$target,$style,$batch)=@_; + my ($source,$target,$style,$batch,$nokeyref)=@_; my $logfile; my $scrout=''; my $allmeta=''; @@ -1290,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; } } @@ -1541,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; +} + ######################################### ######################################### @@ -1563,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 @@ -1583,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; + } } } @@ -1612,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 @@ -1629,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'}; @@ -1675,20 +1813,36 @@ 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; + $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=~/\./) { @@ -1707,7 +1861,12 @@ sub phasetwo { .''; } } - $r->print('

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

'); + + $output .= '

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

'; + unless ($usebuffer) { + $r->print($output); + $output = ''; + } print $logfile "\nWrote metadata"; } @@ -1716,17 +1875,35 @@ sub phasetwo { $metadatafields{'url'} = $distarget; $metadatafields{'version'} = 'current'; - my ($error,$success) = &store_metadata(%metadatafields); - if ($success) { - $r->print('

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

'); - print $logfile "\nSynchronized SQL metadata database"; - } else { - $r->print($error); - print $logfile "\n".$error; + my $crsauthor; + if ($env{'request.course.id'}) { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + if ($distarget =~ m{^/res/$cdom/$cnum}) { + $crsauthor = 1; + } + } + unless ($crsauthor) { + my ($error,$success) = &store_metadata(%metadatafields); + if ($success) { + $output .= '

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

'; + print $logfile "\nSynchronized SQL metadata database"; + } else { + $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 @@ -1740,9 +1917,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)) { @@ -1757,18 +1943,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 @@ -1777,19 +1980,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"; } @@ -1805,22 +2023,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 @@ -1831,14 +2065,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]); @@ -1857,7 +2106,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) { @@ -1866,7 +2119,7 @@ sub phasetwo { my $thissrcdir=$thissrc; $thissrcdir=~s/\/[^\/]+$/\//; - $r->print( + $output .= &Apache::lonhtmlcommon::actionbox([ ''. &mt('View Published Version'). @@ -1876,10 +2129,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 @@ -1923,12 +2192,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; @@ -1943,31 +2211,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; @@ -1993,7 +2276,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() @@ -2018,7 +2305,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!~/\~$/)) { @@ -2044,7 +2331,7 @@ sub publishdirectory { } if ($publishthis) { - &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename); + &batchpublish($r,$fn.'/'.$filename,$resdir.'/'.$filename,$nokeyref); } else { $r->print('
'.&mt('Skipping').' '.$filename.'
'); } @@ -2206,29 +2493,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; @@ -2247,7 +2512,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)) @@ -2257,10 +2568,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([ @@ -2333,7 +2645,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('

'. @@ -2341,7 +2653,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()); @@ -2349,6 +2663,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__