+ my ( $self, $cache ) = shift;
+ $cache ||= 'cache';
+ return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
+
+ $self->flush_L1_cache();
+
+ return $self->{$cache}->flush_all()
+ if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
+ return $self->{$cache}->clear();
+}
+
+sub flush_L1_cache {
+ my( $self ) = @_;
+ delete $L1_cache{$self->{namespace}};
+}
+
+=head1 TIED INTERFACE
+
+Koha::Cache also provides a tied interface which enables users to provide a
+constructor closure and (after creation) treat cached data like normal reference
+variables and rely on the cache Just Working and getting updated when it
+expires, etc.
+
+ my $cache = Koha::Cache->new();
+ my $data = 'whatever';
+ my $scalar = Koha::Cache->create_scalar(
+ {
+ 'key' => 'whatever',
+ 'timeout' => 2,
+ 'constructor' => sub { return $data; },
+ }
+ );
+ print "$$scalar\n"; # Prints "whatever"
+ $data = 'somethingelse';
+ print "$$scalar\n"; # Prints "whatever" because it is cached
+ sleep 2; # Wait until the cache entry has expired
+ print "$$scalar\n"; # Prints "somethingelse"
+
+ my $hash = Koha::Cache->create_hash(
+ {
+ 'key' => 'whatever',
+ 'timeout' => 2,
+ 'constructor' => sub { return $data; },
+ }
+ );
+ print "$$variable\n"; # Prints "whatever"
+
+The gotcha with this interface, of course, is that the variable returned by
+create_scalar and create_hash is a I<reference> to a tied variable and not a
+tied variable itself.
+
+The tied variable is configured by means of a hashref passed in to the
+create_scalar and create_hash methods. The following parameters are supported:
+
+=over
+
+=item I<key>
+
+Required. The key to use for identifying the variable in the cache.
+
+=item I<constructor>
+
+Required. A closure (or reference to a function) that will return the value that
+needs to be stored in the cache.
+
+=item I<preload>
+
+Optional. A closure (or reference to a function) that gets run to initialize
+the cache when creating the tied variable.
+
+=item I<arguments>
+
+Optional. Array reference with the arguments that should be passed to the
+constructor function.
+
+=item I<timeout>
+
+Optional. The cache timeout in seconds for the variable. Defaults to 600
+(ten minutes).
+
+=item I<cache_type>
+
+Optional. Which type of cache to use for the variable. Defaults to whatever is
+set in the environment variable CACHING_SYSTEM. If set to 'null', disables
+caching for the tied variable.
+
+=item I<allowupdate>
+
+Optional. Boolean flag to allow the variable to be updated directly. When this
+is set and the variable is used as an l-value, the cache will be updated
+immediately with the new value. Using this is probably a bad idea on a
+multi-threaded system. When I<allowupdate> is not set to true, using the
+tied variable as an l-value will have no effect.
+
+=item I<destructor>
+
+Optional. A closure (or reference to a function) that should be called when the
+tied variable is destroyed.
+
+=item I<unset>
+
+Optional. Boolean flag to tell the object to remove the variable from the cache
+when it is destroyed or goes out of scope.
+
+=item I<inprocess>
+
+Optional. Boolean flag to tell the object not to refresh the variable from the
+cache every time the value is desired, but rather only when the I<local> copy
+of the variable is older than the timeout.
+
+=back
+
+=head2 create_scalar
+
+ my $scalar = Koha::Cache->create_scalar(\%params);
+
+Create scalar tied to the cache.
+
+=cut
+
+sub create_scalar {
+ my ( $self, $args ) = @_;
+
+ $self->_set_tied_defaults($args);
+
+ tie my $scalar, 'Koha::Cache::Object', $args;
+ return \$scalar;
+}
+
+sub create_hash {
+ my ( $self, $args ) = @_;
+
+ $self->_set_tied_defaults($args);
+
+ tie my %hash, 'Koha::Cache::Object', $args;
+ return \%hash;
+}
+
+sub _set_tied_defaults {
+ my ( $self, $args ) = @_;
+
+ $args->{'timeout'} = '600' unless defined( $args->{'timeout'} );
+ $args->{'inprocess'} = '0' unless defined( $args->{'inprocess'} );
+ unless ( $args->{cache_type} and lc( $args->{cache_type} ) eq 'null' ) {
+ $args->{'cache'} = $self;
+ $args->{'cache_type'} ||= $ENV{'CACHING_SYSTEM'};
+ }
+
+ return $args;