1 package Koha
::Cache
::Object
;
3 # Copyright 2013 C & P Bibliography Services
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 3 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
22 Koha::Cache::Object - Tie-able class for caching objects
26 my $cache = Koha::Cache->new();
27 my $scalar = Koha::Cache->create_scalar(
31 'constructor' => sub { return 'stuff'; },
34 my %hash = Koha::Cache->create_hash(
36 'key' => 'whateverelse',
38 'constructor' => sub { return { 'stuff' => 'nonsense' }; },
44 Do not use this class directly. It is tied to variables by Koha::Cache
45 for transparent cache access. If you choose to ignore this warning, you
46 should be aware that it is disturbingly polymorphic and supports both
47 scalars and hashes, with arrays a potential future addition.
57 use base
qw(Class::Accessor);
59 __PACKAGE__
->mk_ro_accessors(
60 qw( allowupdate arguments cache cache_type constructor destructor inprocess key lastupdate timeout unset value )
63 # General/SCALAR routines
66 my ( $class, $self ) = @_;
68 $self->{'datatype'} ||= 'SCALAR';
69 $self->{'arguments'} ||= [];
70 if ( defined $self->{'preload'} ) {
71 $self->{'value'} = &{ $self->{'preload'} }( @
{ $self->{'arguments'} } );
72 if ( defined( $self->{'cache'} ) ) {
73 $self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
74 $self->{'timeout'}, $self->{'cache_type'} . '_cache' );
76 $self->{'lastupdate'} = time;
78 return bless $self, $class;
82 my ( $self, $index ) = @_;
86 && carp
"Retrieving cached hash member $index of $self->{'key'}";
90 if ( !( $self->{'inprocess'} && defined( $self->{'value'} ) )
95 ->get_from_cache( $self->{'key'}, $self->{'cache_type'} . '_cache' );
96 $self->{'lastupdate'} = $now;
99 if ( !defined $self->{'value'}
100 || ( defined $index && !exists $self->{'value'}->{$index} )
101 || !defined $self->{'lastupdate'}
102 || ( $now - $self->{'lastupdate'} > $self->{'timeout'} ) )
105 &{ $self->{'constructor'} }( @
{ $self->{'arguments'} },
106 $self->{'value'}, $index );
107 if ( defined( $self->{'cache'} ) ) {
108 $self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
109 $self->{'timeout'}, $self->{'cache_type'} . '_cache' );
111 $self->{'lastupdate'} = $now;
113 if ( $self->{'datatype'} eq 'HASH' && defined $index ) {
114 return $self->{'value'}->{$index};
116 return $self->{'value'};
121 my ( $self, $index ) = @_;
123 if ( $self->{'datatype'} eq 'HASH' && defined($index) ) {
124 $self->{'value'}->{$index} = $value;
127 $self->{'value'} = $value;
129 if ( defined( $self->{'allowupdate'} )
130 && $self->{'allowupdate'}
131 && defined( $self->{'cache'} ) )
134 ->set_in_cache( $self->{'key'}, $self->{'value'}, $self->{'timeout'},
135 $self->{'cache_type'} . '_cache' );
138 return $self->{'value'};
144 if ( defined( $self->{'destructor'} ) ) {
145 &{ $self->{'destructor'} }( @
{ $self->{'arguments'} } );
148 if ( defined( $self->{'unset'} )
150 && defined( $self->{'cache'} ) )
152 $self->{'cache'}->clear_from_cache( $self->{'key'},
153 $self->{'cache_type'} . '_cache' );
156 undef $self->{'value'};
161 # HASH-specific routines
164 my ( $class, $self, @args ) = @_;
165 $self->{'datatype'} = 'HASH';
166 return TIESCALAR
( $class, $self, @args );
170 my ( $self, $index ) = @_;
171 delete $self->{'value'}->{$index};
172 return $self->STORE( $self->{'value'} );
176 my ( $self, $index ) = @_;
177 $self->FETCH($index);
178 return exists $self->{'value'}->{$index};
184 $self->{'iterator'} = [ keys %{ $self->{'value'} } ];
185 return $self->NEXTKEY;
190 return shift @
{ $self->{'iterator'} };
196 return scalar %{ $self->{'value'} }
197 if ( ref( $self->{'value'} ) eq 'HASH' );
203 return $self->DESTROY;
206 # ARRAY-specific routines
210 Koha::Cache, tie, perltie
214 Jared Camins-Esakov, E<lt>jcamins@cpbibliography.comE<gt>