Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

DB_Cache

by quidity (Pilgrim)
on Nov 29, 2000 at 09:58 UTC ( [id://43856]=sourcecode: print w/replies, xml ) Need Help??
Category: Databases
Author/Contact Info Alex Gough (quidity)
Description: A small package which reduces the number of times a database needs to be queried when multiple execute methods are called on a statement handle when some of them may be the same.
package DB_Cache;
use strict;

=head1 DB_Cache: caching of SELECT calls with DBI

By Alex Gough, 2000.  You may use and redistribute
this code under the same terms as perl itself.

=head1 Description

A small package which reduces the number of times a database
needs to be queried when multiple execute methods are called
on a statement handle when some of them may be the same.

=head1 Synopsis

 use strict;
 use DBI;
 use DB_Cache;

 my $dbh = DBI->connect('DBI:mysql:testcache','cache', 'test');
 my $sth = $dbh->prepare('SELECT * FROM foo WHERE col1 = ?');

 my $cached_sth = DB_Cache->new($sth);

 while (my $href = $cached_sth->fetchrow_hashref('value')) {
   foreach (keys %$href) {
     print "$_:${$href}{$_}\n";
   }
 }

 while (my $ref = $cached_sth->fetchrow_arrayref('other value')) {
   print join ':', @{$ref};
   print "\n";
 }

 $cached_sth->finish;
 $dbh->disconnect;

=head1 Waffle

Cached statment handles are created by handing a prepared
statment handle to this package using the new method.

The first time a query is made, the statment is executed
and the first relevant row returned (undef otherwise).
Other rows are fetched by the package and stored for later
use.  These can be requested by repeated fetch calls to the
cached handle, undef is returned once all rows have been
returned.

The next time the handle is queried, the rows are returned
again, without the database being contacted again.

Three fetching methods are provided, fetchrow_array,
fetchrow_arrayref and fetchrow_hashref.  The first two
both use the same call to the database, while
fetchrow_hashref uses its own call, so if the database
changes between a hash and array fetch, they will have
different contents.  Of course, if the database is likely
to change, you do not really want to be caching.

=cut

=head2 new

 $cached_handle = DB_Cache->new( [prepared statement handle]  );

=cut

sub new {
  return bless {_statement=> $_[1], # a DBI sth
        _entries=>{},       # holds cached results
        _results=>{},       # holds number of results returned
        _current =>{},      # holds current place in fetch queue
           }, $_[0];
}

=head2 fetchrow_array

  @row = $cached_handle->fetchrow_array( [bind values] );

=cut

sub fetchrow_array { # this just uses fetchrow_arrayref then dereferen
+ces
  my $self = shift;
  my $ref = $self->fetchrow_arrayref(@_);
  return @{$ref} if ref($ref);
  return ();
}

=head2 fetchrow_hashref

  $hash_ref = $cached_handle->fetchrow_hashref( [bind values] );

=cut

sub fetchrow_hashref {
  my $self = shift;
  my $ref = $self->_fetchrow('hash', @_);
  return $ref if ref($ref);
  return undef;
}

=head2 fetchrow_arrayref

  $array_ref = $cached_handle->fetchrow_arrayref( [bind values] );

=cut

sub fetchrow_arrayref {
  my $self = shift;
  my $ref = $self->_fetchrow('array', @_);
  return $ref if ref($ref);
  return undef;
}

=head2 renew

  $cached_handle->renew( [bind values] );

Makes another query to the database for the given bind values.
Refetches either or both of hash and array types, if either is
currently in use.  Returns result of (array getting , hash getting).

=cut

sub renew {
  my $self = shift;
  my @args = @_;
  my ($args, $arv, $hrv);
  $args = join '', map {s/\?/??/g;$_} @args; # the keywords to be exec
+uted by the statement
  if (exists $self->{_entries}{hash}{$args}) {
    delete $self->{_entries}{hash}->{$args};
    $hrv = $self->_fetchrow('hash', @_);
    $self->{_current}{hash}{$args} = $self->{_results}{$args};
  }

  if (exists $self->{_entries}{array}{$args}) {
    delete $self->{_entries}{array}->{$args};
    $arv = $self->_fetchrow('array', @_);
    $self->{_current}{array}{$args} = $self->{_results}{$args};
  }

  return ($arv, $hrv);
}

=head2 finish

  $cached_handle->finish;

This acts like a normal finish call, and frees up the memory being
used to cache any values.  Will not hurt anything which is currently
referenced though.

=cut

sub finish {
  my $self = shift;
  $self->{_statement}->finish;
  %{$self} = ();
  return 1;
}

# This acts like an execute an fetch rolled into one.  The first time 
+this is called
# with a certain set of arguments it will attempt to fetch all relevan
+t rows from
# the database and store them away as appropriate.  If the execute fai
+ls (nothing to
# fetch) it will return a non-reference.  Takes 'array' or 'hash' as f
+irst arg.

sub _fetchrow {
  my $self = shift;
  my $ref_type = shift;
  my @args = @_;
  my $args;
  $args = join '', map {s/\?/??/g;$_} @args; # the keywords to be exec
+uted by the statement

  if (exists $self->{_entries}{$ref_type}{$args}) { # have already got
+ this, release from cache
    my $count = $self->{_current}{$ref_type}{$args}--;
    if ($count == 0) { # the last matching item has already been retur
+ned
      $self->{_current}{$ref_type}{$args} = $self->{_results}{$args}; 
+# reset counter
      return undef;
    }
    return $self->{_entries}{$ref_type}{$args}[-$count];
  }

  my $r = $self->{_statement}->execute(@_);
  return $r if $r < 1; # ie, nothing to fetch
  $self->{_results}{$args} = $r;
  $self->{_current}{$ref_type}{$args} = $r-1; # so the next fetched it
+em is #2
  $self->{_entries}{$ref_type}{$args} = [];

  # fill up array of references to rowhashes or rowarrays, as reqd.

  if ($ref_type eq 'hash') {
    while (my $ref = $self->{_statement}->fetchrow_hashref) {
      push @{$self->{_entries}{$ref_type}{$args}}, $ref;
    }
  }
  elsif ($ref_type eq 'array') {
    while (my $ref = $self->{_statement}->fetchrow_arrayref) {
      push @{$self->{_entries}{$ref_type}{$args}}, $ref;
    }
  }
  else {warn "No reference type supplied"; return undef};

  return $self->{_entries}{$ref_type}{$args}[0]; # return the first fe
+tched value
}

1; # for the grace of God, why?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://43856]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chanting in the Monastery: (4)
As of 2024-03-28 15:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found