1 package DBIx::Class::Cursor::Cached;
11 $VERSION = '1.000001';
15 my ($storage, $args, $attrs) = @_;
16 $class = ref $class if ref $class;
17 # This gives us the class the storage object -would- have used
18 # (since cursor_class is inherited Class::Accessor::Grouped type)
19 my $inner_class = (ref $storage)->cursor_class;
20 my $inner = $inner_class->new(@_);
21 if ($attrs->{cache_for}) {
24 cache_for => delete $attrs->{cache_for},
25 cache_object => delete $attrs->{cache_object},
26 # this must be here to ensure the deletes have happened
27 cache_key => $class->_build_cache_key(@_),
30 return bless(\%args, $class);
32 return $inner; # return object that -would- have been constructed.
37 return @{($self->{data} ||= $self->_fill_data)->[$self->{pos}++]||[]};
42 return @{$self->{data} ||= $self->_fill_data};
49 sub _build_cache_key {
50 my ($class, $storage, $args, $attrs) = @_;
51 # compose the query and bind values, like as_query(),
52 # so the cache key is only affected by what the database sees
53 # and not any other cruft in $attrs
54 my $ref = $storage->_select_args_to_query(@{$args}[0..2], $attrs);
55 my $connect_info = $storage->_dbi_connect_info;
56 my ($dbname, $username);
57 if (ref($connect_info->[0]) eq 'CODE') {
58 my $dbh = $connect_info->[0]->();
59 $dbname = $dbh->{Name};
60 $username = $dbh->{Username} || '';
62 $dbname = $connect_info->[0];
63 $username = $connect_info->[1] || '';
66 local $Storable::canonical = 1;
67 return Digest::SHA1::sha1_hex(Storable::nfreeze( [ $ref, $dbname, $username ] ));
73 my $cache = $self->{cache_object};
74 my $key = $self->{cache_key};
75 return $cache->get($key) || do {
76 my $data = [ $self->{inner}->all ];
77 $cache->set($key, $data, $self->{cache_for});
84 $self->{cache_object}->remove($self->{cache_key});
88 sub cache_key { shift->{cache_key} }
94 DBIx::Class::Cursor::Cached - cursor class with built-in caching support
98 my $schema = SchemaClass->connect(
99 $dsn, $user, $pass, { cursor_class => 'DBIx::Class::Cursor::Cached' }
102 $schema->default_resultset_attributes({
103 cache_object => Cache::FileCache->new({ namespace => 'SchemaClass' }),
106 my $rs = $schema->resultset('CD')->search(undef, { cache_for => 300 });
108 my @cds = $rs->all; # fills cache
110 $rs = $schema->resultset('CD')->search(undef, { cache_for => 300 });
113 @cds = $rs->all; # uses cache, no SQL run
115 $rs->cursor->clear_cache; # deletes data from cache
117 @cds = $rs->all; # refills cache
121 Matt S Trout <mst@shadowcat.co.uk> http://www.shadowcat.co.uk/
123 Initial development sponsored by and (c) Takkle, Inc. 2007
127 This library is free software under the same license as perl itself