From srdjan at catalyst.net.nz Fri Apr 1 01:45:13 2016 From: srdjan at catalyst.net.nz (Srdjan) Date: Fri, 1 Apr 2016 12:45:13 +1300 Subject: [Koha-patches] [PATCH] bug_11213: Changed XSLTParse4Display() interface Message-ID: <1459467913-15848-1-git-send-email-srdjan@catalyst.net.nz> The list of biblio items is passed on now, instead of GetItemsInfo() being called. This is because the callers already have the list ready, so the GetItemsInfo() call is being duplicated unnecessarily. Search::searchResults() builds items list from XML, and that one is passed instead. * XSLT::XSLTParse4Display() - supply the items list as input param - removed hidden items list param - hidden should not be in the items list - changed buildKohaItemsNamespace() accordingly * Items - removed GetItemsLocationInfo() - added sort_by input param to GetItemsInfo() - VirtualShelves::Page::shelfpage() - replaced GetItemsLocationInfo() call with GetItemsInfo() call, passing order_by "cn_sort" * catalogue/detail.pl, opac/opac-detail.pl, shelfpage() - added items list to the XSLTParse4Display() call * Search::searchResults() - include all available info when building items lists - added combined items list (available, on loan, other) to the XSLTParse4Display() call To test: This change is a noop, so following screens need to be checked against any changes: * Intranet: - catalogue/search.pl (results) - catalogue/detail.pl - virtualshelves/shelves.pl * Opac - opac-search.pl (results, hidelostitems syspref on and off) - opac-detail.pl - opac-shelves.pl The display should stay the same before and after patch. The speed should increase though. --- C4/Items.pm | 91 +++++++++++++---------------------------------------- C4/Search.pm | 19 +++-------- C4/XSLT.pm | 23 ++++++++------ catalogue/detail.pl | 12 +++---- opac/opac-detail.pl | 10 +++--- 5 files changed, 51 insertions(+), 104 deletions(-) diff --git a/C4/Items.pm b/C4/Items.pm index a0dfb29..fb32cf0 100644 --- a/C4/Items.pm +++ b/C4/Items.pm @@ -69,7 +69,6 @@ BEGIN { GetItemInfosOf GetItemsByBiblioitemnumber GetItemsInfo - GetItemsLocationInfo GetHostItemsInfo GetItemnumbersForBiblio get_itemnumbers_of @@ -1258,10 +1257,14 @@ sub GetItemsByBiblioitemnumber { =head2 GetItemsInfo - @results = GetItemsInfo($biblionumber); + @results = GetItemsInfo($biblionumber, $order_by); Returns information about items with the given biblionumber. +The list is ordered by home branch name and some complex criteria +within it (see the code), unless $order_by is specified. +Currently only "cn_sort" is supported. + C returns a list of references-to-hash. Each element contains a number of keys. Most of them are attributes from the C, C, C, and C tables in the @@ -1299,7 +1302,8 @@ If this is set, it is set to C. =cut sub GetItemsInfo { - my ( $biblionumber ) = @_; + my ( $biblionumber, $order_by ) = @_; + my $dbh = C4::Context->dbh; # note biblioitems.* must be avoided to prevent large marc and marcxml fields from killing performance. require C4::Languages; @@ -1354,7 +1358,18 @@ sub GetItemsInfo { AND localization.lang = ? |; - $query .= " WHERE items.biblionumber = ? ORDER BY home.branchname, items.enumchron, LPAD( items.copynumber, 8, '0' ), items.dateaccessioned DESC" ; + $query .= " WHERE items.biblionumber = ? ORDER BY "; + my $order_by_cause = "home.branchname, items.enumchron, LPAD( items.copynumber, 8, '0' ), items.dateaccessioned DESC" ; + if ($order_by) { + if ($order_by eq 'cn_sort') { + $order_by_cause = "cn_sort ASC"; + } + else { + warn qq{Unsupported order by "$order_by"}; + } + } + $query .= $order_by_cause; + my $sth = $dbh->prepare($query); $sth->execute($language, $biblionumber); my $i = 0; @@ -1387,6 +1402,9 @@ sub GetItemsInfo { $data->{stack} = C4::Koha::GetKohaAuthorisedValueLib( $code, $data->{stack} ); } + $data->{location_intranet} = GetKohaAuthorisedValueLib('LOC', $data->{location}); + $data->{location_opac} = GetKohaAuthorisedValueLib('LOC', $data->{location}, 1); + # Find the last 3 people who borrowed this item. my $sth2 = $dbh->prepare("SELECT * FROM old_issues,borrowers WHERE itemnumber = ? @@ -1411,71 +1429,6 @@ sub GetItemsInfo { : @results; } -=head2 GetItemsLocationInfo - - my @itemlocinfo = GetItemsLocationInfo($biblionumber); - -Returns the branch names, shelving location and itemcallnumber for each item attached to the biblio in question - -C returns a list of references-to-hash. Data returned: - -=over 2 - -=item C<$data-E{homebranch}> - -Branch Name of the item's homebranch - -=item C<$data-E{holdingbranch}> - -Branch Name of the item's holdingbranch - -=item C<$data-E{location}> - -Item's shelving location code - -=item C<$data-E{location_intranet}> - -The intranet description for the Shelving Location as set in authorised_values 'LOC' - -=item C<$data-E{location_opac}> - -The OPAC description for the Shelving Location as set in authorised_values 'LOC'. Falls back to intranet description if no OPAC -description is set. - -=item C<$data-E{itemcallnumber}> - -Item's itemcallnumber - -=item C<$data-E{cn_sort}> - -Item's call number normalized for sorting - -=back - -=cut - -sub GetItemsLocationInfo { - my $biblionumber = shift; - my @results; - - my $dbh = C4::Context->dbh; - my $query = "SELECT a.branchname as homebranch, b.branchname as holdingbranch, - location, itemcallnumber, cn_sort - FROM items, branches as a, branches as b - WHERE homebranch = a.branchcode AND holdingbranch = b.branchcode - AND biblionumber = ? - ORDER BY cn_sort ASC"; - my $sth = $dbh->prepare($query); - $sth->execute($biblionumber); - - while ( my $data = $sth->fetchrow_hashref ) { - $data->{location_intranet} = GetKohaAuthorisedValueLib('LOC', $data->{location}); - $data->{location_opac}= GetKohaAuthorisedValueLib('LOC', $data->{location}, 1); - push @results, $data; - } - return @results; -} - =head2 GetHostItemsInfo $hostiteminfo = GetHostItemsInfo($hostfield); diff --git a/C4/Search.pm b/C4/Search.pm index 9b7bde3..a1e6b4c 100644 --- a/C4/Search.pm +++ b/C4/Search.pm @@ -2007,7 +2007,6 @@ sub searchResults { my $items_count = scalar(@fields); my $maxitems_pref = C4::Context->preference('maxItemsinSearchResults'); my $maxitems = $maxitems_pref ? $maxitems_pref - 1 : 1; - my @hiddenitems; # hidden itemnumbers based on OpacHiddenItems syspref # loop through every item foreach my $field (@fields) { @@ -2029,7 +2028,6 @@ sub searchResults { # hidden based on OpacHiddenItems syspref my @hi = C4::Items::GetHiddenItemnumbers($item); if (scalar @hi) { - push @hiddenitems, @hi; $hideatopac_count++; next; } @@ -2046,7 +2044,7 @@ sub searchResults { $item->{'branchname'} = $branches{$item->{$otherbranch}}; } - my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber}; + my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber}; # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item my $userenv = C4::Context->userenv; if ( $item->{onloan} @@ -2054,12 +2052,10 @@ sub searchResults { { $onloan_count++; my $key = $prefix . $item->{onloan} . $item->{barcode}; + $onloan_items->{$key} = { %$item }; $onloan_items->{$key}->{due_date} = output_pref( { dt => dt_from_string( $item->{onloan} ), dateonly => 1 } ); $onloan_items->{$key}->{count}++ if $item->{$hbranch}; - $onloan_items->{$key}->{branchname} = $item->{branchname}; $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} }; - $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber}; - $onloan_items->{$key}->{description} = $item->{description}; $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); @@ -2145,25 +2141,20 @@ sub searchResults { $other_count++; my $key = $prefix . $item->{status}; - foreach (qw(withdrawn itemlost damaged branchname itemcallnumber)) { - $other_items->{$key}->{$_} = $item->{$_}; - } + $other_items->{$key} = { %$item }; $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0; $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0; $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value and $item->{notforloan}; $other_items->{$key}->{count}++ if $item->{$hbranch}; $other_items->{$key}->{location} = $shelflocations->{ $item->{location} }; - $other_items->{$key}->{description} = $item->{description}; $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); } # item is available else { $can_place_holds = 1; $available_count++; + $available_items->{$prefix} = { %$item }; $available_items->{$prefix}->{count}++ if $item->{$hbranch}; - foreach (qw(branchname itemcallnumber description)) { - $available_items->{$prefix}->{$_} = $item->{$_}; - } $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} }; $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); } @@ -2192,7 +2183,7 @@ sub searchResults { # XSLT processing of some stuff my $interface = $search_context eq 'opac' ? 'OPAC' : ''; if (!$scan && C4::Context->preference($interface . "XSLTResultsDisplay")) { - $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, $interface."XSLTResultsDisplay", 1, \@hiddenitems); + $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, $interface."XSLTResultsDisplay", [@available_items_loop, @onloan_items_loop, @other_items_loop], 1); # the last parameter tells Koha to clean up the problematic ampersand entities that Zebra outputs } diff --git a/C4/XSLT.pm b/C4/XSLT.pm index dd13c50..874deee 100644 --- a/C4/XSLT.pm +++ b/C4/XSLT.pm @@ -156,8 +156,17 @@ sub _get_best_default_xslt_filename { return $xslfilename; } +=head2 XSLTParse4Display( $biblionumber, $orig_record, $xslsyspref, $items, $fixamps ) + + $items => an array of items rerords, as returned from eg. GetItemsInfo + +Returns XSLT block + +=cut + sub XSLTParse4Display { - my ( $biblionumber, $orig_record, $xslsyspref, $fixamps, $hidden_items ) = @_; + my ( $biblionumber, $orig_record, $xslsyspref, $items, $fixamps ) = @_; + my $xslfilename = C4::Context->preference($xslsyspref); if ( $xslfilename =~ /^\s*"?default"?\s*$/i ) { my $htdocs; @@ -195,7 +204,7 @@ sub XSLTParse4Display { # grab the XML, run it through our stylesheet, push it out to the browser my $record = transformMARCXML4XSLT($biblionumber, $orig_record); - my $itemsxml = buildKohaItemsNamespace($biblionumber, $hidden_items); + my $itemsxml = $items ? buildKohaItemsNamespace($biblionumber, $items) : ""; my $xmlrecord = $record->as_xml(C4::Context->preference('marcflavour')); my $sysxml = "\n"; foreach my $syspref ( qw/ hidelostitems OPACURLOpenInNewWindow @@ -242,13 +251,7 @@ Is only used in this module currently. =cut sub buildKohaItemsNamespace { - my ($biblionumber, $hidden_items) = @_; - - my @items = C4::Items::GetItemsInfo($biblionumber); - if ($hidden_items && @$hidden_items) { - my %hi = map {$_ => 1} @$hidden_items; - @items = grep { !$hi{$_->{itemnumber}} } @items; - } + my ($biblionumber, $items) = @_; my $shelflocations = GetKohaAuthorisedValues('items.location',GetFrameworkCode($biblionumber), 'opac'); my $ccodes = GetKohaAuthorisedValues('items.ccode',GetFrameworkCode($biblionumber), 'opac'); @@ -258,7 +261,7 @@ sub buildKohaItemsNamespace { my $location = ""; my $ccode = ""; my $xml = ''; - for my $item (@items) { + for my $item (@$items) { my $status; my ( $transfertwhen, $transfertfrom, $transfertto ) = C4::Circulation::GetTransfers($item->{itemnumber}); diff --git a/catalogue/detail.pl b/catalogue/detail.pl index c4afb62..bea9c13 100755 --- a/catalogue/detail.pl +++ b/catalogue/detail.pl @@ -83,12 +83,6 @@ my $fw = GetFrameworkCode($biblionumber); my $showallitems = $query->param('showallitems'); my $marcflavour = C4::Context->preference("marcflavour"); -# XSLT processing of some stuff -if (C4::Context->preference("XSLTDetailsDisplay") ) { - $template->param('XSLTDetailsDisplay' =>'1', - 'XSLTBloc' => XSLTParse4Display($biblionumber, $record, "XSLTDetailsDisplay") ); -} - $template->param( 'SpineLabelShowPrintOnBibDetails' => C4::Context->preference("SpineLabelShowPrintOnBibDetails") ); $template->param( ocoins => GetCOinSBiblio($record) ); @@ -136,6 +130,12 @@ if (@hostitems){ push (@items, at hostitems); } +# XSLT processing of some stuff +if (C4::Context->preference("XSLTDetailsDisplay") ) { + $template->param('XSLTDetailsDisplay' =>'1', + 'XSLTBloc' => XSLTParse4Display($biblionumber, $record, "XSLTDetailsDisplay", \@all_items) ); +} + my $dat = &GetBiblioData($biblionumber); #coping with subscriptions diff --git a/opac/opac-detail.pl b/opac/opac-detail.pl index 6d71bed..d753700 100755 --- a/opac/opac-detail.pl +++ b/opac/opac-detail.pl @@ -140,11 +140,6 @@ SetUTF8Flag($record); my $marcflavour = C4::Context->preference("marcflavour"); my $ean = GetNormalizedEAN( $record, $marcflavour ); -# XSLT processing of some stuff -if (C4::Context->preference("OPACXSLTDetailsDisplay") ) { - $template->param( 'XSLTBloc' => XSLTParse4Display($biblionumber, $record, "OPACXSLTDetailsDisplay" ) ); -} - my $OpacBrowseResults = C4::Context->preference("OpacBrowseResults"); $template->{VARS}->{'OpacBrowseResults'} = $OpacBrowseResults; @@ -480,6 +475,11 @@ if ($hideitems) { @items = @all_items; } +# XSLT processing of some stuff +if (C4::Context->preference("OPACXSLTDetailsDisplay") ) { + $template->param( 'XSLTBloc' => XSLTParse4Display($biblionumber, $record, "OPACXSLTDetailsDisplay", \@items) ); +} + my $branches = GetBranches(); my $branch = ''; if (C4::Context->userenv){ -- 2.5.0 From srdjan at catalyst.net.nz Fri Apr 1 01:46:56 2016 From: srdjan at catalyst.net.nz (Srdjan) Date: Fri, 1 Apr 2016 12:46:56 +1300 Subject: [Koha-patches] [PATCH] bug_11213: whitespace correction Message-ID: <1459468016-16402-1-git-send-email-srdjan@catalyst.net.nz> --- C4/Search.pm | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/C4/Search.pm b/C4/Search.pm index a1e6b4c..7b88a59 100644 --- a/C4/Search.pm +++ b/C4/Search.pm @@ -2055,7 +2055,7 @@ sub searchResults { $onloan_items->{$key} = { %$item }; $onloan_items->{$key}->{due_date} = output_pref( { dt => dt_from_string( $item->{onloan} ), dateonly => 1 } ); $onloan_items->{$key}->{count}++ if $item->{$hbranch}; - $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} }; + $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} }; $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); @@ -2144,19 +2144,22 @@ sub searchResults { $other_items->{$key} = { %$item }; $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0; $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0; - $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value and $item->{notforloan}; - $other_items->{$key}->{count}++ if $item->{$hbranch}; - $other_items->{$key}->{location} = $shelflocations->{ $item->{location} }; - $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); + $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) + if $notforloan_authorised_value and $item->{notforloan}; + $other_items->{$key}->{count}++ + if $item->{$hbranch}; + $other_items->{$key}->{location} = $shelflocations->{ $item->{location} }; + $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); } # item is available else { $can_place_holds = 1; $available_count++; $available_items->{$prefix} = { %$item }; - $available_items->{$prefix}->{count}++ if $item->{$hbranch}; - $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} }; - $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); + $available_items->{$prefix}->{count}++ + if $item->{$hbranch}; + $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} }; + $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); } } } # notforloan, item level and biblioitem level -- 2.5.0 From srdjan at catalyst.net.nz Fri Apr 1 01:47:19 2016 From: srdjan at catalyst.net.nz (Srdjan) Date: Fri, 1 Apr 2016 12:47:19 +1300 Subject: [Koha-patches] [PATCH] bug_11213: Include XSLT processing for searchResults() test Message-ID: <1459468039-16548-1-git-send-email-srdjan@catalyst.net.nz> * Added template paths to temp test dir, so XSLT templates can be picked up --- C4/XSLT.pm | 1 + t/db_dependent/Search.t | 11 +++++++++++ 2 files changed, 12 insertions(+) diff --git a/C4/XSLT.pm b/C4/XSLT.pm index 874deee..9a6a38f 100644 --- a/C4/XSLT.pm +++ b/C4/XSLT.pm @@ -25,6 +25,7 @@ use strict; use warnings; use C4::Context; +use C4::Templates; use C4::Branch; use C4::Items; use C4::Koha; diff --git a/t/db_dependent/Search.t b/t/db_dependent/Search.t index c61c583..6ac0fab 100644 --- a/t/db_dependent/Search.t +++ b/t/db_dependent/Search.t @@ -123,6 +123,8 @@ $contextmodule->mock('preference', sub { return 'en'; } elsif ($pref eq 'AlternateHoldingsField') { return '490av'; + } elsif ($pref =~ m/XSLTResultsDisplay/) { + return 'default'; } elsif ($pref eq 'AuthoritySeparator') { return '--'; } elsif ($pref eq 'DisplayLibraryFacets') { @@ -191,6 +193,15 @@ sub mock_marcfromkohafield { sub run_marc21_search_tests { my $indexing_mode = shift; $datadir = tempdir(); + # Unix friendly, but so is the zebra_config.pl command below... + my $tpl_dir = File::Spec->rel2abs( dirname(__FILE__) ) . "/../../koha-tmpl"; + my $opac_dir = "$datadir/opac"; + mkdir $opac_dir; + symlink "$tpl_dir/opac-tmpl", "$opac_dir/templates"; + my $intranet_dir = "$datadir/intranet"; + mkdir $intranet_dir; + symlink "$tpl_dir/intranet-tmpl", "$intranet_dir/templates"; + system(dirname(__FILE__) . "/zebra_config.pl $datadir marc21 $indexing_mode"); mock_marcfromkohafield('marc21'); -- 2.5.0 From srdjan at catalyst.net.nz Fri Apr 1 01:47:38 2016 From: srdjan at catalyst.net.nz (Srdjan) Date: Fri, 1 Apr 2016 12:47:38 +1300 Subject: [Koha-patches] [PATCH] bug_11213: GetItemsInfo() test Message-ID: <1459468058-16682-1-git-send-email-srdjan@catalyst.net.nz> --- t/db_dependent/Items.t | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/t/db_dependent/Items.t b/t/db_dependent/Items.t index 5df6eb5..9bbb9d2 100755 --- a/t/db_dependent/Items.t +++ b/t/db_dependent/Items.t @@ -40,7 +40,7 @@ my $location = 'My Location'; subtest 'General Add, Get and Del tests' => sub { - plan tests => 14; + plan tests => 16; $schema->storage->txn_begin; @@ -58,6 +58,11 @@ subtest 'General Add, Get and Del tests' => sub { cmp_ok($item_bibnum, '==', $bibnum, "New item is linked to correct biblionumber."); cmp_ok($item_bibitemnum, '==', $bibitemnum, "New item is linked to correct biblioitemnumber."); + # Get items. + my @items_infos = GetItemsInfo( $bibnum, "cn_sort" ); + cmp_ok(scalar(@items_infos), '==', 1, "One item for biblionumber."); + cmp_ok($items_infos[0]{biblionumber}, '==', $bibnum, "Item has correct biblionumber."); + # Get item. my $getitem = GetItem($itemnumber); cmp_ok($getitem->{'itemnumber'}, '==', $itemnumber, "Retrieved item has correct itemnumber."); -- 2.5.0 From srdjan at catalyst.net.nz Fri Apr 1 01:48:06 2016 From: srdjan at catalyst.net.nz (Srdjan) Date: Fri, 1 Apr 2016 12:48:06 +1300 Subject: [Koha-patches] [PATCH] bug_11213: Added XSLTParse4Display() to Items test Message-ID: <1459468086-16855-1-git-send-email-srdjan@catalyst.net.nz> --- t/db_dependent/Items.t | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/t/db_dependent/Items.t b/t/db_dependent/Items.t index 9bbb9d2..c6ed605 100755 --- a/t/db_dependent/Items.t +++ b/t/db_dependent/Items.t @@ -20,6 +20,7 @@ use Modern::Perl; use MARC::Record; use C4::Biblio; +use C4::XSLT; use Koha::Database; use Koha::Library; @@ -40,7 +41,7 @@ my $location = 'My Location'; subtest 'General Add, Get and Del tests' => sub { - plan tests => 16; + plan tests => 18; $schema->storage->txn_begin; @@ -63,6 +64,16 @@ subtest 'General Add, Get and Del tests' => sub { cmp_ok(scalar(@items_infos), '==', 1, "One item for biblionumber."); cmp_ok($items_infos[0]{biblionumber}, '==', $bibnum, "Item has correct biblionumber."); + C4::Context->set_preference('XSLTResultsDisplay', 'default'); + C4::Context->set_preference('OPACXSLTResultsDisplay', 'default'); + C4::Context->clear_syspref_cache(); + my $record = GetMarcBiblio($bibnum); + my $html = XSLTParse4Display($bibnum, $record, "OPACXSLTResultsDisplay", \@items_infos); + ok($html, "XSLTParse4Display( OPACXSLTResultsDisplay )"); + $html = XSLTParse4Display($bibnum, $record, "XSLTResultsDisplay", \@items_infos); + ok($html, "XSLTParse4Display( XSLTResultsDisplay )"); + + # Get item. my $getitem = GetItem($itemnumber); cmp_ok($getitem->{'itemnumber'}, '==', $itemnumber, "Retrieved item has correct itemnumber."); -- 2.5.0 From srdjan at catalyst.net.nz Fri Apr 1 01:48:41 2016 From: srdjan at catalyst.net.nz (Srdjan) Date: Fri, 1 Apr 2016 12:48:41 +1300 Subject: [Koha-patches] [PATCH] bug_11213: Check for $item->{itype} presence to avoid warning Message-ID: <1459468121-17049-1-git-send-email-srdjan@catalyst.net.nz> --- C4/XSLT.pm | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/C4/XSLT.pm b/C4/XSLT.pm index 9a6a38f..adf5e97 100644 --- a/C4/XSLT.pm +++ b/C4/XSLT.pm @@ -269,8 +269,16 @@ sub buildKohaItemsNamespace { my $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber} ); - if ( $itemtypes->{ $item->{itype} }->{notforloan} || $item->{notforloan} || $item->{onloan} || $item->{withdrawn} || $item->{itemlost} || $item->{damaged} || - (defined $transfertwhen && $transfertwhen ne '') || $item->{itemnotforloan} || (defined $reservestatus && $reservestatus eq "Waiting") ){ + if ( ($item->{itype} && $itemtypes->{ $item->{itype} }->{notforloan}) + || $item->{notforloan} + || $item->{onloan} + || $item->{withdrawn} + || $item->{itemlost} + || $item->{damaged} + || (defined $transfertwhen && $transfertwhen ne '') + || $item->{itemnotforloan} + || (defined $reservestatus && $reservestatus eq "Waiting") + ){ if ( $item->{notforloan} < 0) { $status = "On order"; } -- 2.5.0 From srdjan at catalyst.net.nz Wed Apr 13 03:11:15 2016 From: srdjan at catalyst.net.nz (Srdjan) Date: Wed, 13 Apr 2016 13:11:15 +1200 Subject: [Koha-patches] [PATCH] bug_11213: Changed XSLTParse4Display() interface Message-ID: <1460509875-590-1-git-send-email-srdjan@catalyst.net.nz> The list of biblio items is passed on now, instead of GetItemsInfo() being called. This is because the callers already have the list ready, so the GetItemsInfo() call is being duplicated unnecessarily. Search::searchResults() builds items list from XML, and that one is passed instead. * XSLT::XSLTParse4Display() - supply the items list as input param - removed hidden items list param - hidden should not be in the items list - changed buildKohaItemsNamespace() accordingly * Items - added sort_by input param to GetItemsInfo() * catalogue/detail.pl, opac/opac-detail.pl, shelfpage() - added items list to the XSLTParse4Display() call * Search::searchResults() - include all available info when building items lists - added combined items list (available, on loan, other) to the XSLTParse4Display() call To test: This change is a noop, so following screens need to be checked against any changes: * Intranet: - catalogue/search.pl (results) - catalogue/detail.pl - virtualshelves/shelves.pl * Opac - opac-search.pl (results, hidelostitems syspref on and off) - opac-detail.pl - opac-shelves.pl The display should stay the same before and after patch. The speed should increase though. --- C4/Items.pm | 25 ++++++++++++++++++++++--- C4/Search.pm | 19 +++++-------------- C4/XSLT.pm | 23 +++++++++++++---------- catalogue/detail.pl | 12 ++++++------ opac/opac-detail.pl | 10 +++++----- 5 files changed, 51 insertions(+), 38 deletions(-) diff --git a/C4/Items.pm b/C4/Items.pm index a0dfb29..8d8174e 100644 --- a/C4/Items.pm +++ b/C4/Items.pm @@ -1258,10 +1258,14 @@ sub GetItemsByBiblioitemnumber { =head2 GetItemsInfo - @results = GetItemsInfo($biblionumber); + @results = GetItemsInfo($biblionumber, $order_by); Returns information about items with the given biblionumber. +The list is ordered by home branch name and some complex criteria +within it (see the code), unless $order_by is specified. +Currently only "cn_sort" is supported. + C returns a list of references-to-hash. Each element contains a number of keys. Most of them are attributes from the C, C, C, and C tables in the @@ -1299,7 +1303,8 @@ If this is set, it is set to C. =cut sub GetItemsInfo { - my ( $biblionumber ) = @_; + my ( $biblionumber, $order_by ) = @_; + my $dbh = C4::Context->dbh; # note biblioitems.* must be avoided to prevent large marc and marcxml fields from killing performance. require C4::Languages; @@ -1354,7 +1359,18 @@ sub GetItemsInfo { AND localization.lang = ? |; - $query .= " WHERE items.biblionumber = ? ORDER BY home.branchname, items.enumchron, LPAD( items.copynumber, 8, '0' ), items.dateaccessioned DESC" ; + $query .= " WHERE items.biblionumber = ? ORDER BY "; + my $order_by_cause = "home.branchname, items.enumchron, LPAD( items.copynumber, 8, '0' ), items.dateaccessioned DESC" ; + if ($order_by) { + if ($order_by eq 'cn_sort') { + $order_by_cause = "cn_sort ASC"; + } + else { + warn qq{Unsupported order by "$order_by"}; + } + } + $query .= $order_by_cause; + my $sth = $dbh->prepare($query); $sth->execute($language, $biblionumber); my $i = 0; @@ -1387,6 +1403,9 @@ sub GetItemsInfo { $data->{stack} = C4::Koha::GetKohaAuthorisedValueLib( $code, $data->{stack} ); } + $data->{location_intranet} = GetKohaAuthorisedValueLib('LOC', $data->{location}); + $data->{location_opac} = GetKohaAuthorisedValueLib('LOC', $data->{location}, 1); + # Find the last 3 people who borrowed this item. my $sth2 = $dbh->prepare("SELECT * FROM old_issues,borrowers WHERE itemnumber = ? diff --git a/C4/Search.pm b/C4/Search.pm index 9b7bde3..a1e6b4c 100644 --- a/C4/Search.pm +++ b/C4/Search.pm @@ -2007,7 +2007,6 @@ sub searchResults { my $items_count = scalar(@fields); my $maxitems_pref = C4::Context->preference('maxItemsinSearchResults'); my $maxitems = $maxitems_pref ? $maxitems_pref - 1 : 1; - my @hiddenitems; # hidden itemnumbers based on OpacHiddenItems syspref # loop through every item foreach my $field (@fields) { @@ -2029,7 +2028,6 @@ sub searchResults { # hidden based on OpacHiddenItems syspref my @hi = C4::Items::GetHiddenItemnumbers($item); if (scalar @hi) { - push @hiddenitems, @hi; $hideatopac_count++; next; } @@ -2046,7 +2044,7 @@ sub searchResults { $item->{'branchname'} = $branches{$item->{$otherbranch}}; } - my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber}; + my $prefix = $item->{$hbranch} . '--' . $item->{location} . $item->{itype} . $item->{itemcallnumber}; # For each grouping of items (onloan, available, unavailable), we build a key to store relevant info about that item my $userenv = C4::Context->userenv; if ( $item->{onloan} @@ -2054,12 +2052,10 @@ sub searchResults { { $onloan_count++; my $key = $prefix . $item->{onloan} . $item->{barcode}; + $onloan_items->{$key} = { %$item }; $onloan_items->{$key}->{due_date} = output_pref( { dt => dt_from_string( $item->{onloan} ), dateonly => 1 } ); $onloan_items->{$key}->{count}++ if $item->{$hbranch}; - $onloan_items->{$key}->{branchname} = $item->{branchname}; $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} }; - $onloan_items->{$key}->{itemcallnumber} = $item->{itemcallnumber}; - $onloan_items->{$key}->{description} = $item->{description}; $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); @@ -2145,25 +2141,20 @@ sub searchResults { $other_count++; my $key = $prefix . $item->{status}; - foreach (qw(withdrawn itemlost damaged branchname itemcallnumber)) { - $other_items->{$key}->{$_} = $item->{$_}; - } + $other_items->{$key} = { %$item }; $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0; $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0; $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value and $item->{notforloan}; $other_items->{$key}->{count}++ if $item->{$hbranch}; $other_items->{$key}->{location} = $shelflocations->{ $item->{location} }; - $other_items->{$key}->{description} = $item->{description}; $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); } # item is available else { $can_place_holds = 1; $available_count++; + $available_items->{$prefix} = { %$item }; $available_items->{$prefix}->{count}++ if $item->{$hbranch}; - foreach (qw(branchname itemcallnumber description)) { - $available_items->{$prefix}->{$_} = $item->{$_}; - } $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} }; $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); } @@ -2192,7 +2183,7 @@ sub searchResults { # XSLT processing of some stuff my $interface = $search_context eq 'opac' ? 'OPAC' : ''; if (!$scan && C4::Context->preference($interface . "XSLTResultsDisplay")) { - $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, $interface."XSLTResultsDisplay", 1, \@hiddenitems); + $oldbiblio->{XSLTResultsRecord} = XSLTParse4Display($oldbiblio->{biblionumber}, $marcrecord, $interface."XSLTResultsDisplay", [@available_items_loop, @onloan_items_loop, @other_items_loop], 1); # the last parameter tells Koha to clean up the problematic ampersand entities that Zebra outputs } diff --git a/C4/XSLT.pm b/C4/XSLT.pm index dd13c50..874deee 100644 --- a/C4/XSLT.pm +++ b/C4/XSLT.pm @@ -156,8 +156,17 @@ sub _get_best_default_xslt_filename { return $xslfilename; } +=head2 XSLTParse4Display( $biblionumber, $orig_record, $xslsyspref, $items, $fixamps ) + + $items => an array of items rerords, as returned from eg. GetItemsInfo + +Returns XSLT block + +=cut + sub XSLTParse4Display { - my ( $biblionumber, $orig_record, $xslsyspref, $fixamps, $hidden_items ) = @_; + my ( $biblionumber, $orig_record, $xslsyspref, $items, $fixamps ) = @_; + my $xslfilename = C4::Context->preference($xslsyspref); if ( $xslfilename =~ /^\s*"?default"?\s*$/i ) { my $htdocs; @@ -195,7 +204,7 @@ sub XSLTParse4Display { # grab the XML, run it through our stylesheet, push it out to the browser my $record = transformMARCXML4XSLT($biblionumber, $orig_record); - my $itemsxml = buildKohaItemsNamespace($biblionumber, $hidden_items); + my $itemsxml = $items ? buildKohaItemsNamespace($biblionumber, $items) : ""; my $xmlrecord = $record->as_xml(C4::Context->preference('marcflavour')); my $sysxml = "\n"; foreach my $syspref ( qw/ hidelostitems OPACURLOpenInNewWindow @@ -242,13 +251,7 @@ Is only used in this module currently. =cut sub buildKohaItemsNamespace { - my ($biblionumber, $hidden_items) = @_; - - my @items = C4::Items::GetItemsInfo($biblionumber); - if ($hidden_items && @$hidden_items) { - my %hi = map {$_ => 1} @$hidden_items; - @items = grep { !$hi{$_->{itemnumber}} } @items; - } + my ($biblionumber, $items) = @_; my $shelflocations = GetKohaAuthorisedValues('items.location',GetFrameworkCode($biblionumber), 'opac'); my $ccodes = GetKohaAuthorisedValues('items.ccode',GetFrameworkCode($biblionumber), 'opac'); @@ -258,7 +261,7 @@ sub buildKohaItemsNamespace { my $location = ""; my $ccode = ""; my $xml = ''; - for my $item (@items) { + for my $item (@$items) { my $status; my ( $transfertwhen, $transfertfrom, $transfertto ) = C4::Circulation::GetTransfers($item->{itemnumber}); diff --git a/catalogue/detail.pl b/catalogue/detail.pl index c4afb62..bea9c13 100755 --- a/catalogue/detail.pl +++ b/catalogue/detail.pl @@ -83,12 +83,6 @@ my $fw = GetFrameworkCode($biblionumber); my $showallitems = $query->param('showallitems'); my $marcflavour = C4::Context->preference("marcflavour"); -# XSLT processing of some stuff -if (C4::Context->preference("XSLTDetailsDisplay") ) { - $template->param('XSLTDetailsDisplay' =>'1', - 'XSLTBloc' => XSLTParse4Display($biblionumber, $record, "XSLTDetailsDisplay") ); -} - $template->param( 'SpineLabelShowPrintOnBibDetails' => C4::Context->preference("SpineLabelShowPrintOnBibDetails") ); $template->param( ocoins => GetCOinSBiblio($record) ); @@ -136,6 +130,12 @@ if (@hostitems){ push (@items, at hostitems); } +# XSLT processing of some stuff +if (C4::Context->preference("XSLTDetailsDisplay") ) { + $template->param('XSLTDetailsDisplay' =>'1', + 'XSLTBloc' => XSLTParse4Display($biblionumber, $record, "XSLTDetailsDisplay", \@all_items) ); +} + my $dat = &GetBiblioData($biblionumber); #coping with subscriptions diff --git a/opac/opac-detail.pl b/opac/opac-detail.pl index 6d71bed..d753700 100755 --- a/opac/opac-detail.pl +++ b/opac/opac-detail.pl @@ -140,11 +140,6 @@ SetUTF8Flag($record); my $marcflavour = C4::Context->preference("marcflavour"); my $ean = GetNormalizedEAN( $record, $marcflavour ); -# XSLT processing of some stuff -if (C4::Context->preference("OPACXSLTDetailsDisplay") ) { - $template->param( 'XSLTBloc' => XSLTParse4Display($biblionumber, $record, "OPACXSLTDetailsDisplay" ) ); -} - my $OpacBrowseResults = C4::Context->preference("OpacBrowseResults"); $template->{VARS}->{'OpacBrowseResults'} = $OpacBrowseResults; @@ -480,6 +475,11 @@ if ($hideitems) { @items = @all_items; } +# XSLT processing of some stuff +if (C4::Context->preference("OPACXSLTDetailsDisplay") ) { + $template->param( 'XSLTBloc' => XSLTParse4Display($biblionumber, $record, "OPACXSLTDetailsDisplay", \@items) ); +} + my $branches = GetBranches(); my $branch = ''; if (C4::Context->userenv){ -- 2.5.0 From srdjan at catalyst.net.nz Wed Apr 13 03:11:27 2016 From: srdjan at catalyst.net.nz (Srdjan) Date: Wed, 13 Apr 2016 13:11:27 +1200 Subject: [Koha-patches] [PATCH] bug_11213: whitespace correction Message-ID: <1460509887-701-1-git-send-email-srdjan@catalyst.net.nz> --- C4/Search.pm | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/C4/Search.pm b/C4/Search.pm index a1e6b4c..7b88a59 100644 --- a/C4/Search.pm +++ b/C4/Search.pm @@ -2055,7 +2055,7 @@ sub searchResults { $onloan_items->{$key} = { %$item }; $onloan_items->{$key}->{due_date} = output_pref( { dt => dt_from_string( $item->{onloan} ), dateonly => 1 } ); $onloan_items->{$key}->{count}++ if $item->{$hbranch}; - $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} }; + $onloan_items->{$key}->{location} = $shelflocations->{ $item->{location} }; $onloan_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); @@ -2144,19 +2144,22 @@ sub searchResults { $other_items->{$key} = { %$item }; $other_items->{$key}->{intransit} = ( $transfertwhen ne '' ) ? 1 : 0; $other_items->{$key}->{onhold} = ($reservestatus) ? 1 : 0; - $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) if $notforloan_authorised_value and $item->{notforloan}; - $other_items->{$key}->{count}++ if $item->{$hbranch}; - $other_items->{$key}->{location} = $shelflocations->{ $item->{location} }; - $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); + $other_items->{$key}->{notforloan} = GetAuthorisedValueDesc('','',$item->{notforloan},'','',$notforloan_authorised_value) + if $notforloan_authorised_value and $item->{notforloan}; + $other_items->{$key}->{count}++ + if $item->{$hbranch}; + $other_items->{$key}->{location} = $shelflocations->{ $item->{location} }; + $other_items->{$key}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); } # item is available else { $can_place_holds = 1; $available_count++; $available_items->{$prefix} = { %$item }; - $available_items->{$prefix}->{count}++ if $item->{$hbranch}; - $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} }; - $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); + $available_items->{$prefix}->{count}++ + if $item->{$hbranch}; + $available_items->{$prefix}->{location} = $shelflocations->{ $item->{location} }; + $available_items->{$prefix}->{imageurl} = getitemtypeimagelocation( $search_context, $itemtypes{ $item->{itype} }->{imageurl} ); } } } # notforloan, item level and biblioitem level -- 2.5.0 From srdjan at catalyst.net.nz Wed Apr 13 03:11:43 2016 From: srdjan at catalyst.net.nz (Srdjan) Date: Wed, 13 Apr 2016 13:11:43 +1200 Subject: [Koha-patches] [PATCH] bug_11213: Include XSLT processing for searchResults() test Message-ID: <1460509903-838-1-git-send-email-srdjan@catalyst.net.nz> * Added template paths to temp test dir, so XSLT templates can be picked up --- C4/XSLT.pm | 1 + t/db_dependent/Search.t | 11 +++++++++++ 2 files changed, 12 insertions(+) diff --git a/C4/XSLT.pm b/C4/XSLT.pm index 874deee..9a6a38f 100644 --- a/C4/XSLT.pm +++ b/C4/XSLT.pm @@ -25,6 +25,7 @@ use strict; use warnings; use C4::Context; +use C4::Templates; use C4::Branch; use C4::Items; use C4::Koha; diff --git a/t/db_dependent/Search.t b/t/db_dependent/Search.t index c61c583..6ac0fab 100644 --- a/t/db_dependent/Search.t +++ b/t/db_dependent/Search.t @@ -123,6 +123,8 @@ $contextmodule->mock('preference', sub { return 'en'; } elsif ($pref eq 'AlternateHoldingsField') { return '490av'; + } elsif ($pref =~ m/XSLTResultsDisplay/) { + return 'default'; } elsif ($pref eq 'AuthoritySeparator') { return '--'; } elsif ($pref eq 'DisplayLibraryFacets') { @@ -191,6 +193,15 @@ sub mock_marcfromkohafield { sub run_marc21_search_tests { my $indexing_mode = shift; $datadir = tempdir(); + # Unix friendly, but so is the zebra_config.pl command below... + my $tpl_dir = File::Spec->rel2abs( dirname(__FILE__) ) . "/../../koha-tmpl"; + my $opac_dir = "$datadir/opac"; + mkdir $opac_dir; + symlink "$tpl_dir/opac-tmpl", "$opac_dir/templates"; + my $intranet_dir = "$datadir/intranet"; + mkdir $intranet_dir; + symlink "$tpl_dir/intranet-tmpl", "$intranet_dir/templates"; + system(dirname(__FILE__) . "/zebra_config.pl $datadir marc21 $indexing_mode"); mock_marcfromkohafield('marc21'); -- 2.5.0 From srdjan at catalyst.net.nz Wed Apr 13 03:11:52 2016 From: srdjan at catalyst.net.nz (Srdjan) Date: Wed, 13 Apr 2016 13:11:52 +1200 Subject: [Koha-patches] [PATCH] bug_11213: GetItemsInfo() test Message-ID: <1460509912-931-1-git-send-email-srdjan@catalyst.net.nz> --- t/db_dependent/Items.t | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/t/db_dependent/Items.t b/t/db_dependent/Items.t index 5df6eb5..9bbb9d2 100755 --- a/t/db_dependent/Items.t +++ b/t/db_dependent/Items.t @@ -40,7 +40,7 @@ my $location = 'My Location'; subtest 'General Add, Get and Del tests' => sub { - plan tests => 14; + plan tests => 16; $schema->storage->txn_begin; @@ -58,6 +58,11 @@ subtest 'General Add, Get and Del tests' => sub { cmp_ok($item_bibnum, '==', $bibnum, "New item is linked to correct biblionumber."); cmp_ok($item_bibitemnum, '==', $bibitemnum, "New item is linked to correct biblioitemnumber."); + # Get items. + my @items_infos = GetItemsInfo( $bibnum, "cn_sort" ); + cmp_ok(scalar(@items_infos), '==', 1, "One item for biblionumber."); + cmp_ok($items_infos[0]{biblionumber}, '==', $bibnum, "Item has correct biblionumber."); + # Get item. my $getitem = GetItem($itemnumber); cmp_ok($getitem->{'itemnumber'}, '==', $itemnumber, "Retrieved item has correct itemnumber."); -- 2.5.0 From srdjan at catalyst.net.nz Wed Apr 13 03:12:01 2016 From: srdjan at catalyst.net.nz (Srdjan) Date: Wed, 13 Apr 2016 13:12:01 +1200 Subject: [Koha-patches] [PATCH] bug_11213: Added XSLTParse4Display() to Items test Message-ID: <1460509921-1025-1-git-send-email-srdjan@catalyst.net.nz> --- t/db_dependent/Items.t | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/t/db_dependent/Items.t b/t/db_dependent/Items.t index 9bbb9d2..c6ed605 100755 --- a/t/db_dependent/Items.t +++ b/t/db_dependent/Items.t @@ -20,6 +20,7 @@ use Modern::Perl; use MARC::Record; use C4::Biblio; +use C4::XSLT; use Koha::Database; use Koha::Library; @@ -40,7 +41,7 @@ my $location = 'My Location'; subtest 'General Add, Get and Del tests' => sub { - plan tests => 16; + plan tests => 18; $schema->storage->txn_begin; @@ -63,6 +64,16 @@ subtest 'General Add, Get and Del tests' => sub { cmp_ok(scalar(@items_infos), '==', 1, "One item for biblionumber."); cmp_ok($items_infos[0]{biblionumber}, '==', $bibnum, "Item has correct biblionumber."); + C4::Context->set_preference('XSLTResultsDisplay', 'default'); + C4::Context->set_preference('OPACXSLTResultsDisplay', 'default'); + C4::Context->clear_syspref_cache(); + my $record = GetMarcBiblio($bibnum); + my $html = XSLTParse4Display($bibnum, $record, "OPACXSLTResultsDisplay", \@items_infos); + ok($html, "XSLTParse4Display( OPACXSLTResultsDisplay )"); + $html = XSLTParse4Display($bibnum, $record, "XSLTResultsDisplay", \@items_infos); + ok($html, "XSLTParse4Display( XSLTResultsDisplay )"); + + # Get item. my $getitem = GetItem($itemnumber); cmp_ok($getitem->{'itemnumber'}, '==', $itemnumber, "Retrieved item has correct itemnumber."); -- 2.5.0 From srdjan at catalyst.net.nz Wed Apr 13 03:12:12 2016 From: srdjan at catalyst.net.nz (Srdjan) Date: Wed, 13 Apr 2016 13:12:12 +1200 Subject: [Koha-patches] [PATCH] bug_11213: Check for $item->{itype} presence to avoid warning Message-ID: <1460509932-1122-1-git-send-email-srdjan@catalyst.net.nz> --- C4/XSLT.pm | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/C4/XSLT.pm b/C4/XSLT.pm index 9a6a38f..adf5e97 100644 --- a/C4/XSLT.pm +++ b/C4/XSLT.pm @@ -269,8 +269,16 @@ sub buildKohaItemsNamespace { my $reservestatus = C4::Reserves::GetReserveStatus( $item->{itemnumber} ); - if ( $itemtypes->{ $item->{itype} }->{notforloan} || $item->{notforloan} || $item->{onloan} || $item->{withdrawn} || $item->{itemlost} || $item->{damaged} || - (defined $transfertwhen && $transfertwhen ne '') || $item->{itemnotforloan} || (defined $reservestatus && $reservestatus eq "Waiting") ){ + if ( ($item->{itype} && $itemtypes->{ $item->{itype} }->{notforloan}) + || $item->{notforloan} + || $item->{onloan} + || $item->{withdrawn} + || $item->{itemlost} + || $item->{damaged} + || (defined $transfertwhen && $transfertwhen ne '') + || $item->{itemnotforloan} + || (defined $reservestatus && $reservestatus eq "Waiting") + ){ if ( $item->{notforloan} < 0) { $status = "On order"; } -- 2.5.0 From srdjan at catalyst.net.nz Tue Apr 26 05:53:38 2016 From: srdjan at catalyst.net.nz (Srdjan) Date: Tue, 26 Apr 2016 15:53:38 +1200 Subject: [Koha-patches] [PATCH] bug_15562: Multi-host helper for plack installations Message-ID: <1461642818-24403-1-git-send-email-srdjan@catalyst.net.nz> Sort of an apocalypse * C4::Context->new() must be called with at least config file param. If you want current context, call C4::Context->current(). C4::Context->some_method() will still work as is. * Koha::Database->new_schema() now takes optional context param. * C4::Context->set_context() and restore_context() are synched with database set_schema() and restore_schema(). Created run_within_context() that wraps set_context() and restore_context() around code. * Created Koha::Handler::Plack* to facilitate running same code within different (database) contexts. * This initial version does not run with memcached turned on. Next patch will correct that. https://bugs.koha-community.org/show_bug.cgi?id=15562 --- C4/Auth_with_cas.pm | 2 +- C4/Auth_with_ldap.pm | 2 +- C4/Context.pm | 352 ++++++++++++++--------------- Koha/Cache.pm | 14 +- Koha/Database.pm | 38 +++- Koha/Handler/Plack.pm | 163 +++++++++++++ Koha/Handler/Plack/CGI.pm | 228 +++++++++++++++++++ about.pl | 2 +- admin/systempreferences.pl | 2 +- misc/cronjobs/check-url.pl | 2 +- misc/plack/koha-multi.psgi | 29 +++ misc/translator/LangInstaller.pm | 4 +- t/Koha_Handler_Plack.t | 136 +++++++++++ t/conf/dummy/koha-conf.xml | 7 + t/conf/koha1/koha-conf.xml | 7 + t/conf/koha2/koha-conf.xml | 5 + t/db_dependent/Amazon.t | 2 +- t/db_dependent/Context.t | 2 +- t/db_dependent/Template/Plugin/KohaDates.t | 2 +- t/db_dependent/XISBN.t | 2 +- t/db_dependent/sysprefs.t | 13 +- 21 files changed, 802 insertions(+), 212 deletions(-) create mode 100644 Koha/Handler/Plack.pm create mode 100644 Koha/Handler/Plack/CGI.pm create mode 100644 misc/plack/koha-multi.psgi create mode 100644 t/Koha_Handler_Plack.t create mode 100644 t/conf/dummy/koha-conf.xml create mode 100644 t/conf/koha1/koha-conf.xml create mode 100644 t/conf/koha2/koha-conf.xml diff --git a/C4/Auth_with_cas.pm b/C4/Auth_with_cas.pm index c9174da..f78e3b5 100644 --- a/C4/Auth_with_cas.pm +++ b/C4/Auth_with_cas.pm @@ -36,7 +36,7 @@ BEGIN { @ISA = qw(Exporter); @EXPORT = qw(check_api_auth_cas checkpw_cas login_cas logout_cas login_cas_url); } -my $context = C4::Context->new() or die 'C4::Context->new failed'; +my $context = C4::Context->current() or die 'No current context'; my $defaultcasserver; my $casservers; my $yamlauthfile = C4::Context->config('intranetdir') . "/C4/Auth_cas_servers.yaml"; diff --git a/C4/Auth_with_ldap.pm b/C4/Auth_with_ldap.pm index c50df76..0f7a174 100644 --- a/C4/Auth_with_ldap.pm +++ b/C4/Auth_with_ldap.pm @@ -53,7 +53,7 @@ sub ldapserver_error { } use vars qw($mapping @ldaphosts $base $ldapname $ldappassword); -my $context = C4::Context->new() or die 'C4::Context->new failed'; +my $context = C4::Context->current() or die 'No current context'; my $ldap = C4::Context->config("ldapserver") or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF}; my $prefhost = $ldap->{hostname} or die ldapserver_error('hostname'); my $base = $ldap->{base} or die ldapserver_error('base'); diff --git a/C4/Context.pm b/C4/Context.pm index c80647a..63a71d6 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -31,7 +31,7 @@ BEGIN { eval {C4::Context->dbh();}; if ($@){ $debug_level = 1; - } + } else { $debug_level = C4::Context->preference("DebugLevel"); } @@ -49,7 +49,7 @@ BEGIN { # a little example table with various version info"; print "

Koha error

-

The following fatal error has occurred:

+

The following fatal error has occurred:

$msg
@@ -63,11 +63,11 @@ BEGIN { } elsif ($debug_level eq "1"){ print "

Koha error

-

The following fatal error has occurred:

+

The following fatal error has occurred:

$msg
"; } else { print "

production mode - trapped fatal error

"; - } + } print ""; } #CGI::Carp::set_message(\&handle_errors); @@ -112,6 +112,7 @@ use Koha::Cache; use POSIX (); use DateTime::TimeZone; use Module::Load::Conditional qw(can_load); +use Data::Dumper; use Carp; use C4::Boolean; @@ -179,10 +180,6 @@ environment variable to the pathname of a configuration file to use. # file (/etc/koha/koha-conf.xml). # dbh # A handle to the appropriate database for this context. -# dbh_stack -# Used by &set_dbh and &restore_dbh to hold other database -# handles for this context. -# Zconn # A connection object for the Zebra server # Koha's main configuration file koha-conf.xml @@ -191,7 +188,7 @@ environment variable to the pathname of a configuration file to use. # 1. Path supplied via use C4::Context '/path/to/koha-conf.xml' # 2. Path supplied in KOHA_CONF environment variable. # 3. Path supplied in INSTALLED_CONFIG_FNAME, as long -# as value has changed from its default of +# as value has changed from its default of # '__KOHA_CONF_DIR__/koha-conf.xml', as happens # when Koha is installed in 'standard' or 'single' # mode. @@ -201,52 +198,25 @@ environment variable to the pathname of a configuration file to use. use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml"; # Default config file, if none is specified - + my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml'; # path to config file set by installer # __KOHA_CONF_DIR__ is set by rewrite-confg.PL # when Koha is installed in 'standard' or 'single' - # mode. If Koha was installed in 'dev' mode, + # mode. If Koha was installed in 'dev' mode, # __KOHA_CONF_DIR__ is *not* rewritten; instead - # developers should set the KOHA_CONF environment variable - -$context = undef; # Initially, no context is set - at context_stack = (); # Initially, no saved contexts - - -=head2 read_config_file - -Reads the specified Koha config file. - -Returns an object containing the configuration variables. The object's -structure is a bit complex to the uninitiated ... take a look at the -koha-conf.xml file as well as the XML::Simple documentation for details. Or, -here are a few examples that may give you what you need: + # developers should set the KOHA_CONF environment variable -The simple elements nested within the element: + at context_stack = (); # Initially, no saved contexts - my $pass = $koha->{'config'}->{'pass'}; +=head2 current -The elements: - - my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'}; - -The elements nested within the element: - - my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'}; - -Returns undef in case of error. +Returns the current context =cut -sub read_config_file { # Pass argument naming config file to read - my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => ''); - - if ($ismemcached) { - $memcached->set('kohaconf',$koha); - } - - return $koha; # Return value: ref-to-hash holding the configuration +sub current { + return $context; } =head2 ismemcached @@ -274,6 +244,15 @@ sub memcached { } } +sub db_driver { + my $self = shift; + + $self = $context unless ref ($self); + return unless $self; + + return $self->{db_driver}; +} + =head2 db_scheme2dbi my $dbd_driver_name = C4::Context::db_schema2dbi($scheme); @@ -294,32 +273,85 @@ sub import { # Create the default context ($C4::Context::Context) # the first time the module is called # (a config file can be optionaly passed) + # If ":no_config" is passed, no config load will be attempted + # Config file defaults to either the file given by the $KOHA_CONF + # environment variable, or /etc/koha/koha-conf.xml. + # It saves the context values in the declared memcached server(s) + # if currently available and uses those values until them expire and + # re-reads them. + + my ($pkg,$config_file) = @_ ; # default context already exists? return if $context; + if ($ismemcached) { + # retrieve from memcached + if (my $self = $memcached->get('kohaconf')) { + $context = $self; + return; + } + } + + # check that the specified config file exists and is not empty + undef $config_file if defined $config_file && + !( ref($config_file) || openhandle($config_file) || -s $config_file ); + # Figure out a good config file to load if none was specified. + if (!defined($config_file)) + { + # If the $KOHA_CONF environment variable is set, use + # that. Otherwise, use the built-in default. + if ($ENV{'KOHA_CONF'} and ref($ENV{'KOHA_CONF'}) || -s $ENV{"KOHA_CONF"}) { + $config_file = $ENV{"KOHA_CONF"}; + } elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) { + # NOTE: be careful -- don't change __KOHA_CONF_DIR in the above + # regex to anything else -- don't want installer to rewrite it + $config_file = $INSTALLED_CONFIG_FNAME; + } elsif (-s CONFIG_FNAME) { + $config_file = CONFIG_FNAME; + } else { + die "unable to locate Koha configuration file koha-conf.xml"; + } + } + # no ? so load it! - my ($pkg,$config_file) = @_ ; + return if $config_file && $config_file eq ":no_config"; my $new_ctx = __PACKAGE__->new($config_file); return unless $new_ctx; # if successfully loaded, use it by default - $new_ctx->set_context; - 1; + $context = $new_ctx; + + if ($ismemcached) { + $memcached->set('kohaconf',$new_ctx); + } } +use Scalar::Util qw(openhandle); =head2 new - $context = new C4::Context; $context = new C4::Context("/path/to/koha-conf.xml"); Allocates a new context. Initializes the context from the specified -file, which defaults to either the file given by the C<$KOHA_CONF> -environment variable, or F. +file. -It saves the koha-conf.xml values in the declared memcached server(s) -if currently available and uses those values until them expire and -re-reads them. +XML structure is a bit complex to the uninitiated ... take a look at the +koha-conf.xml file as well as the XML::Simple documentation for details. Or, +here are a few examples that may give you what you need: + +The simple elements nested within the element: + + my $pass = $koha->{'config'}->{'pass'}; + +The elements: + + my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'}; + +The elements nested within the element: + + my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'}; + +Returns undef in case of error. C<&new> does not set this context as the new default context; for that, use C<&set_context>. @@ -331,46 +363,22 @@ that, use C<&set_context>. # 2004-08-10 A. Tarallo: Added check if the conf file is not empty sub new { my $class = shift; - my $conf_fname = shift; # Config file to load - my $self = {}; - - # check that the specified config file exists and is not empty - undef $conf_fname unless - (defined $conf_fname && -s $conf_fname); - # Figure out a good config file to load if none was specified. - if (!defined($conf_fname)) - { - # If the $KOHA_CONF environment variable is set, use - # that. Otherwise, use the built-in default. - if (exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s $ENV{"KOHA_CONF"}) { - $conf_fname = $ENV{"KOHA_CONF"}; - } elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) { - # NOTE: be careful -- don't change __KOHA_CONF_DIR in the above - # regex to anything else -- don't want installer to rewrite it - $conf_fname = $INSTALLED_CONFIG_FNAME; - } elsif (-s CONFIG_FNAME) { - $conf_fname = CONFIG_FNAME; - } else { - warn "unable to locate Koha configuration file koha-conf.xml"; - return; - } - } - - if ($ismemcached) { - # retrieve from memcached - $self = $memcached->get('kohaconf'); - if (not defined $self) { - # not in memcached yet - $self = read_config_file($conf_fname); - } - } else { - # non-memcached env, read from file - $self = read_config_file($conf_fname); - } - - $self->{"config_file"} = $conf_fname; - warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"}); - return if !defined($self->{"config"}); + my $conf_fname = shift or croak "No conf"; + my $namespace = shift; + + my $self = XMLin( + $conf_fname, + keyattr => ['id'], + forcearray => ['listen', 'server', 'serverinfo'], + suppressempty => '', + ); + die "Invalid config ".(ref($conf_fname) ? $$conf_fname : $conf_fname).": ".Dumper($self) + unless ref($self) && $self->{"config"}; + + $self->{config_file} = $conf_fname; + $self->{namespace} = $namespace; + $self->{use_syspref_cache} = 1; + $self->{syspref_cache} = Koha::Cache->new({namespace => $namespace}); $self->{"Zconn"} = undef; # Zebra Connections $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield @@ -386,7 +394,6 @@ sub new { =head2 set_context - $context = new C4::Context; $context->set_context(); or set_context C4::Context $context; @@ -419,17 +426,21 @@ sub set_context if (ref($self) eq "") { # Class method. The new context is the next argument. - $new_context = shift; + $new_context = shift or croak "No new context"; } else { # Instance method. The new context is $self. $new_context = $self; } - # Save the old context, if any, on the stack - push @context_stack, $context if defined($context); + # undef $new_context->{schema} if $new_context->{schema} && !$new_context->{schema}->ping + my $schema = $new_context->{schema} ||= Koha::Database->new_schema($new_context); + + # Save the old context on the stack + push @context_stack, $context; # Set the new context $context = $new_context; + Koha::Database->set_schema($schema); } =head2 restore_context @@ -445,19 +456,38 @@ sub restore_context { my $self = shift; - if ($#context_stack < 0) - { - # Stack underflow. - die "Context stack underflow"; - } - # Pop the old context and set it. $context = pop @context_stack; + Koha::Database->restore_schema(); # FIXME - Should this return something, like maybe the context # that was current when this was called? } +=head2 run_within_context + + $context->run_within_context(sub {...}); + +Runs code within context + +=cut + +#' +sub run_within_context +{ + my $self = shift; + my $code = shift or croak "No code"; + + $self->set_context; + + local $@; + my $ret = eval { $code->(@_) }; + my $died = $@; + $self->restore_context; + die $died if $died; + return $ret; +} + =head2 config $value = C4::Context->config("config_variable"); @@ -474,26 +504,32 @@ Cnew> will not return it. =cut sub _common_config { - my $var = shift; - my $term = shift; - return if !defined($context->{$term}); + my $self = shift; + my $var = shift; + my $term = shift; + + $self = $context unless ref $self; + return if !defined($self->{$term}); # Presumably $self->{$term} might be # undefined if the config file given to &new # didn't exist, and the caller didn't bother # to check the return value. # Return the value of the requested config variable - return $context->{$term}->{$var}; + return $self->{$term}->{$var}; } sub config { - return _common_config($_[1],'config'); + my $self = shift; + return $self->_common_config($_[0],'config'); } sub zebraconfig { - return _common_config($_[1],'server'); + my $self = shift; + return $self->_common_config($_[0],'server'); } sub ModZebrations { - return _common_config($_[1],'serverinfo'); + my $self = shift; + return $self->_common_config($_[0],'serverinfo'); } =head2 preference @@ -512,10 +548,9 @@ with this method. =cut -my $syspref_cache = Koha::Cache->get_instance(); -my $use_syspref_cache = 1; sub preference { my $self = shift; + $self = $context unless ref $self; my $var = shift; # The system preference to return $var = lc $var; @@ -523,8 +558,8 @@ sub preference { return $ENV{"OVERRIDE_SYSPREF_$var"} if defined $ENV{"OVERRIDE_SYSPREF_$var"}; - my $cached_var = $use_syspref_cache - ? $syspref_cache->get_from_cache("syspref_$var") + my $cached_var = $self->{use_syspref_cache} + ? $self->{syspref_cache}->get_from_cache("syspref_$var") : undef; return $cached_var if defined $cached_var; @@ -532,8 +567,8 @@ sub preference { eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) }; my $value = $syspref ? $syspref->value() : undef; - if ( $use_syspref_cache ) { - $syspref_cache->set_in_cache("syspref_$var", $value); + if ( $self->{use_syspref_cache} ) { + $self->{syspref_cache}->set_in_cache("syspref_$var", $value); } return $value; } @@ -556,7 +591,8 @@ default behavior. sub enable_syspref_cache { my ($self) = @_; - $use_syspref_cache = 1; + $self = $context unless ref $self; + $self->{use_syspref_cache} = 1; # We need to clear the cache to have it up-to-date $self->clear_syspref_cache(); } @@ -572,7 +608,8 @@ used with Plack and other persistent environments. sub disable_syspref_cache { my ($self) = @_; - $use_syspref_cache = 0; + $self = $context unless ref $self; + $self->{use_syspref_cache} = 0; $self->clear_syspref_cache(); } @@ -587,8 +624,10 @@ will not be seen by this process. =cut sub clear_syspref_cache { - return unless $use_syspref_cache; - $syspref_cache->flush_all; + my ($self) = @_; + $self = $context unless ref $self; + return unless $self->{use_syspref_cache}; + $self->{syspref_cache}->flush_all; } =head2 set_preference @@ -604,6 +643,7 @@ preference. sub set_preference { my ( $self, $variable, $value, $explanation, $type, $options ) = @_; + $self = $context unless ref $self; $variable = lc $variable; @@ -639,8 +679,8 @@ sub set_preference { )->store(); } - if ( $use_syspref_cache ) { - $syspref_cache->set_in_cache( "syspref_$variable", $value ); + if ( $self->{use_syspref_cache} ) { + $self->{syspref_cache}->set_in_cache( "syspref_$variable", $value ); } return $syspref; @@ -658,10 +698,11 @@ was no syspref of the name. sub delete_preference { my ( $self, $var ) = @_; + $self = $context unless ref $self; if ( Koha::Config::SysPrefs->find( $var )->delete ) { - if ( $use_syspref_cache ) { - $syspref_cache->clear_from_cache("syspref_$var"); + if ( $self->{use_syspref_cache} ) { + $self->{syspref_cache}->clear_from_cache("syspref_$var"); } return 1; @@ -675,7 +716,7 @@ sub delete_preference { Returns a connection to the Zebra database -C<$self> +C<$self> C<$server> one of the servers defined in the koha-conf.xml file @@ -786,8 +827,7 @@ creates one, and connects to the database. This database handle is cached for future use: if you call Cdbh> twice, you will get the same handle both -times. If you need a second database handle, use C<&new_dbh> and -possibly C<&set_dbh>. +times. If you need a second database handle, use C<&new_dbh>. =cut @@ -826,64 +866,6 @@ sub new_dbh return &dbh({ new => 1 }); } -=head2 set_dbh - - $my_dbh = C4::Connect->new_dbh; - C4::Connect->set_dbh($my_dbh); - ... - C4::Connect->restore_dbh; - -C<&set_dbh> and C<&restore_dbh> work in a manner analogous to -C<&set_context> and C<&restore_context>. - -C<&set_dbh> saves the current database handle on a stack, then sets -the current database handle to C<$my_dbh>. - -C<$my_dbh> is assumed to be a good database handle. - -=cut - -#' -sub set_dbh -{ - my $self = shift; - my $new_dbh = shift; - - # Save the current database handle on the handle stack. - # We assume that $new_dbh is all good: if the caller wants to - # screw himself by passing an invalid handle, that's fine by - # us. - push @{$context->{"dbh_stack"}}, $context->{"dbh"}; - $context->{"dbh"} = $new_dbh; -} - -=head2 restore_dbh - - C4::Context->restore_dbh; - -Restores the database handle saved by an earlier call to -Cset_dbh>. - -=cut - -#' -sub restore_dbh -{ - my $self = shift; - - if ($#{$context->{"dbh_stack"}} < 0) - { - # Stack underflow - die "DBH stack underflow"; - } - - # Pop the old database handle and set it. - $context->{"dbh"} = pop @{$context->{"dbh_stack"}}; - - # FIXME - If it is determined that restore_context should - # return something, then this function should, too. -} - =head2 queryparser $queryparser = C4::Context->queryparser diff --git a/Koha/Cache.pm b/Koha/Cache.pm index eeb2723..a403836 100644 --- a/Koha/Cache.pm +++ b/Koha/Cache.pm @@ -286,7 +286,7 @@ sub set_in_cache { $value = clone( $value ) if ref($value) and not $unsafe; # Set in L1 cache - $L1_cache{ $key } = $value; + $L1_cache{ $self->{namespace} }{ $key } = $value; # We consider an expiry of 0 to be inifinite if ( $expiry ) { @@ -337,12 +337,12 @@ sub get_from_cache { return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ ); # Return L1 cache value if exists - if ( exists $L1_cache{$key} ) { + if ( exists $L1_cache{ $self->{namespace} }{ $key } ) { # No need to deep copy if it's a scalar # Or if we do not need to deep copy - return $L1_cache{$key} - if not ref $L1_cache{$key} or $unsafe; - return clone $L1_cache{$key}; + return $L1_cache{ $self->{namespace} }{ $key } + if not ref $L1_cache{ $self->{namespace} }{ $key } or $unsafe; + return clone $L1_cache{ $self->{namespace} }{ $key }; } my $get_sub = $self->{ref($self->{$cache}) . "_get"}; @@ -373,7 +373,7 @@ sub clear_from_cache { return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ ); # Clear from L1 cache - delete $L1_cache{$key}; + delete $L1_cache{ $self->{namespace} }{ $key }; return $self->{$cache}->delete($key) if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' ); @@ -402,7 +402,7 @@ sub flush_all { sub flush_L1_cache { my( $self ) = @_; - %L1_cache = (); + delete $L1_cache{ $self->{namespace} }; } =head1 TIED INTERFACE diff --git a/Koha/Database.pm b/Koha/Database.pm index d40eb52..959c00d 100644 --- a/Koha/Database.pm +++ b/Koha/Database.pm @@ -47,10 +47,9 @@ __PACKAGE__->mk_accessors(qw( )); # database connection from the data given in the current context, and # returns it. sub _new_schema { + my $context = shift || C4::Context->current(); - my $context = C4::Context->new(); - - my $db_driver = $context->{db_driver}; + my $db_driver = $context->db_driver; my $db_name = $context->config("database"); my $db_host = $context->config("hostname"); @@ -122,16 +121,16 @@ sub schema { return $database->{schema} if defined $database->{schema}; } - $database->{schema} = &_new_schema(); + $database->{schema} = &_new_schema($params->{context}); return $database->{schema}; } =head2 new_schema - $schema = $database->new_schema; + $schema = $database->new_schema($context); -Creates a new connection to the Koha database for the current context, -and returns the database handle (a C object). +Creates a new connection to the Koha database for the context +(current is default), and returns the database handle (a C object). The handle is not saved anywhere: this method is strictly a convenience function; the point is that it knows which database to @@ -143,7 +142,7 @@ connect to so that the caller doesn't have to know. sub new_schema { my $self = shift; - return &_new_schema(); + return &_new_schema(@_); } =head2 set_schema @@ -200,6 +199,29 @@ sub restore_schema { # return something, then this function should, too. } +=head2 run_with_schema + + $database->run_with_schema( $schema, sub {...} ); + +Restores the database handle saved by an earlier call to +C<$database-Eset_schema> C<$database-Erestore_schema> wrapper. + +=cut + +sub run_with_schema { + my $self = shift; + my $schema = shift or croak "No schema"; + my $code = shift or croak "No sub"; + + $self->set_schema; + local $@; + my $ret = eval { $code->(@_) }; + my $died = $@; + $self->restore_schema; + die $died if $died; + return $ret; +} + =head2 EXPORT None by default. diff --git a/Koha/Handler/Plack.pm b/Koha/Handler/Plack.pm new file mode 100644 index 0000000..af3f6cb --- /dev/null +++ b/Koha/Handler/Plack.pm @@ -0,0 +1,163 @@ +package Koha::Handler::Plack; + +# Copyright (c) 2016 Catalyst IT +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +=head1 NAME + + Koha::Handler::Plack - Plack helper + +=head1 SYNOPSIS + + koha.psgi: + use Koha::Handler::Plack; + + my %HOST_CONF = ( + 'koha1.com' => { ... }, + 'koha2.com' => { ... }, + ... + ); + # last line + Koha::Handler::Plack->app_per_host(\%HOST_CONF); + + See C below + +=head1 DESCRIPTION + + Some handy function to help with Koha/Plack in a multi-host situation. + + The problem: + Koha app relies on env vars. This should be changed, ie C4::Context should + be upgraded to Koha::App, but until then we need a gap filler. That's + because once up, there's no way to pass on new env to a psgi container. + In Apache, for instance, we can specify env vars per virtual host. Plack + has no such concept. + + Solution: + We need to modify the environment in situ, per virtual host - app_per_host(). + We specify env for each hostname, and apply. + +=cut + +use Modern::Perl; +use Carp; + +use Plack::App::URLMap; + +=head1 CLASS METHODS + +=head2 app_per_host($host_apps) + + App wrapper for per virtual host scenario. + + C<$host_apps>: + { + hostname => 'koha1.com', + app => $app1, + context => $context1, + }, + { + hostname => ['koha2.com', 'www.koha2.com'], + app => $app2, + context => $context2, + }, + ... + + C is mandatory. + + koha.psgi: + + use Plack::Builder; + use Plack::App::CGIBin; + + use C4::Context; + + my $opac_app = builder { + enable "Plack::Middleware::Static", + path => qr{^/opac-tmpl/}, root => '/usr/share/koha/opac/htdocs/'; + + enable 'StackTrace'; + mount "/cgi-bin/koha" => Plack::App::CGIBin->new(root => "/usr/share/koha/opac/cgi-bin/opac"); + }; + my $intranet_app = builder { + enable "Plack::Middleware::Static", + path => qr{^/intranet-tmpl/}, root => '/usr/share/koha/intranet/htdocs/'; + + enable 'StackTrace'; + mount "/cgi-bin/koha" => Plack::App::CGIBin->new(root => "/usr/share/koha/cgi-bin"); + }; + + my @host_def; + + my $conf_file_1 = "/etc/koha/site-1/koha_conf.xml"; + my $context_1 = C4::Context->new($conf_file_1); + push @host_def, + { + hostname => [ "public.host.for.site-1", "www.public.host.for.site-1" ], + app => $opac_app, + context => $context_1, + }, + { + hostname => "intranet.host.for.site-1", + app => $intranet_app, + context => $context_1, + }; + + my $conf_file_2 = "/etc/koha/site-1/koha_conf.xml"; + my $context_2 = C4::Context->new($conf_file_2); + push @host_def, + { + hostname => "public.host.for.site-2", + app => $opac_app, + context => $context_2, + }, + { + hostname => "intranet.host.for.site-2", + app => $intranet_app, + context => $context_2, + }; + + ... + + Koha::Handler::Plack->app_per_host( \@host_def ); + +=cut + +sub app_per_host { + my $class = shift; + my $sites = shift or die "No sites spec"; + + my $map = Plack::App::URLMap->new; + foreach my $site_params ( @$sites ) { + my $hosts = $site_params->{hostname} or croak "No hostname"; + $hosts = [$hosts] unless ref $hosts; + + my $app = $site_params->{app} or croak "No app"; + my $context = $site_params->{context} or croak "No Koha Context"; + + foreach my $host (@$hosts) { + $map->map("http://$host/" => sub { + my $env = shift; + + return $context->run_within_context(sub { $app->($env) }); + }); + } + } + return $map->to_app; +} + +1; diff --git a/Koha/Handler/Plack/CGI.pm b/Koha/Handler/Plack/CGI.pm new file mode 100644 index 0000000..36c6907 --- /dev/null +++ b/Koha/Handler/Plack/CGI.pm @@ -0,0 +1,228 @@ +package Koha::Handler::Plack::CGI; + +# Copyright (c) 2016 Catalyst IT +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along with +# Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +=head1 NAME + + Koha::Handler::Plack::CGI - Plack helper for CGI scripts + +=head1 SYNOPSIS + + koha.psgi: + use Koha::Handler::Plack::CGI; + + my %koha_env = ( + opac => { + static_root => '/usr/share/koha/opac/htdocs', + script_root => '/usr/share/koha/opac', + }, + intranet => { + static_root => '/usr/share/koha/intranet/htdocs', + script_root => '/usr/share/koha/intranet' + } + ); + my @sites = ( + { + opac_hostname => 'koha1-opac.com', + intranet_hostname => 'koha1-intranet.com', + config = '/etc/koha/koha1/koha-conf.xml' + }, + { + opac_hostname => ['opac.koha2.com', 'www.opackoha2.com'], + intranet_hostname => ['intranet.koha2.com', 'www.intranetkoha2.com'], + config = '/etc/koha/koha2/koha-conf.xml' + }, + ); + + # last line + Koha::Handler::Plack::CGI->app_per_host(\%HOST_CONF); + + See C below + +=head1 DESCRIPTION + + CGI script runner. + + One beautiful day wiwill move away from that and have proper App module + with router and handlers + + See C + +=cut + +use Modern::Perl; +use Carp; + +use Plack::Builder; +use Plack::App::CGIBin; + +use parent "Koha::Handler::Plack"; + +use C4::Context; + +=head1 CLASS METHODS + +=head2 app($context, $env) + + Plack app builder fora CGI app + + C<$context>: "opac" or "intranet" + C<$env>: + { + static_root => '...', + script_root => '...', + pugins => [ + [ 'StackTrace' ], + ... + ], + } + + koha.psgi: + + Koha::Handler::Plack::CGI->app( "opac", \%opac_app_env ); + +=cut + +sub app { + my $class = shift; + my $context = shift; + croak "Invalid app context '$context' - must be 'opac' or 'intranet'" + unless $context =~ m/^(opac|intranet)$/; + my $env = shift or croak "No $context env details"; + + my $static_root = $env->{static_root} or croak "No $context static_root"; + $static_root = "$static_root/" unless $static_root =~ m!/$!; + my $script_root = $env->{script_root} or croak "No $context script_root"; + $script_root =~ s!/$!!; + my $plugins = $env->{plugins} || []; + my $is_intranet = $context eq "intranet"; + + builder { + enable "Plack::Middleware::Static", + path => qr{^/$context-tmpl/}, root => $static_root; + + map enable(@$_), @$plugins; + + mount "/cgi-bin/koha" => Plack::App::CGIBin->new(root => $script_root)->to_app; + mount "/" => sub { + return [ 302, [ Location => '/cgi-bin/koha/' . ( $is_intranet ? 'mainpage.pl' : 'opac-main.pl' ) ], [] ]; + }; + }; +} + +=head2 multi_site($env, $sites) + + App wrapper for per virtual host scenario. + + C<$env>: + { + opac => { + static_root => '/usr/share/koha/opac/htdocs', + script_root => '/usr/share/koha/opac/cgi-bin/opac', + pugins => [ + [ 'StackTrace' ], + ], + }, + intranet => { + static_root => '/usr/share/koha/intranet/htdocs', + script_root => '/usr/share/koha/cgi-bin' + } + } + C<$sites>: + { + namespace => 'koha1', + opac_hostname => 'koha1-opac.com', + intranet_hostname => 'koha1-intranet.com', + config => '/etc/koha/sites/koha1/koha-conf.xml', + shared_config => 1 + }, + { + namespace => 'koha2', + opac_hostname => ['opac.koha2.com', 'www.opackoha2.com'], + intranet_hostname => ['intranet.koha2.com', 'www.intranetkoha2.com'], + config => '/etc/koha/sites/koha2/koha-conf.xml' + }, + ... + + koha.psgi: + + Koha::Handler::Plack::CGI->multi_site( \%koha_app_env, \@sites ); + +=cut + +my $DUMMY_KOHA_CONF = "DUMMY"; +sub multi_site { + my $class = shift; + my $env = shift or croak "No Koha env details"; + my $sites = shift or croak "No sites spec"; + + my ($opac_app, $intranet_app); + + if (my $opac = $env->{opac}) { + $opac_app = $class->app('opac', $opac); + } + + if (my $intranet = $env->{intranet}) { + $intranet_app = $class->app('intranet', $intranet); + } + + my @host_def = map { + my $namespace = $_->{namespace} or croak "No namespace"; + my $config = $_->{config} or croak "Site without config"; + my $shared_context = $_->{shared_context}; + + my $context = C4::Context->new($config, $namespace); + + my @hd; + if (my $hostname = $_->{opac_hostname}) { + croak "You have OPAC hosts without OPAC env details" unless $opac_app; + push @hd, { + hostname => $hostname, + app => sub { + # XXX this may need some rethinking + local $ENV{KOHA_CONF} = \$DUMMY_KOHA_CONF; + local $ENV{MEMCACHED_NAMESPACE} = $namespace; + + $opac_app->(@_); + }, + context => $context, + shared_context => $shared_context, + }; + } + if (my $hostname = $_->{intranet_hostname}) { + croak "You have Intranet hosts without Intranet env details" unless $intranet_app; + push @hd, { + hostname => $hostname, + app => sub { + # XXX this may need some rethinking + local $ENV{KOHA_CONF} = \$DUMMY_KOHA_CONF; + local $ENV{MEMCACHED_NAMESPACE} = $namespace; + + $intranet_app->(@_); + }, + context => $context, + shared_context => $shared_context, + }; + } + @hd; + } @$sites; + + return $class->app_per_host( \@host_def ); +} + +1; diff --git a/about.pl b/about.pl index 6b77677..a1469c1 100755 --- a/about.pl +++ b/about.pl @@ -92,7 +92,7 @@ my $warnIsRootUser = (! $loggedinuser); my $warnNoActiveCurrency = (! defined Koha::Acquisition::Currencies->get_active); my @xml_config_warnings; -my $context = new C4::Context; +my $context = C4::Context->current; if ( ! defined C4::Context->config('zebra_bib_index_mode') ) { push @xml_config_warnings, { diff --git a/admin/systempreferences.pl b/admin/systempreferences.pl index 67e0638..861508f 100755 --- a/admin/systempreferences.pl +++ b/admin/systempreferences.pl @@ -387,7 +387,7 @@ output_html_with_http_headers $input, $cookie, $template->output; # .pref files. sub get_prefs_from_files { - my $context = C4::Context->new(); + my $context = C4::Context->current(); my $path_pref_en = $context->config('intrahtdocs') . '/prog/en/modules/admin/preferences'; # Get all .pref file names diff --git a/misc/cronjobs/check-url.pl b/misc/cronjobs/check-url.pl index 71885ab..2869446 100755 --- a/misc/cronjobs/check-url.pl +++ b/misc/cronjobs/check-url.pl @@ -190,7 +190,7 @@ sub check_all_url { my $checker = C4::URL::Checker->new($timeout,$agent); $checker->{ host_default } = $host; - my $context = new C4::Context( ); + my $context = C4::Context->current(); my $dbh = $context->dbh; my $sth = $dbh->prepare( "SELECT biblionumber FROM biblioitems WHERE url <> ''" ); diff --git a/misc/plack/koha-multi.psgi b/misc/plack/koha-multi.psgi new file mode 100644 index 0000000..e897f02 --- /dev/null +++ b/misc/plack/koha-multi.psgi @@ -0,0 +1,29 @@ +#!/usr/bin/perl + +# This is a minimal example. You can include all frills from koha.psgi +# To try it: +# plackup -I /usr/share/koha/lib --port 5010 koha-multi.psgi + +my %KOHA_ENV = ( + opac => { + static_root => '/usr/share/koha/opac/htdocs', + script_root => '/usr/share/koha/opac/cgi-bin/opac', + pugins => [ + # don't enable this plugin in production, since stack traces reveal too much information + # about system to potential attackers! + [ 'StackTrace' ], + ], + }, + intranet => { + static_root => '/usr/share/koha/intranet/htdocs', + script_root => '/usr/share/koha/intranet/cgi-bin', + } +); +my @SITES = map { + namespace => $_, + opac_hostname => "opac.$_.my-koha-multisite.net", + intranet_hostname => "intranet.$_.my-koha-multisite.net", + config => "/etc/koha/sites/$_/koha-conf.xml" +}, qw(koha1 koha2 koha3); + +Koha::Handler::Plack::CGI->multi_site( \%KOHA_ENV, \@SITES ); diff --git a/misc/translator/LangInstaller.pm b/misc/translator/LangInstaller.pm index 683897d..14a21c7 100644 --- a/misc/translator/LangInstaller.pm +++ b/misc/translator/LangInstaller.pm @@ -56,7 +56,7 @@ sub new { my $self = { }; - my $context = C4::Context->new(); + my $context = C4::Context->current(); $self->{context} = $context; $self->{path_pref_en} = $context->config('intrahtdocs') . '/prog/en/modules/admin/preferences'; @@ -140,7 +140,7 @@ sub new { sub po_filename { my $self = shift; - my $context = C4::Context->new; + my $context = C4::Context->current(); my $trans_path = $Bin . '/po'; my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po"; return $trans_file; diff --git a/t/Koha_Handler_Plack.t b/t/Koha_Handler_Plack.t new file mode 100644 index 0000000..8172940 --- /dev/null +++ b/t/Koha_Handler_Plack.t @@ -0,0 +1,136 @@ +#!/usr/bin/perl + +use Test::More tests => 15; +use Plack::Test; +use Plack::Test::MockHTTP; +use Test::Mock::LWP::Dispatch; +use Test::MockModule; +use HTTP::Request::Common; +use FindBin qw($Bin); +use Data::Dumper; + +use_ok("Koha::Handler::Plack"); +use_ok("Koha::Handler::Plack::CGI"); + +use C4::Context; + +my $db = Test::MockModule->new('Koha::Database'); +$db->mock( + _new_schema => sub { + return $_[0]; + } +); + +sub make_response { + return join ";", map defined($_) ? $_ : "", @_; +} +sub dummy_val { + return C4::Context->config("dummy"); +} +sub check_context { + my $dummy_val = dummy_val(); + is $dummy_val, undef, "context preserved" + or diag("dummy val: $dummy_val"); +} + +my $app = sub { + return [ + 200, + [ 'Content-Type' => 'text/plain' ], + [ make_response(dummy_val()) ] + ]; +}; +my $generic_url = "http://dummyhost.com/"; + +my $KOHA_CONF_XML = < + + test + XML + . + + +EOS + +my @HOST_CONF = ( + { + hostname => ['koha-file.com', 'www.koha-file.com'], + app => $app, + context => C4::Context->new("$Bin/conf/koha1/koha-conf.xml"), + _dummy => "KOHA1" + }, + { + hostname => ['koha-xml.com', 'www.koha-xml.com'], + app => $app, + context => C4::Context->new(\$KOHA_CONF_XML), + _dummy => "XML" + }, +); +test_psgi + app => Koha::Handler::Plack->app_per_host(\@HOST_CONF), + client => sub { + my $cb = shift; + + foreach my $site_params ( @HOST_CONF ) { + my $valid_response = make_response( + $site_params->{_dummy} + ); + foreach (@{$site_params->{hostname}}) { + my $res = $cb->(GET "http://$_/"); + is $res->content, $valid_response, $_ + or diag(Dumper($site_params, $_, $res->as_string)); + check_context(); + } + } + + $res = $cb->(GET $generic_url); + is $res->code, 404, "app_per_host unknown host" + or diag($res->as_string); + }; + +my %MULTI_HOST_ENV = ( + opac => { + static_root => "$Bin/../koha-tmpl/opac-tmpl/bootstrap", + script_root => "$Bin/../opac", + }, + intranet => { + static_root => "$Bin/../koha-tmpl/intranet-tmpl/bootstrap", + script_root => "$Bin/.." + } +); +my @MULTI_HOST_SITES = ( + { + namespace => 'koha1', + opac_hostname => ['opac.koha1.com', 'www.opac.koha1.com'], + intranet_hostname => ['intranet.koha1.com', 'www.intranet.koha1.com'], + config => "$Bin/conf/koha1/koha-conf.xml", + }, + { + namespace => 'koha2', + opac_hostname => ['opac.koha2.com', 'www.opac.koha2.com'], + intranet_hostname => ['intranet.koha2.com', 'www.intranet.koha2.com'], + config => "$Bin/conf/koha2/koha-conf.xml", + shared_context => 1, + }, +); +test_psgi + app => Koha::Handler::Plack::CGI->multi_site(\%MULTI_HOST_ENV, \@MULTI_HOST_SITES), + client => sub { + my $cb = shift; + + foreach my $site (@MULTI_HOST_SITES) { + my $opac = $site->{opac_hostname}; + foreach my $host (@$opac) { +# this is not really a test, but cannot do any better atm +# TODO: a complex test involving two database connections + my $res = $cb->(GET "http://$host/"); + # A future implementation may not redirect + if ($res->is_redirect) { + my $loc = $res->header("Location"); + $res = $cb->(GET "http://$host$loc"); + } + is $res->code, 500, "multi_site() $host" + or diag($res->as_string); + } + } + }; diff --git a/t/conf/dummy/koha-conf.xml b/t/conf/dummy/koha-conf.xml new file mode 100644 index 0000000..d4c96b0 --- /dev/null +++ b/t/conf/dummy/koha-conf.xml @@ -0,0 +1,7 @@ + + + dummy + DUMMY + . + + diff --git a/t/conf/koha1/koha-conf.xml b/t/conf/koha1/koha-conf.xml new file mode 100644 index 0000000..371d039 --- /dev/null +++ b/t/conf/koha1/koha-conf.xml @@ -0,0 +1,7 @@ + + + koha1 + KOHA1 + . + + diff --git a/t/conf/koha2/koha-conf.xml b/t/conf/koha2/koha-conf.xml new file mode 100644 index 0000000..437e772 --- /dev/null +++ b/t/conf/koha2/koha-conf.xml @@ -0,0 +1,5 @@ + + + KOHA2 + + diff --git a/t/db_dependent/Amazon.t b/t/db_dependent/Amazon.t index 2304073..a5b316f 100755 --- a/t/db_dependent/Amazon.t +++ b/t/db_dependent/Amazon.t @@ -14,7 +14,7 @@ BEGIN { use_ok('C4::External::Amazon'); } -my $context = C4::Context->new(); +my $context = C4::Context->current(); my $locale = $context->preference('AmazonLocale'); diff --git a/t/db_dependent/Context.t b/t/db_dependent/Context.t index b5a050f..c3f6066 100755 --- a/t/db_dependent/Context.t +++ b/t/db_dependent/Context.t @@ -47,7 +47,7 @@ C4::Context->clear_syspref_cache(); C4::Context->enable_syspref_cache(); $dbh->rollback; -ok($koha = C4::Context->new, 'C4::Context->new'); +ok($koha = C4::Context->current, 'C4::Context->current'); my @keys = keys %$koha; my $width = 0; if (ok(@keys)) { diff --git a/t/db_dependent/Template/Plugin/KohaDates.t b/t/db_dependent/Template/Plugin/KohaDates.t index fe18836..2088347 100644 --- a/t/db_dependent/Template/Plugin/KohaDates.t +++ b/t/db_dependent/Template/Plugin/KohaDates.t @@ -14,7 +14,7 @@ BEGIN { my $module_context = new Test::MockModule('C4::Context'); my $date = "1973-05-21"; -my $context = C4::Context->new(); +my $context = C4::Context->current(); my $filter = Koha::Template::Plugin::KohaDates->new(); ok ($filter, "new()"); diff --git a/t/db_dependent/XISBN.t b/t/db_dependent/XISBN.t index 2f6d63b..45e01dd 100755 --- a/t/db_dependent/XISBN.t +++ b/t/db_dependent/XISBN.t @@ -26,7 +26,7 @@ my $search_module = new Test::MockModule('C4::Search'); $search_module->mock('SimpleSearch', \&Mock_SimpleSearch ); -my $context = C4::Context->new; +my $context = C4::Context->current; my ( $biblionumber_tag, $biblionumber_subfield ) = GetMarcFromKohaField( 'biblio.biblionumber', '' ); diff --git a/t/db_dependent/sysprefs.t b/t/db_dependent/sysprefs.t index 340e89a..07552f1 100755 --- a/t/db_dependent/sysprefs.t +++ b/t/db_dependent/sysprefs.t @@ -19,7 +19,7 @@ # along with Koha; if not, see . use Modern::Perl; -use Test::More tests => 8; +use Test::More tests => 11; use C4::Context; # Start transaction @@ -60,4 +60,15 @@ is(C4::Context->preference('testpreference'), 'def', 'caching preferences'); C4::Context->clear_syspref_cache(); is(C4::Context->preference('testpreference'), undef, 'clearing preference cache'); +delete $ENV{OVERRIDE_SYSPREF_opacheader}; + +my $DUMMY_KOHA_CONF = "DUMMY"; +my $context1 = C4::Context->new($DUMMY_KOHA_CONF, "context1"); +is( $context1->preference('opacheader'), $opacheader, 'context1 "opacheader"'); + +my $context2 = C4::Context->new($DUMMY_KOHA_CONF, "context2"); +$context2->set_preference( 'opacheader', $newopacheader ); +is( $context1->preference('opacheader'), $opacheader, 'context1 "opacheader"'); +is( $context2->preference('opacheader'), $newopacheader, 'context2 "opacheader"'); + $dbh->rollback; -- 2.5.0 From srdjan at catalyst.net.nz Tue Apr 26 05:55:19 2016 From: srdjan at catalyst.net.nz (Srdjan) Date: Tue, 26 Apr 2016 15:55:19 +1200 Subject: [Koha-patches] [PATCH] bug_15562: Removed Koha::Cache->get_instance() Message-ID: <1461642919-24920-1-git-send-email-srdjan@catalyst.net.nz> There should be no cache singleton, full stop. If Koha is to move away from .pl scripts that is. As an interim measure Koha::Cache->get_instance() is replaced with C4::Context->cache, in the vein of C4::Context->memcached. In that respect it will continue to work in the singleton-ish way if context is used as a singleton, but supports cache-per-context. Koha::Handler::Plack->app_per_host() cache sysprefs using Context memcached. https://bugs.koha-community.org/show_bug.cgi?id=15562 --- C4/Biblio.pm | 4 +- C4/Calendar.pm | 15 ++-- C4/Context.pm | 123 ++++++++++++++++++++------------ C4/External/OverDrive.pm | 6 +- C4/Koha.pm | 3 +- C4/Utils/DataTables/ColumnsSettings.pm | 3 +- Koha/Cache.pm | 17 ----- Koha/Calendar.pm | 5 +- Koha/Handler/Plack.pm | 41 ++++++++++- Koha/Handler/Plack/CGI.pm | 2 +- Koha/Template/Plugin/Cache.pm | 3 +- admin/biblio_framework.pl | 3 +- admin/koha2marclinks.pl | 2 +- admin/marc_subfields_structure.pl | 2 +- admin/marctagstructure.pl | 5 +- opac/svc/report | 5 +- svc/report | 4 +- t/Cache.t | 4 +- t/Calendar.t | 4 +- t/Context.t | 28 +++++++- t/Koha_Template_Plugin_Cache.t | 4 +- t/db_dependent/Context.t | 8 +-- t/db_dependent/Filter_MARC_ViewPolicy.t | 2 +- tools/newHolidays.pl | 4 +- 24 files changed, 180 insertions(+), 117 deletions(-) diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 9a7c86d..74c2198 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -37,8 +37,8 @@ use C4::ClassSource; use C4::Charset; use C4::Linker; use C4::OAI::Sets; +use C4::Context; -use Koha::Cache; use Koha::Authority::Types; use Koha::Acquisition::Currencies; @@ -1119,7 +1119,7 @@ sub GetMarcStructure { $frameworkcode = "" unless $frameworkcode; $forlibrarian = $forlibrarian ? 1 : 0; - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode"; my $cached = $cache->get_from_cache($cache_key); return $cached if $cached; diff --git a/C4/Calendar.pm b/C4/Calendar.pm index 852bdd7..5d2b753 100644 --- a/C4/Calendar.pm +++ b/C4/Calendar.pm @@ -23,7 +23,6 @@ use Carp; use Date::Calc qw( Date_to_Days Today); use C4::Context; -use Koha::Cache; use constant ISO_DATE_FORMAT => "%04d-%02d-%02d"; @@ -276,7 +275,7 @@ sub insert_single_holiday { # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; return $self; @@ -320,7 +319,7 @@ sub insert_exception_holiday { $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; return $self; @@ -420,7 +419,7 @@ UPDATE special_holidays SET title = ?, description = ? $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; return $self; @@ -462,7 +461,7 @@ UPDATE special_holidays SET title = ?, description = ? $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; return $self; @@ -542,7 +541,7 @@ sub delete_holiday { } # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; return $self; @@ -572,7 +571,7 @@ sub delete_holiday_range { $sth->execute($self->{branchcode}, $options{day}, $options{month}, $options{year}); # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; } @@ -625,7 +624,7 @@ sub delete_exception_holiday_range { $sth->execute($self->{branchcode}, $options{day}, $options{month}, $options{year}); # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; } diff --git a/C4/Context.pm b/C4/Context.pm index 63a71d6..486266d 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -18,7 +18,7 @@ package C4::Context; use strict; use warnings; -use vars qw($AUTOLOAD $context @context_stack $servers $memcached $ismemcached); +use vars qw($AUTOLOAD $context @context_stack $memcached_servers); BEGIN { if ($ENV{'HTTP_USER_AGENT'}) { require CGI::Carp; @@ -88,20 +88,9 @@ BEGIN { } # else there is no browser to send fatals to! # Check if there are memcached servers set - $servers = $ENV{'MEMCACHED_SERVERS'}; - if ($servers) { - # Load required libraries and create the memcached object - require Cache::Memcached; - $memcached = Cache::Memcached->new({ - servers => [ $servers ], - debug => 0, - compress_threshold => 10_000, - expire_time => 600, - namespace => $ENV{'MEMCACHED_NAMESPACE'} || 'koha' - }); - # Verify memcached available (set a variable and test the output) - $ismemcached = $memcached->set('ismemcached','1'); - } + $memcached_servers = $ENV{'MEMCACHED_SERVERS'}; + # Load required libraries and create the memcached object + require Cache::Memcached if $memcached_servers; } @@ -219,29 +208,57 @@ sub current { return $context; } -=head2 ismemcached +sub _new_memcached { + my $namespace = shift or die "No memcached namespace"; + + return unless $memcached_servers; + return Cache::Memcached->new({ + servers => [ $memcached_servers ], + debug => 0, + compress_threshold => 10_000, + expire_time => 600, + namespace => $namespace || $ENV{'MEMCACHED_NAMESPACE'} || 'koha' + }); +} +# Verify memcached available (test the output) +sub _ping_memcached { + my $memcached = shift or croak "No memcached"; -Returns the value of the $ismemcached variable (0/1) + return $memcached->set('ismemcached','1'); +} + +=head2 cache + +Returns the cache object or undef =cut -sub ismemcached { - return $ismemcached; +sub cache { + my $self = shift; + $self = $context unless ref ($self); + + return $self->{cache}; } =head2 memcached -If $ismemcached is true, returns the $memcache variable. -Returns undef otherwise +Returns the memcached object or undef + +=head2 ismemcached =cut sub memcached { - if ($ismemcached) { - return $memcached; - } else { - return; - } + my $self = shift; + $self = $context unless ref ($self); + + my $memcached = $self->{memcached} or return; + return _ping_memcached($memcached) ? $memcached : undef; +} + +sub ismemcached { + my $self = shift; + return $self->memcached; } sub db_driver { @@ -285,10 +302,14 @@ sub import { # default context already exists? return if $context; - if ($ismemcached) { + return if $config_file && $config_file eq ":no_config"; + + my $memcached = _new_memcached($ENV{'MEMCACHED_NAMESPACE'} || 'koha'); + if ($memcached) { # retrieve from memcached - if (my $self = $memcached->get('kohaconf')) { - $context = $self; + if ($context = $memcached->get('kohaconf')) { + $context->{memcached} = $memcached; + $context->{cache} = Koha::Cache->new({namespace => $context->{namespace}}); return; } } @@ -315,15 +336,12 @@ sub import { } # no ? so load it! - return if $config_file && $config_file eq ":no_config"; - my $new_ctx = __PACKAGE__->new($config_file); - return unless $new_ctx; - - # if successfully loaded, use it by default - $context = $new_ctx; - - if ($ismemcached) { - $memcached->set('kohaconf',$new_ctx); + $context = $pkg->_new($config_file) or return; + if ( $memcached && _ping_memcached($memcached) ) { + $memcached->set('kohaconf',$context); + # Canot serialize cache objects + $context->{memcached} = $memcached; + $context->{cache} = Koha::Cache->new({namespace => $context->{namespace}}); } } @@ -366,6 +384,21 @@ sub new { my $conf_fname = shift or croak "No conf"; my $namespace = shift; + my $self = $class->_new($conf_fname, $namespace); + + if ($memcached_servers) { + $self->{memcached} = _new_memcached($namespace); + } + $self->{cache} = Koha::Cache->new({namespace => $namespace}); + + return $self; +} + +sub _new { + my $class = shift; + my $conf_fname = shift or croak "No conf"; + my $namespace = shift; + my $self = XMLin( $conf_fname, keyattr => ['id'], @@ -378,7 +411,6 @@ sub new { $self->{config_file} = $conf_fname; $self->{namespace} = $namespace; $self->{use_syspref_cache} = 1; - $self->{syspref_cache} = Koha::Cache->new({namespace => $namespace}); $self->{"Zconn"} = undef; # Zebra Connections $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield @@ -559,7 +591,7 @@ sub preference { if defined $ENV{"OVERRIDE_SYSPREF_$var"}; my $cached_var = $self->{use_syspref_cache} - ? $self->{syspref_cache}->get_from_cache("syspref_$var") + ? $self->cache->get_from_cache("syspref_$var") : undef; return $cached_var if defined $cached_var; @@ -568,7 +600,8 @@ sub preference { my $value = $syspref ? $syspref->value() : undef; if ( $self->{use_syspref_cache} ) { - $self->{syspref_cache}->set_in_cache("syspref_$var", $value); + $self->cache->set_in_cache("syspref_$var", $value); + $self->{sysprefs}{$var} = $value if $self; } return $value; } @@ -609,8 +642,8 @@ used with Plack and other persistent environments. sub disable_syspref_cache { my ($self) = @_; $self = $context unless ref $self; - $self->{use_syspref_cache} = 0; $self->clear_syspref_cache(); + $self->{use_syspref_cache} = 0; } =head2 clear_syspref_cache @@ -627,7 +660,7 @@ sub clear_syspref_cache { my ($self) = @_; $self = $context unless ref $self; return unless $self->{use_syspref_cache}; - $self->{syspref_cache}->flush_all; + $self->cache->flush_all; } =head2 set_preference @@ -680,7 +713,7 @@ sub set_preference { } if ( $self->{use_syspref_cache} ) { - $self->{syspref_cache}->set_in_cache( "syspref_$variable", $value ); + $self->cache->set_in_cache( "syspref_$variable", $value ); } return $syspref; @@ -702,7 +735,7 @@ sub delete_preference { if ( Koha::Config::SysPrefs->find( $var )->delete ) { if ( $self->{use_syspref_cache} ) { - $self->{syspref_cache}->clear_from_cache("syspref_$var"); + $self->cache->clear_from_cache("syspref_$var"); } return 1; diff --git a/C4/External/OverDrive.pm b/C4/External/OverDrive.pm index 12135c5..0e71707 100644 --- a/C4/External/OverDrive.pm +++ b/C4/External/OverDrive.pm @@ -22,7 +22,7 @@ use warnings; use Koha; use JSON; -use Koha::Cache; +use C4::Context; use HTTP::Request; use HTTP::Request::Common; use LWP::Authen::Basic; @@ -97,9 +97,7 @@ sub GetOverDriveToken { return unless ( $key && $secret ) ; - my $cache; - - eval { $cache = Koha::Cache->get_instance() }; + my $cache = C4::Context->cache; my $token; $cache and $token = $cache->get_from_cache( "overdrive_token" ) and return $token; diff --git a/C4/Koha.pm b/C4/Koha.pm index 7fe07f1..3a67e7f 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -25,7 +25,6 @@ use strict; use C4::Context; use C4::Branch; # Can be removed? -use Koha::Cache; use Koha::DateUtils qw(dt_from_string); use Koha::Libraries; use DateTime::Format::MySQL; @@ -1017,7 +1016,7 @@ sub GetAuthorisedValues { C4::Context->userenv ? C4::Context->userenv->{"branch"} : ""; my $cache_key = "AuthorisedValues-$category-$opac-$branch_limit"; - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; my $result = $cache->get_from_cache($cache_key); return $result if $result; diff --git a/C4/Utils/DataTables/ColumnsSettings.pm b/C4/Utils/DataTables/ColumnsSettings.pm index a107886..31068b4 100644 --- a/C4/Utils/DataTables/ColumnsSettings.pm +++ b/C4/Utils/DataTables/ColumnsSettings.pm @@ -5,11 +5,10 @@ use List::Util qw( first ); use YAML; use C4::Context; use Koha::Database; -use Koha::Cache; sub get_yaml { my $yml_path = C4::Context->config('intranetdir') . '/admin/columns_settings.yml'; - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; my $yaml = $cache->get_from_cache('ColumnsSettingsYaml'); unless ($yaml) { diff --git a/Koha/Cache.pm b/Koha/Cache.pm index a403836..5c8c9e4 100644 --- a/Koha/Cache.pm +++ b/Koha/Cache.pm @@ -49,23 +49,6 @@ __PACKAGE__->mk_ro_accessors( our %L1_cache; -=head2 get_instance - - my $cache = Koha::Cache->get_instance(); - -This gets a shared instance of the cache, set up in a very default way. This is -the recommended way to fetch a cache object. If possible, it'll be -persistent across multiple instances. - -=cut - -our $singleton_cache; -sub get_instance { - my ($class) = @_; - $singleton_cache = $class->new() unless $singleton_cache; - return $singleton_cache; -} - =head2 new Create a new Koha::Cache object. This is required for all cache-related functionality. diff --git a/Koha/Calendar.pm b/Koha/Calendar.pm index 7095aca..7d15d06 100644 --- a/Koha/Calendar.pm +++ b/Koha/Calendar.pm @@ -7,7 +7,6 @@ use DateTime; use DateTime::Set; use DateTime::Duration; use C4::Context; -use Koha::Cache; use Carp; sub new { @@ -57,7 +56,7 @@ sub _init { # lists breaks persistance engines. As of 2013-12-10, the RM # is allowing this with the expectation that prior to release of # 3.16, bug 8089 will be fixed and we can switch the caching over -# to Koha::Cache. +# to external cache our $exception_holidays; @@ -92,7 +91,7 @@ sub exception_holidays { sub single_holidays { my ( $self, $date ) = @_; my $branchcode = $self->{branchcode}; - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; my $single_holidays = $cache->get_from_cache('single_holidays'); # $single_holidays looks like: diff --git a/Koha/Handler/Plack.pm b/Koha/Handler/Plack.pm index af3f6cb..bce66ac 100644 --- a/Koha/Handler/Plack.pm +++ b/Koha/Handler/Plack.pm @@ -69,6 +69,7 @@ use Plack::App::URLMap; hostname => 'koha1.com', app => $app1, context => $context1, + shared_context => 1 }, { hostname => ['koha2.com', 'www.koha2.com'], @@ -78,13 +79,16 @@ use Plack::App::URLMap; ... C is mandatory. + If C is set to true, some Context properties will be preserved across + forked processes. Useful if both OPAC and Intranet apps are served here, so no restart + is needed when Context cached properties cnamge values. Needs memcached. koha.psgi: use Plack::Builder; use Plack::App::CGIBin; - use C4::Context; + use C4::Context ":no_config"; my $opac_app = builder { enable "Plack::Middleware::Static", @@ -137,6 +141,8 @@ use Plack::App::URLMap; =cut +# We cannot store whole Context object, may contain non-serializable things +my @CONTEXT_SHARED_PROPERTIES = qw(sysprefs); sub app_per_host { my $class = shift; my $sites = shift or die "No sites spec"; @@ -148,12 +154,43 @@ sub app_per_host { my $app = $site_params->{app} or croak "No app"; my $context = $site_params->{context} or croak "No Koha Context"; + my $shared_context = $site_params->{shared_context}; + my $cache = $context->memcached; + if ($shared_context) { + if ($cache) { + foreach (@CONTEXT_SHARED_PROPERTIES) { + # Clean slate + $cache->delete($_); + } + } + else { + warn "shared_context works only with memcached"; + } + } foreach my $host (@$hosts) { $map->map("http://$host/" => sub { my $env = shift; - return $context->run_within_context(sub { $app->($env) }); + # may have stopped meanwhile or whatever + my $cache = $context->memcached; + if ($shared_context && $cache) { + foreach (@CONTEXT_SHARED_PROPERTIES) { + if (my $shared = $cache->get($_)) { + $context->{$_} = $shared; + } + } + } + + my $ret = $context->run_within_context(sub { $app->($env) }); + + if ($shared_context && $cache) { + foreach (@CONTEXT_SHARED_PROPERTIES) { + $cache->set($_, $context->{$_}); + } + } + + $ret; }); } } diff --git a/Koha/Handler/Plack/CGI.pm b/Koha/Handler/Plack/CGI.pm index 36c6907..9892562 100644 --- a/Koha/Handler/Plack/CGI.pm +++ b/Koha/Handler/Plack/CGI.pm @@ -73,7 +73,7 @@ use Plack::App::CGIBin; use parent "Koha::Handler::Plack"; -use C4::Context; +use C4::Context ":no_config"; =head1 CLASS METHODS diff --git a/Koha/Template/Plugin/Cache.pm b/Koha/Template/Plugin/Cache.pm index dbb1c82..085f977 100644 --- a/Koha/Template/Plugin/Cache.pm +++ b/Koha/Template/Plugin/Cache.pm @@ -34,8 +34,7 @@ sub new { $cache = delete $params->{cache}; } else { - require Koha::Cache; - $cache = Koha::Cache->get_instance(); + $cache = $context->cache; } my $self = bless { CACHE => $cache, diff --git a/admin/biblio_framework.pl b/admin/biblio_framework.pl index 79a0db1..79f7060 100755 --- a/admin/biblio_framework.pl +++ b/admin/biblio_framework.pl @@ -26,12 +26,11 @@ use C4::Output; use Koha::Biblios; use Koha::BiblioFramework; use Koha::BiblioFrameworks; -use Koha::Cache; my $input = new CGI; my $frameworkcode = $input->param('frameworkcode') || q||; my $op = $input->param('op') || q|list|; -my $cache = Koha::Cache->get_instance(); +my $cache = C4::Context->cache; my @messages; my ( $template, $borrowernumber, $cookie ) = get_template_and_user( diff --git a/admin/koha2marclinks.pl b/admin/koha2marclinks.pl index 9ccca37..68f1e55 100755 --- a/admin/koha2marclinks.pl +++ b/admin/koha2marclinks.pl @@ -59,7 +59,7 @@ else { } my $dbh = C4::Context->dbh; -my $cache = Koha::Cache->get_instance(); +my $cache = C4::Context->cache; ################## ADD_FORM ################################## # called by default. Used to create form to add or modify a record diff --git a/admin/marc_subfields_structure.pl b/admin/marc_subfields_structure.pl index 979d7ec..8c1c7ab8 100755 --- a/admin/marc_subfields_structure.pl +++ b/admin/marc_subfields_structure.pl @@ -77,7 +77,7 @@ my ( $template, $borrowernumber, $cookie ) = get_template_and_user( debug => 1, } ); -my $cache = Koha::Cache->get_instance(); +my $cache = C4::Context->cache; my $op = $input->param('op') || ""; $tagfield =~ s/\,//g; diff --git a/admin/marctagstructure.pl b/admin/marctagstructure.pl index 7728687..26406f4 100755 --- a/admin/marctagstructure.pl +++ b/admin/marctagstructure.pl @@ -25,9 +25,6 @@ use C4::Auth; use C4::Koha; use C4::Context; use C4::Output; -use C4::Context; - -use Koha::Cache; # retrieve parameters my $input = new CGI; @@ -46,7 +43,7 @@ my $pagesize = 20; my $script_name = "/cgi-bin/koha/admin/marctagstructure.pl"; my $dbh = C4::Context->dbh; -my $cache = Koha::Cache->get_instance(); +my $cache = C4::Context->cache; # open template my ($template, $loggedinuser, $cookie) diff --git a/opac/svc/report b/opac/svc/report index bfc84e5..98d2aeb 100755 --- a/opac/svc/report +++ b/opac/svc/report @@ -23,12 +23,11 @@ use Modern::Perl; +use C4::Context; use C4::Reports::Guided; use JSON; use CGI qw ( -utf8 ); -use Koha::Cache; - my $query = CGI->new(); my $report_id = $query->param('id'); my $report_name = $query->param('name'); @@ -41,7 +40,7 @@ die "Sorry this report is not public\n" unless $report_rec->{public}; my @sql_params = $query->param('sql_params'); -my $cache = Koha::Cache->get_instance(); +my $cache = C4::Context->cache; my $cache_active = $cache->is_cache_active; my ($cache_key, $json_text); if ($cache_active) { diff --git a/svc/report b/svc/report index da1b9b3..d380090 100755 --- a/svc/report +++ b/svc/report @@ -25,7 +25,7 @@ use C4::Reports::Guided; use JSON; use CGI qw ( -utf8 ); -use Koha::Cache; +use C4::Context; my $query = CGI->new(); @@ -48,7 +48,7 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user( } ); -my $cache = Koha::Cache->get_instance(); +my $cache = C4::Context->cache; my $cache_active = $cache->is_cache_active; my ($cache_key, $json_text); if ($cache_active) { diff --git a/t/Cache.t b/t/Cache.t index 5a5c248..fc4b495 100644 --- a/t/Cache.t +++ b/t/Cache.t @@ -31,7 +31,7 @@ SKIP: { # Set a special namespace for testing, to avoid breaking # if test is run with a different user than Apache's. $ENV{ MEMCACHED_NAMESPACE } = 'unit_tests'; - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; skip "Cache not enabled", 33 unless ( $cache->is_cache_active() && defined $cache ); @@ -213,7 +213,7 @@ SKIP: { END { SKIP: { $ENV{ MEMCACHED_NAMESPACE } = 'unit_tests'; - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; skip "Cache not enabled", 1 unless ( $cache->is_cache_active() ); is( $destructorcount, 1, 'Destructor run exactly once' ); diff --git a/t/Calendar.t b/t/Calendar.t index 37f11f4..720d5c0 100755 --- a/t/Calendar.t +++ b/t/Calendar.t @@ -22,7 +22,7 @@ use Test::MockModule; use DateTime; use DateTime::Duration; -use Koha::Cache; +use C4::Context; use Koha::DateUtils; use Module::Load::Conditional qw/check_install/; @@ -88,7 +88,7 @@ fixtures_ok [ ], ], "add fixtures"; -my $cache = Koha::Cache->get_instance(); +my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; # 'MPL' branch is arbitrary, is not used at all but is needed for initialization diff --git a/t/Context.t b/t/Context.t index e2c1825..d737509 100755 --- a/t/Context.t +++ b/t/Context.t @@ -2,7 +2,7 @@ use Modern::Perl; use DBI; -use Test::More tests => 26; +use Test::More tests => 29; use Test::MockModule; BEGIN { @@ -62,3 +62,29 @@ is(C4::Context->interface, 'opac', 'interface still opac'); #Bug 14751 is( C4::Context->interface( 'SiP' ), 'sip', 'interface SiP' ); is( C4::Context->interface( 'COMMANDLINE' ), 'commandline', 'interface commandline uc' ); + +my $DUMMY_KOHA_CONF = "TEST"; +my $ctx_a = C4::Context->new($DUMMY_KOHA_CONF, "a"); +my $ctx_b = C4::Context->new($DUMMY_KOHA_CONF, "b"); +my $cache_key = "test_C4::Context"; + +SKIP: { + skip "No cache", 3 unless $ctx_a->cache->is_cache_active && $ctx_b->cache->is_cache_active; + + # Light warm up + C4::Context->cache->set_in_cache($cache_key, 'c'); + $ctx_a->cache->set_in_cache($cache_key, 'a'); + $ctx_b->cache->set_in_cache($cache_key, 'b'); + is(C4::Context->cache->get_from_cache($cache_key), 'c', "Correct default cache value"); + is($ctx_a->cache->get_from_cache($cache_key), 'a', "Correct cache 'a' value"); + is($ctx_b->cache->get_from_cache($cache_key), 'b', "Correct cache 'b' value"); + + # A bit more extravagant + # Cannot run atm, fails due to no database in config +# $ctx_a->run_within_context( sub { +# $ctx_b->cache->set_in_cache($cache_key, 'bb'); +# C4::Context->cache->set_in_cache($cache_key, 'aa'); +# } ); +# is($ctx_a->cache->get_from_cache($cache_key), 'aa', "Correct cache 'a' value"); +# is($ctx_b->cache->get_from_cache($cache_key), 'bb', "Correct cache 'b' value"); +} diff --git a/t/Koha_Template_Plugin_Cache.t b/t/Koha_Template_Plugin_Cache.t index da20f61..15ee048 100644 --- a/t/Koha_Template_Plugin_Cache.t +++ b/t/Koha_Template_Plugin_Cache.t @@ -1,6 +1,8 @@ use Modern::Perl; use Test::More tests => 2; +use C4::Context; + use_ok('Koha::Template::Plugin::Cache'); -ok(my $cache = Koha::Template::Plugin::Cache->new()); +ok(my $cache = Koha::Template::Plugin::Cache->new(C4::Context->current)); diff --git a/t/db_dependent/Context.t b/t/db_dependent/Context.t index c3f6066..b35f83d 100755 --- a/t/db_dependent/Context.t +++ b/t/db_dependent/Context.t @@ -12,14 +12,8 @@ use Koha::Database; BEGIN { $debug = $ENV{DEBUG} || 0; - - # Note: The overall number of tests may vary by configuration. - # First we need to check your environmental variables - for (qw(KOHA_CONF PERL5LIB)) { - ok( $ret = $ENV{$_}, "ENV{$_} = $ret" ); - } - use_ok('C4::Context'); } +use_ok('C4::Context'); ok($dbh = C4::Context->dbh(), 'Getting dbh from C4::Context'); diff --git a/t/db_dependent/Filter_MARC_ViewPolicy.t b/t/db_dependent/Filter_MARC_ViewPolicy.t index ba446bc..a0123ec 100644 --- a/t/db_dependent/Filter_MARC_ViewPolicy.t +++ b/t/db_dependent/Filter_MARC_ViewPolicy.t @@ -71,7 +71,7 @@ sub run_hiding_tests { $sth->execute($hidden_value); - my $cache = Koha::Cache->get_instance(); + my $cache = Koha::Cache->new(); $cache->flush_all(); # easy way to ensure DB is queried again. my $processor = Koha::RecordProcessor->new( diff --git a/tools/newHolidays.pl b/tools/newHolidays.pl index eda4c1b..38f290c 100755 --- a/tools/newHolidays.pl +++ b/tools/newHolidays.pl @@ -10,7 +10,7 @@ use CGI qw ( -utf8 ); use C4::Auth; use C4::Output; -use Koha::Cache; +use C4::Context; use C4::Calendar; use DateTime; @@ -129,6 +129,6 @@ sub add_holiday { } } # we updated the single_holidays table, so wipe its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; } -- 2.5.0 From srdjan at catalyst.net.nz Thu Apr 28 04:52:43 2016 From: srdjan at catalyst.net.nz (Srdjan) Date: Thu, 28 Apr 2016 14:52:43 +1200 Subject: [Koha-patches] [PATCH] bug_15562: Removed Koha::Cache->get_instance() Message-ID: <1461811963-25060-1-git-send-email-srdjan@catalyst.net.nz> There should be no cache singleton, full stop. If Koha is to move away from .pl scripts that is. As an interim measure Koha::Cache->get_instance() is replaced with C4::Context->cache, in the vein of C4::Context->memcached. In that respect it will continue to work in the singleton-ish way if context is used as a singleton, but supports cache-per-context. Koha::Handler::Plack->app_per_host() cache sysprefs using Context memcached. https://bugs.koha-community.org/show_bug.cgi?id=15562 --- C4/Biblio.pm | 4 +- C4/Calendar.pm | 15 ++-- C4/Context.pm | 123 ++++++++++++++++++++------------ C4/External/OverDrive.pm | 6 +- C4/Koha.pm | 3 +- C4/Utils/DataTables/ColumnsSettings.pm | 3 +- Koha/Cache.pm | 17 ----- Koha/Calendar.pm | 5 +- Koha/Handler/Plack.pm | 41 ++++++++++- Koha/Handler/Plack/CGI.pm | 2 +- Koha/Template/Plugin/Cache.pm | 3 +- admin/biblio_framework.pl | 3 +- admin/koha2marclinks.pl | 2 +- admin/marc_subfields_structure.pl | 2 +- admin/marctagstructure.pl | 5 +- opac/svc/report | 5 +- svc/report | 4 +- t/Cache.t | 4 +- t/Calendar.t | 4 +- t/Context.t | 28 +++++++- t/Koha_Template_Plugin_Cache.t | 4 +- t/db_dependent/Context.t | 8 +-- t/db_dependent/Filter_MARC_ViewPolicy.t | 2 +- tools/newHolidays.pl | 4 +- 24 files changed, 180 insertions(+), 117 deletions(-) diff --git a/C4/Biblio.pm b/C4/Biblio.pm index a59b1b7..9d6eabf 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -38,8 +38,8 @@ use C4::Charset; use C4::Linker; use C4::OAI::Sets; use C4::Debug; +use C4::Context; -use Koha::Cache; use Koha::Authority::Types; use Koha::Acquisition::Currencies; use Koha::SearchEngine; @@ -1122,7 +1122,7 @@ sub GetMarcStructure { $frameworkcode = "" unless $frameworkcode; $forlibrarian = $forlibrarian ? 1 : 0; - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode"; my $cached = $cache->get_from_cache($cache_key); return $cached if $cached; diff --git a/C4/Calendar.pm b/C4/Calendar.pm index 852bdd7..5d2b753 100644 --- a/C4/Calendar.pm +++ b/C4/Calendar.pm @@ -23,7 +23,6 @@ use Carp; use Date::Calc qw( Date_to_Days Today); use C4::Context; -use Koha::Cache; use constant ISO_DATE_FORMAT => "%04d-%02d-%02d"; @@ -276,7 +275,7 @@ sub insert_single_holiday { # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; return $self; @@ -320,7 +319,7 @@ sub insert_exception_holiday { $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; return $self; @@ -420,7 +419,7 @@ UPDATE special_holidays SET title = ?, description = ? $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; return $self; @@ -462,7 +461,7 @@ UPDATE special_holidays SET title = ?, description = ? $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description}; # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; return $self; @@ -542,7 +541,7 @@ sub delete_holiday { } # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; return $self; @@ -572,7 +571,7 @@ sub delete_holiday_range { $sth->execute($self->{branchcode}, $options{day}, $options{month}, $options{year}); # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; } @@ -625,7 +624,7 @@ sub delete_exception_holiday_range { $sth->execute($self->{branchcode}, $options{day}, $options{month}, $options{year}); # changed the 'single_holidays' table, lets force/reset its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; } diff --git a/C4/Context.pm b/C4/Context.pm index 63a71d6..51e370f 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -18,7 +18,7 @@ package C4::Context; use strict; use warnings; -use vars qw($AUTOLOAD $context @context_stack $servers $memcached $ismemcached); +use vars qw($AUTOLOAD $context @context_stack $memcached_servers); BEGIN { if ($ENV{'HTTP_USER_AGENT'}) { require CGI::Carp; @@ -88,20 +88,9 @@ BEGIN { } # else there is no browser to send fatals to! # Check if there are memcached servers set - $servers = $ENV{'MEMCACHED_SERVERS'}; - if ($servers) { - # Load required libraries and create the memcached object - require Cache::Memcached; - $memcached = Cache::Memcached->new({ - servers => [ $servers ], - debug => 0, - compress_threshold => 10_000, - expire_time => 600, - namespace => $ENV{'MEMCACHED_NAMESPACE'} || 'koha' - }); - # Verify memcached available (set a variable and test the output) - $ismemcached = $memcached->set('ismemcached','1'); - } + $memcached_servers = $ENV{'MEMCACHED_SERVERS'}; + # Load required libraries and create the memcached object + require Cache::Memcached if $memcached_servers; } @@ -219,29 +208,57 @@ sub current { return $context; } -=head2 ismemcached +sub _new_memcached { + my $namespace = shift or die "No memcached namespace"; + + return unless $memcached_servers; + return Cache::Memcached->new({ + servers => [ $memcached_servers ], + debug => 0, + compress_threshold => 10_000, + expire_time => 600, + namespace => $namespace || $ENV{'MEMCACHED_NAMESPACE'} || 'koha' + }); +} +# Verify memcached available (test the output) +sub _ping_memcached { + my $memcached = shift or croak "No memcached"; -Returns the value of the $ismemcached variable (0/1) + return $memcached->set('ismemcached','1'); +} + +=head2 cache + +Returns the cache object or undef =cut -sub ismemcached { - return $ismemcached; +sub cache { + my $self = shift; + $self = $context unless ref ($self); + + return $self->{cache}; } =head2 memcached -If $ismemcached is true, returns the $memcache variable. -Returns undef otherwise +Returns the memcached object or undef + +=head2 ismemcached =cut sub memcached { - if ($ismemcached) { - return $memcached; - } else { - return; - } + my $self = shift; + $self = $context unless ref ($self); + + my $memcached = $self->{memcached} or return; + return _ping_memcached($memcached) ? $memcached : undef; +} + +sub ismemcached { + my $self = shift; + return $self->memcached; } sub db_driver { @@ -285,10 +302,14 @@ sub import { # default context already exists? return if $context; - if ($ismemcached) { + return if $config_file && $config_file eq ":no_config"; + + my $memcached = _new_memcached($ENV{'MEMCACHED_NAMESPACE'} || 'koha'); + if ($memcached) { # retrieve from memcached - if (my $self = $memcached->get('kohaconf')) { - $context = $self; + if ($context = $memcached->get('kohaconf')) { + $context->{memcached} = $memcached; + $context->{cache} = Koha::Cache->new({namespace => $context->{namespace}}); return; } } @@ -315,16 +336,13 @@ sub import { } # no ? so load it! - return if $config_file && $config_file eq ":no_config"; - my $new_ctx = __PACKAGE__->new($config_file); - return unless $new_ctx; - - # if successfully loaded, use it by default - $context = $new_ctx; - - if ($ismemcached) { - $memcached->set('kohaconf',$new_ctx); + $context = $pkg->_new($config_file) or return; + if ( $memcached && _ping_memcached($memcached) ) { + $memcached->set('kohaconf',$context); + # Canot serialize cache objects + $context->{memcached} = $memcached; } + $context->{cache} = Koha::Cache->new({namespace => $context->{namespace}}); } use Scalar::Util qw(openhandle); @@ -366,6 +384,21 @@ sub new { my $conf_fname = shift or croak "No conf"; my $namespace = shift; + my $self = $class->_new($conf_fname, $namespace); + + if ($memcached_servers) { + $self->{memcached} = _new_memcached($namespace); + } + $self->{cache} = Koha::Cache->new({namespace => $namespace}); + + return $self; +} + +sub _new { + my $class = shift; + my $conf_fname = shift or croak "No conf"; + my $namespace = shift; + my $self = XMLin( $conf_fname, keyattr => ['id'], @@ -378,7 +411,6 @@ sub new { $self->{config_file} = $conf_fname; $self->{namespace} = $namespace; $self->{use_syspref_cache} = 1; - $self->{syspref_cache} = Koha::Cache->new({namespace => $namespace}); $self->{"Zconn"} = undef; # Zebra Connections $self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield @@ -559,7 +591,7 @@ sub preference { if defined $ENV{"OVERRIDE_SYSPREF_$var"}; my $cached_var = $self->{use_syspref_cache} - ? $self->{syspref_cache}->get_from_cache("syspref_$var") + ? $self->cache->get_from_cache("syspref_$var") : undef; return $cached_var if defined $cached_var; @@ -568,7 +600,8 @@ sub preference { my $value = $syspref ? $syspref->value() : undef; if ( $self->{use_syspref_cache} ) { - $self->{syspref_cache}->set_in_cache("syspref_$var", $value); + $self->cache->set_in_cache("syspref_$var", $value); + $self->{sysprefs}{$var} = $value if $self; } return $value; } @@ -609,8 +642,8 @@ used with Plack and other persistent environments. sub disable_syspref_cache { my ($self) = @_; $self = $context unless ref $self; - $self->{use_syspref_cache} = 0; $self->clear_syspref_cache(); + $self->{use_syspref_cache} = 0; } =head2 clear_syspref_cache @@ -627,7 +660,7 @@ sub clear_syspref_cache { my ($self) = @_; $self = $context unless ref $self; return unless $self->{use_syspref_cache}; - $self->{syspref_cache}->flush_all; + $self->cache->flush_all; } =head2 set_preference @@ -680,7 +713,7 @@ sub set_preference { } if ( $self->{use_syspref_cache} ) { - $self->{syspref_cache}->set_in_cache( "syspref_$variable", $value ); + $self->cache->set_in_cache( "syspref_$variable", $value ); } return $syspref; @@ -702,7 +735,7 @@ sub delete_preference { if ( Koha::Config::SysPrefs->find( $var )->delete ) { if ( $self->{use_syspref_cache} ) { - $self->{syspref_cache}->clear_from_cache("syspref_$var"); + $self->cache->clear_from_cache("syspref_$var"); } return 1; diff --git a/C4/External/OverDrive.pm b/C4/External/OverDrive.pm index 12135c5..0e71707 100644 --- a/C4/External/OverDrive.pm +++ b/C4/External/OverDrive.pm @@ -22,7 +22,7 @@ use warnings; use Koha; use JSON; -use Koha::Cache; +use C4::Context; use HTTP::Request; use HTTP::Request::Common; use LWP::Authen::Basic; @@ -97,9 +97,7 @@ sub GetOverDriveToken { return unless ( $key && $secret ) ; - my $cache; - - eval { $cache = Koha::Cache->get_instance() }; + my $cache = C4::Context->cache; my $token; $cache and $token = $cache->get_from_cache( "overdrive_token" ) and return $token; diff --git a/C4/Koha.pm b/C4/Koha.pm index 7fe07f1..3a67e7f 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -25,7 +25,6 @@ use strict; use C4::Context; use C4::Branch; # Can be removed? -use Koha::Cache; use Koha::DateUtils qw(dt_from_string); use Koha::Libraries; use DateTime::Format::MySQL; @@ -1017,7 +1016,7 @@ sub GetAuthorisedValues { C4::Context->userenv ? C4::Context->userenv->{"branch"} : ""; my $cache_key = "AuthorisedValues-$category-$opac-$branch_limit"; - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; my $result = $cache->get_from_cache($cache_key); return $result if $result; diff --git a/C4/Utils/DataTables/ColumnsSettings.pm b/C4/Utils/DataTables/ColumnsSettings.pm index a107886..31068b4 100644 --- a/C4/Utils/DataTables/ColumnsSettings.pm +++ b/C4/Utils/DataTables/ColumnsSettings.pm @@ -5,11 +5,10 @@ use List::Util qw( first ); use YAML; use C4::Context; use Koha::Database; -use Koha::Cache; sub get_yaml { my $yml_path = C4::Context->config('intranetdir') . '/admin/columns_settings.yml'; - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; my $yaml = $cache->get_from_cache('ColumnsSettingsYaml'); unless ($yaml) { diff --git a/Koha/Cache.pm b/Koha/Cache.pm index a403836..5c8c9e4 100644 --- a/Koha/Cache.pm +++ b/Koha/Cache.pm @@ -49,23 +49,6 @@ __PACKAGE__->mk_ro_accessors( our %L1_cache; -=head2 get_instance - - my $cache = Koha::Cache->get_instance(); - -This gets a shared instance of the cache, set up in a very default way. This is -the recommended way to fetch a cache object. If possible, it'll be -persistent across multiple instances. - -=cut - -our $singleton_cache; -sub get_instance { - my ($class) = @_; - $singleton_cache = $class->new() unless $singleton_cache; - return $singleton_cache; -} - =head2 new Create a new Koha::Cache object. This is required for all cache-related functionality. diff --git a/Koha/Calendar.pm b/Koha/Calendar.pm index 7095aca..7d15d06 100644 --- a/Koha/Calendar.pm +++ b/Koha/Calendar.pm @@ -7,7 +7,6 @@ use DateTime; use DateTime::Set; use DateTime::Duration; use C4::Context; -use Koha::Cache; use Carp; sub new { @@ -57,7 +56,7 @@ sub _init { # lists breaks persistance engines. As of 2013-12-10, the RM # is allowing this with the expectation that prior to release of # 3.16, bug 8089 will be fixed and we can switch the caching over -# to Koha::Cache. +# to external cache our $exception_holidays; @@ -92,7 +91,7 @@ sub exception_holidays { sub single_holidays { my ( $self, $date ) = @_; my $branchcode = $self->{branchcode}; - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; my $single_holidays = $cache->get_from_cache('single_holidays'); # $single_holidays looks like: diff --git a/Koha/Handler/Plack.pm b/Koha/Handler/Plack.pm index af3f6cb..bce66ac 100644 --- a/Koha/Handler/Plack.pm +++ b/Koha/Handler/Plack.pm @@ -69,6 +69,7 @@ use Plack::App::URLMap; hostname => 'koha1.com', app => $app1, context => $context1, + shared_context => 1 }, { hostname => ['koha2.com', 'www.koha2.com'], @@ -78,13 +79,16 @@ use Plack::App::URLMap; ... C is mandatory. + If C is set to true, some Context properties will be preserved across + forked processes. Useful if both OPAC and Intranet apps are served here, so no restart + is needed when Context cached properties cnamge values. Needs memcached. koha.psgi: use Plack::Builder; use Plack::App::CGIBin; - use C4::Context; + use C4::Context ":no_config"; my $opac_app = builder { enable "Plack::Middleware::Static", @@ -137,6 +141,8 @@ use Plack::App::URLMap; =cut +# We cannot store whole Context object, may contain non-serializable things +my @CONTEXT_SHARED_PROPERTIES = qw(sysprefs); sub app_per_host { my $class = shift; my $sites = shift or die "No sites spec"; @@ -148,12 +154,43 @@ sub app_per_host { my $app = $site_params->{app} or croak "No app"; my $context = $site_params->{context} or croak "No Koha Context"; + my $shared_context = $site_params->{shared_context}; + my $cache = $context->memcached; + if ($shared_context) { + if ($cache) { + foreach (@CONTEXT_SHARED_PROPERTIES) { + # Clean slate + $cache->delete($_); + } + } + else { + warn "shared_context works only with memcached"; + } + } foreach my $host (@$hosts) { $map->map("http://$host/" => sub { my $env = shift; - return $context->run_within_context(sub { $app->($env) }); + # may have stopped meanwhile or whatever + my $cache = $context->memcached; + if ($shared_context && $cache) { + foreach (@CONTEXT_SHARED_PROPERTIES) { + if (my $shared = $cache->get($_)) { + $context->{$_} = $shared; + } + } + } + + my $ret = $context->run_within_context(sub { $app->($env) }); + + if ($shared_context && $cache) { + foreach (@CONTEXT_SHARED_PROPERTIES) { + $cache->set($_, $context->{$_}); + } + } + + $ret; }); } } diff --git a/Koha/Handler/Plack/CGI.pm b/Koha/Handler/Plack/CGI.pm index 36c6907..9892562 100644 --- a/Koha/Handler/Plack/CGI.pm +++ b/Koha/Handler/Plack/CGI.pm @@ -73,7 +73,7 @@ use Plack::App::CGIBin; use parent "Koha::Handler::Plack"; -use C4::Context; +use C4::Context ":no_config"; =head1 CLASS METHODS diff --git a/Koha/Template/Plugin/Cache.pm b/Koha/Template/Plugin/Cache.pm index dbb1c82..085f977 100644 --- a/Koha/Template/Plugin/Cache.pm +++ b/Koha/Template/Plugin/Cache.pm @@ -34,8 +34,7 @@ sub new { $cache = delete $params->{cache}; } else { - require Koha::Cache; - $cache = Koha::Cache->get_instance(); + $cache = $context->cache; } my $self = bless { CACHE => $cache, diff --git a/admin/biblio_framework.pl b/admin/biblio_framework.pl index 79a0db1..79f7060 100755 --- a/admin/biblio_framework.pl +++ b/admin/biblio_framework.pl @@ -26,12 +26,11 @@ use C4::Output; use Koha::Biblios; use Koha::BiblioFramework; use Koha::BiblioFrameworks; -use Koha::Cache; my $input = new CGI; my $frameworkcode = $input->param('frameworkcode') || q||; my $op = $input->param('op') || q|list|; -my $cache = Koha::Cache->get_instance(); +my $cache = C4::Context->cache; my @messages; my ( $template, $borrowernumber, $cookie ) = get_template_and_user( diff --git a/admin/koha2marclinks.pl b/admin/koha2marclinks.pl index 9ccca37..68f1e55 100755 --- a/admin/koha2marclinks.pl +++ b/admin/koha2marclinks.pl @@ -59,7 +59,7 @@ else { } my $dbh = C4::Context->dbh; -my $cache = Koha::Cache->get_instance(); +my $cache = C4::Context->cache; ################## ADD_FORM ################################## # called by default. Used to create form to add or modify a record diff --git a/admin/marc_subfields_structure.pl b/admin/marc_subfields_structure.pl index 22d4398..46b749c 100755 --- a/admin/marc_subfields_structure.pl +++ b/admin/marc_subfields_structure.pl @@ -77,7 +77,7 @@ my ( $template, $borrowernumber, $cookie ) = get_template_and_user( debug => 1, } ); -my $cache = Koha::Cache->get_instance(); +my $cache = C4::Context->cache; my $op = $input->param('op') || ""; $tagfield =~ s/\,//g; diff --git a/admin/marctagstructure.pl b/admin/marctagstructure.pl index 7728687..26406f4 100755 --- a/admin/marctagstructure.pl +++ b/admin/marctagstructure.pl @@ -25,9 +25,6 @@ use C4::Auth; use C4::Koha; use C4::Context; use C4::Output; -use C4::Context; - -use Koha::Cache; # retrieve parameters my $input = new CGI; @@ -46,7 +43,7 @@ my $pagesize = 20; my $script_name = "/cgi-bin/koha/admin/marctagstructure.pl"; my $dbh = C4::Context->dbh; -my $cache = Koha::Cache->get_instance(); +my $cache = C4::Context->cache; # open template my ($template, $loggedinuser, $cookie) diff --git a/opac/svc/report b/opac/svc/report index bfc84e5..98d2aeb 100755 --- a/opac/svc/report +++ b/opac/svc/report @@ -23,12 +23,11 @@ use Modern::Perl; +use C4::Context; use C4::Reports::Guided; use JSON; use CGI qw ( -utf8 ); -use Koha::Cache; - my $query = CGI->new(); my $report_id = $query->param('id'); my $report_name = $query->param('name'); @@ -41,7 +40,7 @@ die "Sorry this report is not public\n" unless $report_rec->{public}; my @sql_params = $query->param('sql_params'); -my $cache = Koha::Cache->get_instance(); +my $cache = C4::Context->cache; my $cache_active = $cache->is_cache_active; my ($cache_key, $json_text); if ($cache_active) { diff --git a/svc/report b/svc/report index da1b9b3..d380090 100755 --- a/svc/report +++ b/svc/report @@ -25,7 +25,7 @@ use C4::Reports::Guided; use JSON; use CGI qw ( -utf8 ); -use Koha::Cache; +use C4::Context; my $query = CGI->new(); @@ -48,7 +48,7 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user( } ); -my $cache = Koha::Cache->get_instance(); +my $cache = C4::Context->cache; my $cache_active = $cache->is_cache_active; my ($cache_key, $json_text); if ($cache_active) { diff --git a/t/Cache.t b/t/Cache.t index 5a5c248..fc4b495 100644 --- a/t/Cache.t +++ b/t/Cache.t @@ -31,7 +31,7 @@ SKIP: { # Set a special namespace for testing, to avoid breaking # if test is run with a different user than Apache's. $ENV{ MEMCACHED_NAMESPACE } = 'unit_tests'; - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; skip "Cache not enabled", 33 unless ( $cache->is_cache_active() && defined $cache ); @@ -213,7 +213,7 @@ SKIP: { END { SKIP: { $ENV{ MEMCACHED_NAMESPACE } = 'unit_tests'; - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; skip "Cache not enabled", 1 unless ( $cache->is_cache_active() ); is( $destructorcount, 1, 'Destructor run exactly once' ); diff --git a/t/Calendar.t b/t/Calendar.t index 37f11f4..720d5c0 100755 --- a/t/Calendar.t +++ b/t/Calendar.t @@ -22,7 +22,7 @@ use Test::MockModule; use DateTime; use DateTime::Duration; -use Koha::Cache; +use C4::Context; use Koha::DateUtils; use Module::Load::Conditional qw/check_install/; @@ -88,7 +88,7 @@ fixtures_ok [ ], ], "add fixtures"; -my $cache = Koha::Cache->get_instance(); +my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; # 'MPL' branch is arbitrary, is not used at all but is needed for initialization diff --git a/t/Context.t b/t/Context.t index e2c1825..d737509 100755 --- a/t/Context.t +++ b/t/Context.t @@ -2,7 +2,7 @@ use Modern::Perl; use DBI; -use Test::More tests => 26; +use Test::More tests => 29; use Test::MockModule; BEGIN { @@ -62,3 +62,29 @@ is(C4::Context->interface, 'opac', 'interface still opac'); #Bug 14751 is( C4::Context->interface( 'SiP' ), 'sip', 'interface SiP' ); is( C4::Context->interface( 'COMMANDLINE' ), 'commandline', 'interface commandline uc' ); + +my $DUMMY_KOHA_CONF = "TEST"; +my $ctx_a = C4::Context->new($DUMMY_KOHA_CONF, "a"); +my $ctx_b = C4::Context->new($DUMMY_KOHA_CONF, "b"); +my $cache_key = "test_C4::Context"; + +SKIP: { + skip "No cache", 3 unless $ctx_a->cache->is_cache_active && $ctx_b->cache->is_cache_active; + + # Light warm up + C4::Context->cache->set_in_cache($cache_key, 'c'); + $ctx_a->cache->set_in_cache($cache_key, 'a'); + $ctx_b->cache->set_in_cache($cache_key, 'b'); + is(C4::Context->cache->get_from_cache($cache_key), 'c', "Correct default cache value"); + is($ctx_a->cache->get_from_cache($cache_key), 'a', "Correct cache 'a' value"); + is($ctx_b->cache->get_from_cache($cache_key), 'b', "Correct cache 'b' value"); + + # A bit more extravagant + # Cannot run atm, fails due to no database in config +# $ctx_a->run_within_context( sub { +# $ctx_b->cache->set_in_cache($cache_key, 'bb'); +# C4::Context->cache->set_in_cache($cache_key, 'aa'); +# } ); +# is($ctx_a->cache->get_from_cache($cache_key), 'aa', "Correct cache 'a' value"); +# is($ctx_b->cache->get_from_cache($cache_key), 'bb', "Correct cache 'b' value"); +} diff --git a/t/Koha_Template_Plugin_Cache.t b/t/Koha_Template_Plugin_Cache.t index da20f61..15ee048 100644 --- a/t/Koha_Template_Plugin_Cache.t +++ b/t/Koha_Template_Plugin_Cache.t @@ -1,6 +1,8 @@ use Modern::Perl; use Test::More tests => 2; +use C4::Context; + use_ok('Koha::Template::Plugin::Cache'); -ok(my $cache = Koha::Template::Plugin::Cache->new()); +ok(my $cache = Koha::Template::Plugin::Cache->new(C4::Context->current)); diff --git a/t/db_dependent/Context.t b/t/db_dependent/Context.t index c3f6066..b35f83d 100755 --- a/t/db_dependent/Context.t +++ b/t/db_dependent/Context.t @@ -12,14 +12,8 @@ use Koha::Database; BEGIN { $debug = $ENV{DEBUG} || 0; - - # Note: The overall number of tests may vary by configuration. - # First we need to check your environmental variables - for (qw(KOHA_CONF PERL5LIB)) { - ok( $ret = $ENV{$_}, "ENV{$_} = $ret" ); - } - use_ok('C4::Context'); } +use_ok('C4::Context'); ok($dbh = C4::Context->dbh(), 'Getting dbh from C4::Context'); diff --git a/t/db_dependent/Filter_MARC_ViewPolicy.t b/t/db_dependent/Filter_MARC_ViewPolicy.t index ba446bc..a0123ec 100644 --- a/t/db_dependent/Filter_MARC_ViewPolicy.t +++ b/t/db_dependent/Filter_MARC_ViewPolicy.t @@ -71,7 +71,7 @@ sub run_hiding_tests { $sth->execute($hidden_value); - my $cache = Koha::Cache->get_instance(); + my $cache = Koha::Cache->new(); $cache->flush_all(); # easy way to ensure DB is queried again. my $processor = Koha::RecordProcessor->new( diff --git a/tools/newHolidays.pl b/tools/newHolidays.pl index eda4c1b..38f290c 100755 --- a/tools/newHolidays.pl +++ b/tools/newHolidays.pl @@ -10,7 +10,7 @@ use CGI qw ( -utf8 ); use C4::Auth; use C4::Output; -use Koha::Cache; +use C4::Context; use C4::Calendar; use DateTime; @@ -129,6 +129,6 @@ sub add_holiday { } } # we updated the single_holidays table, so wipe its cache - my $cache = Koha::Cache->get_instance(); + my $cache = C4::Context->cache; $cache->clear_from_cache( 'single_holidays') ; } -- 2.7.4
Apache $versions{apacheVersion}