Attachment #51940 for bug #15562

View | Details | Raw Unified | Return to bug 15562
Collapse All | Expand All




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;

    $frameworkcode = "" unless $frameworkcode;

    $forlibrarian = $forlibrarian ? 1 : 0;
    my $cache = C4::Context->cache;
    my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
    my $cached = $cache->get_from_cache($cache_key);
    return $cached if $cached;




use Date::Calc qw( Date_to_Days Today);

use C4::Context;
use Koha::Cache;

use constant ISO_DATE_FORMAT => "%04d-%02d-%02d";




    # changed the 'single_holidays' table, lets force/reset its cache
    my $cache = C4::Context->cache;
    $cache->clear_from_cache( 'single_holidays') ;
    $cache->clear_from_cache( 'exception_holidays') ;


    $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};

    # changed the 'single_holidays' table, lets force/reset its cache
    my $cache = C4::Context->cache;
    $cache->clear_from_cache( 'single_holidays') ;
    $cache->clear_from_cache( 'exception_holidays') ;


    $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};

    # changed the 'single_holidays' table, lets force/reset its cache
    my $cache = C4::Context->cache;
    $cache->clear_from_cache( 'single_holidays') ;
    $cache->clear_from_cache( 'exception_holidays') ;


    $self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};

    # changed the 'single_holidays' table, lets force/reset its cache
    my $cache = C4::Context->cache;
    $cache->clear_from_cache( 'single_holidays') ;
    $cache->clear_from_cache( 'exception_holidays') ;


    }

    # changed the 'single_holidays' table, lets force/reset its cache
    my $cache = C4::Context->cache;
    $cache->clear_from_cache( 'single_holidays') ;
    $cache->clear_from_cache( 'exception_holidays') ;


    $sth->execute($self->{branchcode}, $options{day}, $options{month}, $options{year});

    # changed the 'single_holidays' table, lets force/reset its cache
    my $cache = C4::Context->cache;
    $cache->clear_from_cache( 'single_holidays') ;
    $cache->clear_from_cache( 'exception_holidays') ;


    $sth->execute($self->{branchcode}, $options{day}, $options{month}, $options{year});

    # changed the 'single_holidays' table, lets force/reset its cache
    my $cache = C4::Context->cache;
    $cache->clear_from_cache( 'single_holidays') ;
    $cache->clear_from_cache( 'exception_holidays') ;
}





use strict;
use warnings;
use vars qw($AUTOLOAD $context @context_stack $memcached_servers);
BEGIN {
	if ($ENV{'HTTP_USER_AGENT'})	{
		require CGI::Carp;

    }  	# else there is no browser to send fatals to!

    # Check if there are memcached servers set
    $memcached_servers = $ENV{'MEMCACHED_SERVERS'};
    # Load required libraries and create the memcached object
    require Cache::Memcached if $memcached_servers;
        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');
    }

}


    return $context;
}

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";

    return $memcached->set('ismemcached','1');
}

=head2 cache

Returns the cache object or undef

=cut

sub cache {
    my $self = shift;
    $self = $context unless ref ($self);

    return $self->{cache};
}

=head2 memcached

Returns the memcached object or undef

=head2 ismemcached

=cut

sub memcached {
    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 {

    # default context already exists?
    return if $context;

    return if $config_file && $config_file eq ":no_config";

    my $memcached = _new_memcached($ENV{'MEMCACHED_NAMESPACE'} || 'koha');
    if ($memcached) {
        # retrieve from memcached
        if ($context = $memcached->get('kohaconf')) {
            $context->{memcached} = $memcached;
            $context->{cache} = Koha::Cache->new({namespace => $context->{namespace}});
            return;
        }
    }

    }

    # no ? so load it!
    $context = $pkg->_new($config_file) or return;
    if ( $memcached && _ping_memcached($memcached) ) {
        $memcached->set('kohaconf',$context);
        # Canot serialize cache objects
        $context->{memcached} = $memcached;
    $context = $new_ctx;

    if ($ismemcached) {
      $memcached->set('kohaconf',$new_ctx);
    }
    $context->{cache} = Koha::Cache->new({namespace => $context->{namespace}});
}

use Scalar::Util qw(openhandle);

    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'],

    $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

        if defined $ENV{"OVERRIDE_SYSPREF_$var"};

    my $cached_var = $self->{use_syspref_cache}
        ? $self->cache->get_from_cache("syspref_$var")
        : undef;
    return $cached_var if defined $cached_var;


    my $value = $syspref ? $syspref->value() : undef;

    if ( $self->{use_syspref_cache} ) {
        $self->cache->set_in_cache("syspref_$var", $value);
        $self->{sysprefs}{$var} = $value if $self;
    }
    return $value;
}

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

    my ($self) = @_;
    $self = $context unless ref $self;
    return unless $self->{use_syspref_cache};
    $self->cache->flush_all;
}

=head2 set_preference

    }

    if ( $self->{use_syspref_cache} ) {
        $self->cache->set_in_cache( "syspref_$variable", $value );
    }

    return $syspref;


    if ( Koha::Config::SysPrefs->find( $var )->delete ) {
        if ( $self->{use_syspref_cache} ) {
            $self->cache->clear_from_cache("syspref_$var");
        }

        return 1;





use Koha;
use JSON;
use C4::Context;
use HTTP::Request;
use HTTP::Request::Common;
use LWP::Authen::Basic;


    return unless ( $key && $secret ) ;

    my $cache = C4::Context->cache;

    eval { $cache = Koha::Cache->get_instance() };

    my $token;
    $cache and $token = $cache->get_from_cache( "overdrive_token" ) and return $token;

Lines 25-31 use strict; Link Here

(-)a/C4/Koha.pm (-2 / +1 lines)
25		25
26	use C4::Context;	26	use C4::Context;
27	use C4::Branch; # Can be removed?	27	use C4::Branch; # Can be removed?
28	use Koha::Cache;
29	use Koha::DateUtils qw(dt_from_string);	28	use Koha::DateUtils qw(dt_from_string);
30	use Koha::Libraries;	29	use Koha::Libraries;
31	use DateTime::Format::MySQL;	30	use DateTime::Format::MySQL;
Lines 1017-1023 sub GetAuthorisedValues { Link Here
1017	C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";	1016	C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
1018	my $cache_key =	1017	my $cache_key =
1019	"AuthorisedValues-$category-$opac-$branch_limit";	1018	"AuthorisedValues-$category-$opac-$branch_limit";
1020	my $cache = Koha::Cache->get_instance();	1019	my $cache = C4::Context->cache;
1021	my $result = $cache->get_from_cache($cache_key);	1020	my $result = $cache->get_from_cache($cache_key);
1022	return $result if $result;	1021	return $result if $result;
1023		1022

Lines 5-15 use List::Util qw( first ); Link Here

(-)a/C4/Utils/DataTables/ColumnsSettings.pm (-2 / +1 lines)
5	use YAML;	5	use YAML;
6	use C4::Context;	6	use C4::Context;
7	use Koha::Database;	7	use Koha::Database;
8	use Koha::Cache;
9		8
10	sub get_yaml {	9	sub get_yaml {
11	my $yml_path = C4::Context->config('intranetdir') . '/admin/columns_settings.yml';	10	my $yml_path = C4::Context->config('intranetdir') . '/admin/columns_settings.yml';
12	my $cache = Koha::Cache->get_instance();	11	my $cache = C4::Context->cache;
13	my $yaml = $cache->get_from_cache('ColumnsSettingsYaml');	12	my $yaml = $cache->get_from_cache('ColumnsSettingsYaml');
14		13
15	unless ($yaml) {	14	unless ($yaml) {





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.




use DateTime::Set;
use DateTime::Duration;
use C4::Context;
use Koha::Cache;
use Carp;

sub new {

sub exception_holidays {
    my ( $self ) = @_;

    my $cache  = C4::Context->cache;
    my $cached = $cache->get_from_cache('exception_holidays');
    return $cached if $cached;


sub single_holidays {
    my ( $self, $date ) = @_;
    my $branchcode = $self->{branchcode};
    my $cache           = C4::Context->cache;
    my $single_holidays = $cache->get_from_cache('single_holidays');

    # $single_holidays looks like:

Lines 69-74 use Plack::App::URLMap; Link Here

(-)a/Koha/Handler/Plack.pm (-2 / +39 lines)
69	hostname => 'koha1.com',	69	hostname => 'koha1.com',
70	app => $app1,	70	app => $app1,
71	context => $context1,	71	context => $context1,
		72	shared_context => 1
72	},	73	},
73	{	74	{
74	hostname => ['koha2.com', 'www.koha2.com'],	75	hostname => ['koha2.com', 'www.koha2.com'],
Lines 78-90 use Plack::App::URLMap; Link Here
78	...	79	...
79		80
80	C<hostname> is mandatory.	81	C<hostname> is mandatory.
		82	If C<shared_context> is set to true, some Context properties will be preserved across
		83	forked processes. Useful if both OPAC and Intranet apps are served here, so no restart
		84	is needed when Context cached properties cnamge values. Needs memcached.
81		85
82	koha.psgi:	86	koha.psgi:
83		87
84	use Plack::Builder;	88	use Plack::Builder;
85	use Plack::App::CGIBin;	89	use Plack::App::CGIBin;
86		90
87	use C4::Context;	91	use C4::Context ":no_config";
88		92
89	my $opac_app = builder {	93	my $opac_app = builder {
90	enable "Plack::Middleware::Static",	94	enable "Plack::Middleware::Static",
Lines 137-142 use Plack::App::URLMap; Link Here
137		141
138	=cut	142	=cut
139		143
		144	# We cannot store whole Context object, may contain non-serializable things
		145	my @CONTEXT_SHARED_PROPERTIES = qw(sysprefs);
140	sub app_per_host {	146	sub app_per_host {
141	my $class = shift;	147	my $class = shift;
142	my $sites = shift or die "No sites spec";	148	my $sites = shift or die "No sites spec";
Lines 148-159 sub app_per_host { Link Here
148		154
149	my $app = $site_params->{app} or croak "No app";	155	my $app = $site_params->{app} or croak "No app";
150	my $context = $site_params->{context} or croak "No Koha Context";	156	my $context = $site_params->{context} or croak "No Koha Context";
		157	my $shared_context = $site_params->{shared_context};
		158	my $cache = $context->memcached;
		159	if ($shared_context) {
		160	if ($cache) {
		161	foreach (@CONTEXT_SHARED_PROPERTIES) {
		162	# Clean slate
		163	$cache->delete($_);
		164	}
		165	}
		166	else {
		167	warn "shared_context works only with memcached";
		168	}
		169	}
151		170
152	foreach my $host (@$hosts) {	171	foreach my $host (@$hosts) {
153	$map->map("http://$host/" => sub {	172	$map->map("http://$host/" => sub {
154	my $env = shift;	173	my $env = shift;
155		174
156	return $context->run_within_context(sub { $app->($env) });	175	# may have stopped meanwhile or whatever
		176	my $cache = $context->memcached;
		177	if ($shared_context && $cache) {
		178	foreach (@CONTEXT_SHARED_PROPERTIES) {
		179	if (my $shared = $cache->get($_)) {
		180	$context->{$_} = $shared;
		181	}
		182	}
		183	}
		184
		185	my $ret = $context->run_within_context(sub { $app->($env) });
		186
		187	if ($shared_context && $cache) {
		188	foreach (@CONTEXT_SHARED_PROPERTIES) {
		189	$cache->set($_, $context->{$_});
		190	}
		191	}
		192
		193	$ret;
157	});	194	});
158	}	195	}
159	}	196	}

Lines 73-79 use Plack::App::CGIBin; Link Here

(-)a/Koha/Handler/Plack/CGI.pm (-1 / +1 lines)
73		73
74	use parent "Koha::Handler::Plack";	74	use parent "Koha::Handler::Plack";
75		75
76	use C4::Context;	76	use C4::Context ":no_config";
77		77
78	=head1 CLASS METHODS	78	=head1 CLASS METHODS
79		79

Lines 34-41 sub new { Link Here

(-)a/Koha/Template/Plugin/Cache.pm (-2 / +1 lines)
34	$cache = delete $params->{cache};	34	$cache = delete $params->{cache};
35	}	35	}
36	else {	36	else {
37	require Koha::Cache;	37	$cache = $context->cache;
38	$cache = Koha::Cache->get_instance();
39	}	38	}
40	my $self = bless {	39	my $self = bless {
41	CACHE => $cache,	40	CACHE => $cache,




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         = C4::Context->cache;
my @messages;

my ( $template, $borrowernumber, $cookie ) = get_template_and_user(

Lines 59-65 else { Link Here

(-)a/admin/koha2marclinks.pl (-1 / +1 lines)
59	}	59	}
60		60
61	my $dbh = C4::Context->dbh;	61	my $dbh = C4::Context->dbh;
62	my $cache = Koha::Cache->get_instance();	62	my $cache = C4::Context->cache;
63		63
64	################## ADD_FORM ##################################	64	################## ADD_FORM ##################################
65	# called by default. Used to create form to add or modify a record	65	# called by default. Used to create form to add or modify a record

Lines 77-83 my ( $template, $borrowernumber, $cookie ) = get_template_and_user( Link Here

(-)a/admin/marc_subfields_structure.pl (-1 / +1 lines)
77	debug => 1,	77	debug => 1,
78	}	78	}
79	);	79	);
80	my $cache = Koha::Cache->get_instance();	80	my $cache = C4::Context->cache;
81		81
82	my $op = $input->param('op') \|\| "";	82	my $op = $input->param('op') \|\| "";
83	$tagfield =~ s/\,//g;	83	$tagfield =~ s/\,//g;




use C4::Koha;
use C4::Context;
use C4::Output;
use C4::Context;

use Koha::Cache;

# retrieve parameters
my $input = new CGI;

my $script_name = "/cgi-bin/koha/admin/marctagstructure.pl";

my $dbh = C4::Context->dbh;
my $cache = C4::Context->cache;

# open template
my ($template, $loggedinuser, $cookie)





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');


my @sql_params  = $query->param('sql_params');

my $cache = C4::Context->cache;
my $cache_active = $cache->is_cache_active;
my ($cache_key, $json_text);
if ($cache_active) {

Lines 25-31 use C4::Reports::Guided; Link Here

(-)a/svc/report (-2 / +2 lines)
25	use JSON;	25	use JSON;
26	use CGI qw ( -utf8 );	26	use CGI qw ( -utf8 );
27		27
28	use Koha::Cache;	28	use C4::Context;
29		29
30		30
31	my $query = CGI->new();	31	my $query = CGI->new();
Lines 48-54 my ( $template, $loggedinuser, $cookie ) = get_template_and_user( Link Here
48	}	48	}
49	);	49	);
50		50
51	my $cache = Koha::Cache->get_instance();	51	my $cache = C4::Context->cache;
52	my $cache_active = $cache->is_cache_active;	52	my $cache_active = $cache->is_cache_active;
53	my ($cache_key, $json_text);	53	my ($cache_key, $json_text);
54	if ($cache_active) {	54	if ($cache_active) {

Lines 32-38 SKIP: { Link Here

(-)a/t/Cache.t (-2 / +2 lines)
32	# Set a special namespace for testing, to avoid breaking	32	# Set a special namespace for testing, to avoid breaking
33	# if test is run with a different user than Apache's.	33	# if test is run with a different user than Apache's.
34	$ENV{ MEMCACHED_NAMESPACE } = 'unit_tests';	34	$ENV{ MEMCACHED_NAMESPACE } = 'unit_tests';
35	my $cache = Koha::Cache->get_instance();	35	my $cache = C4::Context->cache;
36		36
37	skip "Cache not enabled", 33	37	skip "Cache not enabled", 33
38	unless ( $cache->is_cache_active() && defined $cache );	38	unless ( $cache->is_cache_active() && defined $cache );
Lines 224-230 SKIP: { Link Here
224	END {	224	END {
225	SKIP: {	225	SKIP: {
226	$ENV{ MEMCACHED_NAMESPACE } = 'unit_tests';	226	$ENV{ MEMCACHED_NAMESPACE } = 'unit_tests';
227	my $cache = Koha::Cache->get_instance();	227	my $cache = C4::Context->cache;
228	skip "Cache not enabled", 1	228	skip "Cache not enabled", 1
229	unless ( $cache->is_cache_active() );	229	unless ( $cache->is_cache_active() );
230	is( $destructorcount, 1, 'Destructor run exactly once' );	230	is( $destructorcount, 1, 'Destructor run exactly once' );

Lines 22-28 use Test::MockModule; Link Here

(-)a/t/Calendar.t (-2 / +2 lines)
22		22
23	use DateTime;	23	use DateTime;
24	use DateTime::Duration;	24	use DateTime::Duration;
25	use Koha::Cache;	25	use C4::Context;
26	use Koha::DateUtils;	26	use Koha::DateUtils;
27		27
28	use Module::Load::Conditional qw/check_install/;	28	use Module::Load::Conditional qw/check_install/;
Lines 89-95 fixtures_ok [ Link Here
89	],	89	],
90	], "add fixtures";	90	], "add fixtures";
91		91
92	my $cache = Koha::Cache->get_instance();	92	my $cache = C4::Context->cache;
93	$cache->clear_from_cache( 'single_holidays') ;	93	$cache->clear_from_cache( 'single_holidays') ;
94		94
95	# 'MPL' branch is arbitrary, is not used at all but is needed for initialization	95	# 'MPL' branch is arbitrary, is not used at all but is needed for initialization





use Modern::Perl;
use DBI;
use Test::More tests => 29;
use Test::MockModule;

BEGIN {

#Bug 14751
is( C4::Context->interface( 'SiP' ), 'sip', 'interface SiP' );
is( C4::Context->interface( 'COMMANDLINE' ), 'commandline', 'interface commandline uc' );

my $DUMMY_KOHA_CONF = "<yazgfs><config><kohasite>TEST</kohasite></config></yazgfs>";
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");
}

Lines 1-6 Link Here

(-)a/t/Koha_Template_Plugin_Cache.t (-1 / +3 lines)
1	use Modern::Perl;	1	use Modern::Perl;
2	use Test::More tests => 2;	2	use Test::More tests => 2;
3		3
		4	use C4::Context;
		5
4	use_ok('Koha::Template::Plugin::Cache');	6	use_ok('Koha::Template::Plugin::Cache');
5		7
6	ok(my $cache = Koha::Template::Plugin::Cache->new());	8	ok(my $cache = Koha::Template::Plugin::Cache->new(C4::Context->current));





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');


Lines 71-77 sub run_hiding_tests { Link Here

(-)a/t/db_dependent/Filter_MARC_ViewPolicy.t (-1 / +1 lines)
71		71
72	$sth->execute($hidden_value);	72	$sth->execute($hidden_value);
73		73
74	my $cache = Koha::Cache->get_instance();	74	my $cache = Koha::Cache->new();
75	$cache->flush_all(); # easy way to ensure DB is queried again.	75	$cache->flush_all(); # easy way to ensure DB is queried again.
76		76
77	my $processor = Koha::RecordProcessor->new(	77	my $processor = Koha::RecordProcessor->new(

Lines 10-16 use CGI qw ( -utf8 ); Link Here

(-)a/tools/newHolidays.pl (-3 / +2 lines)
10	use C4::Auth;	10	use C4::Auth;
11	use C4::Output;	11	use C4::Output;
12		12
13	use Koha::Cache;	13	use C4::Context;
14		14
15	use C4::Calendar;	15	use C4::Calendar;
16	use DateTime;	16	use DateTime;
Lines 129-134 sub add_holiday { Link Here
129	}	129	}
130	}	130	}
131	# we updated the single_holidays table, so wipe its cache	131	# we updated the single_holidays table, so wipe its cache
132	my $cache = Koha::Cache->get_instance();	132	my $cache = C4::Context->cache;
133	$cache->clear_from_cache( 'single_holidays') ;	133	$cache->clear_from_cache( 'single_holidays') ;
134	}	134	}
135	-

Return to bug 15562

Lines 38-45 use C4::Charset; Link Here

(-)a/C4/Biblio.pm (-2 / +2 lines)
38	use C4::Linker;	38	use C4::Linker;
39	use C4::OAI::Sets;	39	use C4::OAI::Sets;
40	use C4::Debug;	40	use C4::Debug;
		41	use C4::Context;
41		42
42	use Koha::Cache;
43	use Koha::Authority::Types;	43	use Koha::Authority::Types;
44	use Koha::Acquisition::Currencies;	44	use Koha::Acquisition::Currencies;
45	use Koha::SearchEngine;	45	use Koha::SearchEngine;
Lines 1122-1128 sub GetMarcStructure { Link Here
1122	$frameworkcode = "" unless $frameworkcode;	1122	$frameworkcode = "" unless $frameworkcode;
1123		1123
1124	$forlibrarian = $forlibrarian ? 1 : 0;	1124	$forlibrarian = $forlibrarian ? 1 : 0;
1125	my $cache = Koha::Cache->get_instance();	1125	my $cache = C4::Context->cache;
1126	my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";	1126	my $cache_key = "MarcStructure-$forlibrarian-$frameworkcode";
1127	my $cached = $cache->get_from_cache($cache_key);	1127	my $cached = $cache->get_from_cache($cache_key);
1128	return $cached if $cached;	1128	return $cached if $cached;

Lines 23-29 use Carp; Link Here

(-)a/C4/Calendar.pm (-8 / +7 lines)
23	use Date::Calc qw( Date_to_Days Today);	23	use Date::Calc qw( Date_to_Days Today);
24		24
25	use C4::Context;	25	use C4::Context;
26	use Koha::Cache;
27		26
28	use constant ISO_DATE_FORMAT => "%04d-%02d-%02d";	27	use constant ISO_DATE_FORMAT => "%04d-%02d-%02d";
29		28
Lines 276-282 sub insert_single_holiday { Link Here
276		275
277		276
278	# changed the 'single_holidays' table, lets force/reset its cache	277	# changed the 'single_holidays' table, lets force/reset its cache
279	my $cache = Koha::Cache->get_instance();	278	my $cache = C4::Context->cache;
280	$cache->clear_from_cache( 'single_holidays') ;	279	$cache->clear_from_cache( 'single_holidays') ;
281	$cache->clear_from_cache( 'exception_holidays') ;	280	$cache->clear_from_cache( 'exception_holidays') ;
282		281
Lines 321-327 sub insert_exception_holiday { Link Here
321	$self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};	320	$self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};
322		321
323	# changed the 'single_holidays' table, lets force/reset its cache	322	# changed the 'single_holidays' table, lets force/reset its cache
324	my $cache = Koha::Cache->get_instance();	323	my $cache = C4::Context->cache;
325	$cache->clear_from_cache( 'single_holidays') ;	324	$cache->clear_from_cache( 'single_holidays') ;
326	$cache->clear_from_cache( 'exception_holidays') ;	325	$cache->clear_from_cache( 'exception_holidays') ;
327		326
Lines 422-428 UPDATE special_holidays SET title = ?, description = ? Link Here
422	$self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};	421	$self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};
423		422
424	# changed the 'single_holidays' table, lets force/reset its cache	423	# changed the 'single_holidays' table, lets force/reset its cache
425	my $cache = Koha::Cache->get_instance();	424	my $cache = C4::Context->cache;
426	$cache->clear_from_cache( 'single_holidays') ;	425	$cache->clear_from_cache( 'single_holidays') ;
427	$cache->clear_from_cache( 'exception_holidays') ;	426	$cache->clear_from_cache( 'exception_holidays') ;
428		427
Lines 465-471 UPDATE special_holidays SET title = ?, description = ? Link Here
465	$self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};	464	$self->{'exception_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};
466		465
467	# changed the 'single_holidays' table, lets force/reset its cache	466	# changed the 'single_holidays' table, lets force/reset its cache
468	my $cache = Koha::Cache->get_instance();	467	my $cache = C4::Context->cache;
469	$cache->clear_from_cache( 'single_holidays') ;	468	$cache->clear_from_cache( 'single_holidays') ;
470	$cache->clear_from_cache( 'exception_holidays') ;	469	$cache->clear_from_cache( 'exception_holidays') ;
471		470
Lines 546-552 sub delete_holiday { Link Here
546	}	545	}
547		546
548	# changed the 'single_holidays' table, lets force/reset its cache	547	# changed the 'single_holidays' table, lets force/reset its cache
549	my $cache = Koha::Cache->get_instance();	548	my $cache = C4::Context->cache;
550	$cache->clear_from_cache( 'single_holidays') ;	549	$cache->clear_from_cache( 'single_holidays') ;
551	$cache->clear_from_cache( 'exception_holidays') ;	550	$cache->clear_from_cache( 'exception_holidays') ;
552		551
Lines 577-583 sub delete_holiday_range { Link Here
577	$sth->execute($self->{branchcode}, $options{day}, $options{month}, $options{year});	576	$sth->execute($self->{branchcode}, $options{day}, $options{month}, $options{year});
578		577
579	# changed the 'single_holidays' table, lets force/reset its cache	578	# changed the 'single_holidays' table, lets force/reset its cache
580	my $cache = Koha::Cache->get_instance();	579	my $cache = C4::Context->cache;
581	$cache->clear_from_cache( 'single_holidays') ;	580	$cache->clear_from_cache( 'single_holidays') ;
582	$cache->clear_from_cache( 'exception_holidays') ;	581	$cache->clear_from_cache( 'exception_holidays') ;
583		582
Lines 631-637 sub delete_exception_holiday_range { Link Here
631	$sth->execute($self->{branchcode}, $options{day}, $options{month}, $options{year});	630	$sth->execute($self->{branchcode}, $options{day}, $options{month}, $options{year});
632		631
633	# changed the 'single_holidays' table, lets force/reset its cache	632	# changed the 'single_holidays' table, lets force/reset its cache
634	my $cache = Koha::Cache->get_instance();	633	my $cache = C4::Context->cache;
635	$cache->clear_from_cache( 'single_holidays') ;	634	$cache->clear_from_cache( 'single_holidays') ;
636	$cache->clear_from_cache( 'exception_holidays') ;	635	$cache->clear_from_cache( 'exception_holidays') ;
637	}	636	}

Lines 18-24 package C4::Context; Link Here

(-)a/C4/Context.pm (-45 / +78 lines)
18		18
19	use strict;	19	use strict;
20	use warnings;	20	use warnings;
21	use vars qw($AUTOLOAD $context @context_stack $servers $memcached $ismemcached);	21	use vars qw($AUTOLOAD $context @context_stack $memcached_servers);
22	BEGIN {	22	BEGIN {
23	if ($ENV{'HTTP_USER_AGENT'}) {	23	if ($ENV{'HTTP_USER_AGENT'}) {
24	require CGI::Carp;	24	require CGI::Carp;
Lines 88-107 BEGIN { Link Here
88	} # else there is no browser to send fatals to!	88	} # else there is no browser to send fatals to!
89		89
90	# Check if there are memcached servers set	90	# Check if there are memcached servers set
91	$servers = $ENV{'MEMCACHED_SERVERS'};	91	$memcached_servers = $ENV{'MEMCACHED_SERVERS'};
92	if ($servers) {	92	# Load required libraries and create the memcached object
93	# Load required libraries and create the memcached object	93	require Cache::Memcached if $memcached_servers;
94	require Cache::Memcached;
95	$memcached = Cache::Memcached->new({
96	servers => [ $servers ],
97	debug => 0,
98	compress_threshold => 10_000,
99	expire_time => 600,
100	namespace => $ENV{'MEMCACHED_NAMESPACE'} \|\| 'koha'
101	});
102	# Verify memcached available (set a variable and test the output)
103	$ismemcached = $memcached->set('ismemcached','1');
104	}
105		94
106	}	95	}
107		96
Lines 219-247 sub current { Link Here
219	return $context;	208	return $context;
220	}	209	}
221		210
222	=head2 ismemcached	211	sub _new_memcached {
		212	my $namespace = shift or die "No memcached namespace";
		213
		214	return unless $memcached_servers;
		215	return Cache::Memcached->new({
		216	servers => [ $memcached_servers ],
		217	debug => 0,
		218	compress_threshold => 10_000,
		219	expire_time => 600,
		220	namespace => $namespace \|\| $ENV{'MEMCACHED_NAMESPACE'} \|\| 'koha'
		221	});
		222	}
		223	# Verify memcached available (test the output)
		224	sub _ping_memcached {
		225	my $memcached = shift or croak "No memcached";
223		226
224	Returns the value of the $ismemcached variable (0/1)	227	return $memcached->set('ismemcached','1');
		228	}
		229
		230	=head2 cache
		231
		232	Returns the cache object or undef
225		233
226	=cut	234	=cut
227		235
228	sub ismemcached {	236	sub cache {
229	return $ismemcached;	237	my $self = shift;
		238	$self = $context unless ref ($self);
		239
		240	return $self->{cache};
230	}	241	}
231		242
232	=head2 memcached	243	=head2 memcached
233		244
234	If $ismemcached is true, returns the $memcache variable.	245	Returns the memcached object or undef
235	Returns undef otherwise	246
		247	=head2 ismemcached
236		248
237	=cut	249	=cut
238		250
239	sub memcached {	251	sub memcached {
240	if ($ismemcached) {	252	my $self = shift;
241	return $memcached;	253	$self = $context unless ref ($self);
242	} else {	254
243	return;	255	my $memcached = $self->{memcached} or return;
244	}	256	return _ping_memcached($memcached) ? $memcached : undef;
		257	}
		258
		259	sub ismemcached {
		260	my $self = shift;
		261	return $self->memcached;
245	}	262	}
246		263
247	sub db_driver {	264	sub db_driver {
Lines 285-294 sub import { Link Here
285	# default context already exists?	302	# default context already exists?
286	return if $context;	303	return if $context;
287		304
288	if ($ismemcached) {	305	return if $config_file && $config_file eq ":no_config";
		306
		307	my $memcached = _new_memcached($ENV{'MEMCACHED_NAMESPACE'} \|\| 'koha');
		308	if ($memcached) {
289	# retrieve from memcached	309	# retrieve from memcached
290	if (my $self = $memcached->get('kohaconf')) {	310	if ($context = $memcached->get('kohaconf')) {
291	$context = $self;	311	$context->{memcached} = $memcached;
		312	$context->{cache} = Koha::Cache->new({namespace => $context->{namespace}});
292	return;	313	return;
293	}	314	}
294	}	315	}
Lines 315-330 sub import { Link Here
315	}	336	}
316		337
317	# no ? so load it!	338	# no ? so load it!
318	return if $config_file && $config_file eq ":no_config";	339	$context = $pkg->_new($config_file) or return;
319	my $new_ctx = __PACKAGE__->new($config_file);	340	if ( $memcached && _ping_memcached($memcached) ) {
320	return unless $new_ctx;	341	$memcached->set('kohaconf',$context);
321		342	# Canot serialize cache objects
322	# if successfully loaded, use it by default	343	$context->{memcached} = $memcached;
323	$context = $new_ctx;
324
325	if ($ismemcached) {
326	$memcached->set('kohaconf',$new_ctx);
327	}	344	}
		345	$context->{cache} = Koha::Cache->new({namespace => $context->{namespace}});
328	}	346	}
329		347
330	use Scalar::Util qw(openhandle);	348	use Scalar::Util qw(openhandle);
Lines 366-371 sub new { Link Here
366	my $conf_fname = shift or croak "No conf";	384	my $conf_fname = shift or croak "No conf";
367	my $namespace = shift;	385	my $namespace = shift;
368		386
		387	my $self = $class->_new($conf_fname, $namespace);
		388
		389	if ($memcached_servers) {
		390	$self->{memcached} = _new_memcached($namespace);
		391	}
		392	$self->{cache} = Koha::Cache->new({namespace => $namespace});
		393
		394	return $self;
		395	}
		396
		397	sub _new {
		398	my $class = shift;
		399	my $conf_fname = shift or croak "No conf";
		400	my $namespace = shift;
		401
369	my $self = XMLin(	402	my $self = XMLin(
370	$conf_fname,	403	$conf_fname,
371	keyattr => ['id'],	404	keyattr => ['id'],
Lines 378-384 sub new { Link Here
378	$self->{config_file} = $conf_fname;	411	$self->{config_file} = $conf_fname;
379	$self->{namespace} = $namespace;	412	$self->{namespace} = $namespace;
380	$self->{use_syspref_cache} = 1;	413	$self->{use_syspref_cache} = 1;
381	$self->{syspref_cache} = Koha::Cache->new({namespace => $namespace});
382		414
383	$self->{"Zconn"} = undef; # Zebra Connections	415	$self->{"Zconn"} = undef; # Zebra Connections
384	$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield	416	$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield
Lines 559-565 sub preference { Link Here
559	if defined $ENV{"OVERRIDE_SYSPREF_$var"};	591	if defined $ENV{"OVERRIDE_SYSPREF_$var"};
560		592
561	my $cached_var = $self->{use_syspref_cache}	593	my $cached_var = $self->{use_syspref_cache}
562	? $self->{syspref_cache}->get_from_cache("syspref_$var")	594	? $self->cache->get_from_cache("syspref_$var")
563	: undef;	595	: undef;
564	return $cached_var if defined $cached_var;	596	return $cached_var if defined $cached_var;
565		597
Lines 568-574 sub preference { Link Here
568	my $value = $syspref ? $syspref->value() : undef;	600	my $value = $syspref ? $syspref->value() : undef;
569		601
570	if ( $self->{use_syspref_cache} ) {	602	if ( $self->{use_syspref_cache} ) {
571	$self->{syspref_cache}->set_in_cache("syspref_$var", $value);	603	$self->cache->set_in_cache("syspref_$var", $value);
		604	$self->{sysprefs}{$var} = $value if $self;
572	}	605	}
573	return $value;	606	return $value;
574	}	607	}
Lines 609-616 used with Plack and other persistent environments. Link Here
609	sub disable_syspref_cache {	642	sub disable_syspref_cache {
610	my ($self) = @_;	643	my ($self) = @_;
611	$self = $context unless ref $self;	644	$self = $context unless ref $self;
612	$self->{use_syspref_cache} = 0;
613	$self->clear_syspref_cache();	645	$self->clear_syspref_cache();
		646	$self->{use_syspref_cache} = 0;
614	}	647	}
615		648
616	=head2 clear_syspref_cache	649	=head2 clear_syspref_cache
Lines 627-633 sub clear_syspref_cache { Link Here
627	my ($self) = @_;	660	my ($self) = @_;
628	$self = $context unless ref $self;	661	$self = $context unless ref $self;
629	return unless $self->{use_syspref_cache};	662	return unless $self->{use_syspref_cache};
630	$self->{syspref_cache}->flush_all;	663	$self->cache->flush_all;
631	}	664	}
632		665
633	=head2 set_preference	666	=head2 set_preference
Lines 680-686 sub set_preference { Link Here
680	}	713	}
681		714
682	if ( $self->{use_syspref_cache} ) {	715	if ( $self->{use_syspref_cache} ) {
683	$self->{syspref_cache}->set_in_cache( "syspref_$variable", $value );	716	$self->cache->set_in_cache( "syspref_$variable", $value );
684	}	717	}
685		718
686	return $syspref;	719	return $syspref;
Lines 702-708 sub delete_preference { Link Here
702		735
703	if ( Koha::Config::SysPrefs->find( $var )->delete ) {	736	if ( Koha::Config::SysPrefs->find( $var )->delete ) {
704	if ( $self->{use_syspref_cache} ) {	737	if ( $self->{use_syspref_cache} ) {
705	$self->{syspref_cache}->clear_from_cache("syspref_$var");	738	$self->cache->clear_from_cache("syspref_$var");
706	}	739	}
707		740
708	return 1;	741	return 1;

Lines 22-28 use warnings; Link Here

(-)a/C4/External/OverDrive.pm (-4 / +2 lines)
22		22
23	use Koha;	23	use Koha;
24	use JSON;	24	use JSON;
25	use Koha::Cache;	25	use C4::Context;
26	use HTTP::Request;	26	use HTTP::Request;
27	use HTTP::Request::Common;	27	use HTTP::Request::Common;
28	use LWP::Authen::Basic;	28	use LWP::Authen::Basic;
Lines 97-105 sub GetOverDriveToken { Link Here
97		97
98	return unless ( $key && $secret ) ;	98	return unless ( $key && $secret ) ;
99		99
100	my $cache;	100	my $cache = C4::Context->cache;
101
102	eval { $cache = Koha::Cache->get_instance() };
103		101
104	my $token;	102	my $token;
105	$cache and $token = $cache->get_from_cache( "overdrive_token" ) and return $token;	103	$cache and $token = $cache->get_from_cache( "overdrive_token" ) and return $token;

Lines 49-71 __PACKAGE__->mk_ro_accessors( Link Here

(-)a/Koha/Cache.pm (-17 lines)
49		49
50	our %L1_cache;	50	our %L1_cache;
51		51
52	=head2 get_instance
53
54	my $cache = Koha::Cache->get_instance();
55
56	This gets a shared instance of the cache, set up in a very default way. This is
57	the recommended way to fetch a cache object. If possible, it'll be
58	persistent across multiple instances.
59
60	=cut
61
62	our $singleton_cache;
63	sub get_instance {
64	my ($class) = @_;
65	$singleton_cache = $class->new() unless $singleton_cache;
66	return $singleton_cache;
67	}
68
69	=head2 new	52	=head2 new
70		53
71	Create a new Koha::Cache object. This is required for all cache-related functionality.	54	Create a new Koha::Cache object. This is required for all cache-related functionality.

Lines 7-13 use DateTime; Link Here

(-)a/Koha/Calendar.pm (-3 / +2 lines)
7	use DateTime::Set;	7	use DateTime::Set;
8	use DateTime::Duration;	8	use DateTime::Duration;
9	use C4::Context;	9	use C4::Context;
10	use Koha::Cache;
11	use Carp;	10	use Carp;
12		11
13	sub new {	12	sub new {
Lines 55-61 sub _init { Link Here
55	sub exception_holidays {	54	sub exception_holidays {
56	my ( $self ) = @_;	55	my ( $self ) = @_;
57		56
58	my $cache = Koha::Cache->get_instance();	57	my $cache = C4::Context->cache;
59	my $cached = $cache->get_from_cache('exception_holidays');	58	my $cached = $cache->get_from_cache('exception_holidays');
60	return $cached if $cached;	59	return $cached if $cached;
61		60
Lines 84-90 sub exception_holidays { Link Here
84	sub single_holidays {	83	sub single_holidays {
85	my ( $self, $date ) = @_;	84	my ( $self, $date ) = @_;
86	my $branchcode = $self->{branchcode};	85	my $branchcode = $self->{branchcode};
87	my $cache = Koha::Cache->get_instance();	86	my $cache = C4::Context->cache;
88	my $single_holidays = $cache->get_from_cache('single_holidays');	87	my $single_holidays = $cache->get_from_cache('single_holidays');
89		88
90	# $single_holidays looks like:	89	# $single_holidays looks like:

Lines 26-37 use C4::Output; Link Here

(-)a/admin/biblio_framework.pl (-2 / +1 lines)
26	use Koha::Biblios;	26	use Koha::Biblios;
27	use Koha::BiblioFramework;	27	use Koha::BiblioFramework;
28	use Koha::BiblioFrameworks;	28	use Koha::BiblioFrameworks;
29	use Koha::Cache;
30		29
31	my $input = new CGI;	30	my $input = new CGI;
32	my $frameworkcode = $input->param('frameworkcode') \|\| q\|\|;	31	my $frameworkcode = $input->param('frameworkcode') \|\| q\|\|;
33	my $op = $input->param('op') \|\| q\|list\|;	32	my $op = $input->param('op') \|\| q\|list\|;
34	my $cache = Koha::Cache->get_instance();	33	my $cache = C4::Context->cache;
35	my @messages;	34	my @messages;
36		35
37	my ( $template, $borrowernumber, $cookie ) = get_template_and_user(	36	my ( $template, $borrowernumber, $cookie ) = get_template_and_user(

Lines 25-33 use C4::Auth; Link Here

(-)a/admin/marctagstructure.pl (-4 / +1 lines)
25	use C4::Koha;	25	use C4::Koha;
26	use C4::Context;	26	use C4::Context;
27	use C4::Output;	27	use C4::Output;
28	use C4::Context;
29
30	use Koha::Cache;
31		28
32	# retrieve parameters	29	# retrieve parameters
33	my $input = new CGI;	30	my $input = new CGI;
Lines 46-52 my $pagesize = 20; Link Here
46	my $script_name = "/cgi-bin/koha/admin/marctagstructure.pl";	43	my $script_name = "/cgi-bin/koha/admin/marctagstructure.pl";
47		44
48	my $dbh = C4::Context->dbh;	45	my $dbh = C4::Context->dbh;
49	my $cache = Koha::Cache->get_instance();	46	my $cache = C4::Context->cache;
50		47
51	# open template	48	# open template
52	my ($template, $loggedinuser, $cookie)	49	my ($template, $loggedinuser, $cookie)

Lines 23-34 Link Here

(-)a/opac/svc/report (-3 / +2 lines)
23		23
24	use Modern::Perl;	24	use Modern::Perl;
25		25
		26	use C4::Context;
26	use C4::Reports::Guided;	27	use C4::Reports::Guided;
27	use JSON;	28	use JSON;
28	use CGI qw ( -utf8 );	29	use CGI qw ( -utf8 );
29		30
30	use Koha::Cache;
31
32	my $query = CGI->new();	31	my $query = CGI->new();
33	my $report_id = $query->param('id');	32	my $report_id = $query->param('id');
34	my $report_name = $query->param('name');	33	my $report_name = $query->param('name');
Lines 41-47 die "Sorry this report is not public\n" unless $report_rec->{public}; Link Here
41		40
42	my @sql_params = $query->param('sql_params');	41	my @sql_params = $query->param('sql_params');
43		42
44	my $cache = Koha::Cache->get_instance();	43	my $cache = C4::Context->cache;
45	my $cache_active = $cache->is_cache_active;	44	my $cache_active = $cache->is_cache_active;
46	my ($cache_key, $json_text);	45	my ($cache_key, $json_text);
47	if ($cache_active) {	46	if ($cache_active) {

Lines 2-8 Link Here

(-)a/t/Context.t (-1 / +27 lines)
2		2
3	use Modern::Perl;	3	use Modern::Perl;
4	use DBI;	4	use DBI;
5	use Test::More tests => 26;	5	use Test::More tests => 29;
6	use Test::MockModule;	6	use Test::MockModule;
7		7
8	BEGIN {	8	BEGIN {
Lines 62-64 is(C4::Context->interface, 'opac', 'interface still opac'); Link Here
62	#Bug 14751	62	#Bug 14751
63	is( C4::Context->interface( 'SiP' ), 'sip', 'interface SiP' );	63	is( C4::Context->interface( 'SiP' ), 'sip', 'interface SiP' );
64	is( C4::Context->interface( 'COMMANDLINE' ), 'commandline', 'interface commandline uc' );	64	is( C4::Context->interface( 'COMMANDLINE' ), 'commandline', 'interface commandline uc' );
		65
		66	my $DUMMY_KOHA_CONF = "<yazgfs><config><kohasite>TEST</kohasite></config></yazgfs>";
		67	my $ctx_a = C4::Context->new($DUMMY_KOHA_CONF, "a");
		68	my $ctx_b = C4::Context->new($DUMMY_KOHA_CONF, "b");
		69	my $cache_key = "test_C4::Context";
		70
		71	SKIP: {
		72	skip "No cache", 3 unless $ctx_a->cache->is_cache_active && $ctx_b->cache->is_cache_active;
		73
		74	# Light warm up
		75	C4::Context->cache->set_in_cache($cache_key, 'c');
		76	$ctx_a->cache->set_in_cache($cache_key, 'a');
		77	$ctx_b->cache->set_in_cache($cache_key, 'b');
		78	is(C4::Context->cache->get_from_cache($cache_key), 'c', "Correct default cache value");
		79	is($ctx_a->cache->get_from_cache($cache_key), 'a', "Correct cache 'a' value");
		80	is($ctx_b->cache->get_from_cache($cache_key), 'b', "Correct cache 'b' value");
		81
		82	# A bit more extravagant
		83	# Cannot run atm, fails due to no database in config
		84	# $ctx_a->run_within_context( sub {
		85	# $ctx_b->cache->set_in_cache($cache_key, 'bb');
		86	# C4::Context->cache->set_in_cache($cache_key, 'aa');
		87	# } );
		88	# is($ctx_a->cache->get_from_cache($cache_key), 'aa', "Correct cache 'a' value");
		89	# is($ctx_b->cache->get_from_cache($cache_key), 'bb', "Correct cache 'b' value");
		90	}

Lines 12-25 use Koha::Database; Link Here

(-)a/t/db_dependent/Context.t (-7 / +1 lines)
12		12
13	BEGIN {	13	BEGIN {
14	$debug = $ENV{DEBUG} \|\| 0;	14	$debug = $ENV{DEBUG} \|\| 0;
15
16	# Note: The overall number of tests may vary by configuration.
17	# First we need to check your environmental variables
18	for (qw(KOHA_CONF PERL5LIB)) {
19	ok( $ret = $ENV{$_}, "ENV{$_} = $ret" );
20	}
21	use_ok('C4::Context');
22	}	15	}
		16	use_ok('C4::Context');
23		17
24	ok($dbh = C4::Context->dbh(), 'Getting dbh from C4::Context');	18	ok($dbh = C4::Context->dbh(), 'Getting dbh from C4::Context');
25		19