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.
56 use base qw(Class::Accessor);
58 __PACKAGE__->mk_ro_accessors(
59 qw( allowupdate arguments cache cache_type constructor destructor inprocess key lastupdate timeout unset value )
62 # General/SCALAR routines
65 my ( $class, $self ) = @_;
67 $self->{'datatype'} ||= 'SCALAR';
68 $self->{'arguments'} ||= [];
69 if ( defined $self->{'preload'} ) {
70 $self->{'value'} = &{ $self->{'preload'} }( @{ $self->{'arguments'} } );
71 if ( defined( $self->{'cache'} ) ) {
72 $self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
73 { expiry => $self->{'timeout'} } );
75 $self->{'lastupdate'} = time;
77 return bless $self, $class;
81 my ( $self, $index ) = @_;
85 if ( !( $self->{'inprocess'} && defined( $self->{'value'} ) )
88 $self->{'value'} = $self->{'cache'}->get_from_cache( $self->{'key'} );
89 $self->{'lastupdate'} = $now;
92 if ( !defined $self->{'value'}
93 || ( defined $index && !exists $self->{'value'}->{$index} )
94 || !defined $self->{'lastupdate'}
95 || ( $now - $self->{'lastupdate'} > $self->{'timeout'} ) )
98 &{ $self->{'constructor'} }( @{ $self->{'arguments'} },
99 $self->{'value'}, $index );
100 if ( defined( $self->{'cache'} ) ) {
101 $self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
102 { expiry => $self->{'timeout'} } );
104 $self->{'lastupdate'} = $now;
106 if ( $self->{'datatype'} eq 'HASH' && defined $index ) {
107 return $self->{'value'}->{$index};
109 return $self->{'value'};
114 my ( $self, $index ) = @_;
116 if ( $self->{'datatype'} eq 'HASH' && defined($index) ) {
117 $self->{'value'}->{$index} = $value;
120 $self->{'value'} = $value;
122 if ( defined( $self->{'allowupdate'} )
123 && $self->{'allowupdate'}
124 && defined( $self->{'cache'} ) )
126 $self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
127 { expiry => $self->{'timeout'} },
131 return $self->{'value'};
137 if ( defined( $self->{'destructor'} ) ) {
138 &{ $self->{'destructor'} }( @{ $self->{'arguments'} } );
141 if ( defined( $self->{'unset'} )
143 && defined( $self->{'cache'} ) )
145 $self->{'cache'}->clear_from_cache( $self->{'key'} );
148 undef $self->{'value'};
153 # HASH-specific routines
156 my ( $class, $self, @args ) = @_;
157 $self->{'datatype'} = 'HASH';
158 return TIESCALAR( $class, $self, @args );
162 my ( $self, $index ) = @_;
163 delete $self->{'value'}->{$index};
164 return $self->STORE( $self->{'value'} );
168 my ( $self, $index ) = @_;
169 $self->FETCH($index);
170 return exists $self->{'value'}->{$index};
176 $self->{'iterator'} = [ keys %{ $self->{'value'} } ];
177 return $self->NEXTKEY;
182 return shift @{ $self->{'iterator'} };
188 return scalar %{ $self->{'value'} }
189 if ( ref( $self->{'value'} ) eq 'HASH' );
195 return $self->DESTROY;
198 # ARRAY-specific routines
202 Koha::Cache, tie, perltie
206 Jared Camins-Esakov, E<lt>jcamins@cpbibliography.comE<gt>