Tie::Collection - A trivial implementaion of Tie::Cache by using a tied

Tie-Tools documentation Contained in the Tie-Tools distribution.

Index

Code Index:

NAME

Top

Tie::Collection - A trivial implementaion of Tie::Cache by using a tied handle of a hash for storage.

SYNOPSIS

Top

use Tie::Collection; use DB_File; use Fcntl;

$dbm = tie %hash2, DB_File, 'file.db', O_RDWR | O_CREAT, 0644; tie %hash, Tie::Collection, $dbm, {MaxBytes => $cache_size};

DESCRIPTION

Top

Tie::Collection implements a trivial implementation of Tie::Cache by Joshua Chamas, that gets a tied hash handle to store the data. Assumption was that most common use will be disk storage, therfore the storage hash will probably be tied.

Tie::Collection is useful with DB_File or MLDBM, as will as with Tie::DBI. It was designed to be used with HTML::HTPL in order to cache objects accesses via a key, so they don't have to be read from disk again and again.

Tie::Collection needs two parameters: The handled of the tied hash, and a hashref with parameters to pass to Tie::Cache. (See manpage).

AUTHOR

Top

Ariel Brosh, schop@cpan.org. Tie::Cache was written by Joshua Chamas, chamas@alumni.stanford.org

SEE ALSO

Top

perl(1), Tie::Cache.

COPYRIGHT

Top

Tie::Collection is part of the HTPL package. See HTML::HTPL

Tie-Tools documentation Contained in the Tie-Tools distribution. 
package Tie::Collection;

# $Id: Collection.pm 1883 2007-10-29 21:18:13Z jonasbn $

use Tie::Cache;
use strict;
use vars qw(@ISA $VERSION);

$VERSION = '0.02';

@ISA = qw(Tie::Cache);

sub TIEHASH {
    my ($class, $storage, $ref, $bless) = @_;
    my $this = Tie::Cache::TIEHASH($class, $ref);
    bless $this, $class;
    $this->{'Storage'} = $storage;
    $this->{'Bless'} = $bless;
    $this;
}

sub read {
    my ($self, $key) = @_;
    my $s = $self->{'Storage'};
    my $el = $s->EXISTS($key) ? $s->FETCH($key) : undef;
    my $bless = $self->{'Bless'};
    if ($bless && $el) {
        bless $el, $bless;
        eval '$el->postload;';
    }
    $el;
}

sub write {
    my ($self, $key, $value) = @_;
    my $bless = $self->{'Bless'};
    eval '$value->prestore;' if ($bless && ref($value) =~ /$bless/);
    $self->{'Storage'}->STORE($key, $value);
}

sub flush {
    my ($self) = @_;
    $self->{'Storage'}->sync();
    $self->SUPER::flush();
}

1;

__END__