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
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
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 { expiry => $self->{'timeout'} } );
76 $self->{'lastupdate'} = time;
78 return bless $self, $class;
82 my ( $self, $index ) = @_;
86 if ( !( $self->{'inprocess'} && defined( $self->{'value'} ) )
89 $self->{'value'} = $self->{'cache'}->get_from_cache( $self->{'key'} );
90 $self->{'lastupdate'} = $now;
93 if ( !defined $self->{'value'}
94 || ( defined $index && !exists $self->{'value'}->{$index} )
95 || !defined $self->{'lastupdate'}
96 || ( $now - $self->{'lastupdate'} > $self->{'timeout'} ) )
99 &{ $self->{'constructor'} }( @{ $self->{'arguments'} },
100 $self->{'value'}, $index );
101 if ( defined( $self->{'cache'} ) ) {
102 $self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
103 { expiry => $self->{'timeout'} } );
105 $self->{'lastupdate'} = $now;
107 if ( $self->{'datatype'} eq 'HASH' && defined $index ) {
108 return $self->{'value'}->{$index};
110 return $self->{'value'};
115 my ( $self, $index ) = @_;
117 if ( $self->{'datatype'} eq 'HASH' && defined($index) ) {
118 $self->{'value'}->{$index} = $value;
121 $self->{'value'} = $value;
123 if ( defined( $self->{'allowupdate'} )
124 && $self->{'allowupdate'}
125 && defined( $self->{'cache'} ) )
127 $self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
128 { expiry => $self->{'timeout'} },
132 return $self->{'value'};
138 if ( defined( $self->{'destructor'} ) ) {
139 &{ $self->{'destructor'} }( @{ $self->{'arguments'} } );
142 if ( defined( $self->{'unset'} )
144 && defined( $self->{'cache'} ) )
146 $self->{'cache'}->clear_from_cache( $self->{'key'} );
149 undef $self->{'value'};
154 # HASH-specific routines
157 my ( $class, $self, @args ) = @_;
158 $self->{'datatype'} = 'HASH';
159 return TIESCALAR( $class, $self, @args );
163 my ( $self, $index ) = @_;
164 delete $self->{'value'}->{$index};
165 return $self->STORE( $self->{'value'} );
169 my ( $self, $index ) = @_;
170 $self->FETCH($index);
171 return exists $self->{'value'}->{$index};
177 $self->{'iterator'} = [ keys %{ $self->{'value'} } ];
178 return $self->NEXTKEY;
183 return shift @{ $self->{'iterator'} };
189 return scalar %{ $self->{'value'} }
190 if ( ref( $self->{'value'} ) eq 'HASH' );
196 return $self->DESTROY;
199 # ARRAY-specific routines
203 Koha::Cache, tie, perltie
207 Jared Camins-Esakov, E<lt>jcamins@cpbibliography.comE<gt>