[Bio] / PPO / DBObjectCache.pm Repository:
ViewVC logotype

View of /PPO/DBObjectCache.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (download) (as text) (annotate)
Thu Dec 13 21:22:07 2007 UTC (11 years, 11 months ago) by paarmann
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, rast_rel_2014_0912, rast_rel_2008_06_18, mobedac_release_05302012, mgrast_dev_05262011, rast_rel_2008_12_18, mgrast_dev_04082011, rast_rel_2008_07_21, rast_rel_2010_0928, rast_2008_0924, mgrast_version_3_2, mgrast_dev_12152011, rast_rel_2008_04_23, rast_rel_2008_06_16, mgrast_dev_06072011, rast_rel_2008_09_30, rast_rel_2009_0925, rast_rel_2010_0526, rast_rel_2014_0729, mgrast_dev_02212011, rast_rel_2010_1206, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2010_0118, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, rast_rel_2009_02_05, rast_rel_2011_0119, mgrast_rel_2008_0625, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_2, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, rast_rel_2008_10_09, mgrast_dev_04012011, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, rast_rel_2009_07_09, rast_rel_2010_0827, mgrast_rel_2008_1110, myrast_33, rast_rel_2011_0928, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, mgrast_dev_04052011, mgrast_dev_02222011, rast_rel_2009_03_26, mgrast_dev_10262011, rast_rel_2008_11_24, rast_rel_2008_08_07, HEAD
Changes since 1.3: +11 -3 lines
limited the size of the cache

package DBObjectCache;

# DBObjectCache - object cache manager for PPO

# $Id: DBObjectCache.pm,v 1.4 2007/12/13 21:22:07 paarmann Exp $

use strict;
use warnings;

use constant SIZE => 65535;

my $object_cache;

1;

=pod

=head1 NAME

DBObjectCache - object cache manager for PPO

=head1 OBJECT CACHE

The Persistent Perl Objects utilise an object cache which limits each instance 
of DBMaster or DBObject to one perl object representation. Querying or dereferencing
objects will automatically update the internal cache and hand out an existing object
if present.

=head1 METHODS

=over 4

=item * B<init> ()

Returns the reference to the global object cache.

=cut

sub init {

  unless (defined $object_cache) {
    my $class = shift;
    my $this = { '_cache' => {},
	         'recent' => [],
	       };
    $object_cache = bless $this, $class;
  }

  return $object_cache;
}


=pod

=item * B<master_to_cache> (I<DBMaster>)

Stores a DBMaster in the cache and initialises the cache for that database.

=cut

sub master_to_cache {
  my ($self, $master) = @_;

  unless (ref $master and $master->isa('DBMaster')) {
    die 'No DBMaster given.';
  }

  unless (exists $self->{'_cache'}->{$master->backend->type}) {
    $self->{'_cache'}->{$master->backend->type} = {};
  }

  unless (exists $self->{'_cache'}->{$master->backend->type}->{$master->database} and
	  ref $self->{'_cache'}->{$master->backend->type}->{$master->database}->{'master'}) {
    $self->{'_cache'}->{$master->backend->type}->{$master->database} = {};
    $self->{'_cache'}->{$master->backend->type}->{$master->database}->{'master'} = $master;
  }
  
}


=pod

=item * B<master_from_cache> ()

If possible, returns a DBMaster for that database from the cache. 
Returns undef else.

=cut

sub master_from_cache {
  my ($self, $backend, $database) = @_;

  unless (defined $backend) {
    die 'No backend type given.';
  }

  unless (defined $database) {
    die 'No database name given.';
  }
  
  if (exists $self->{'_cache'}->{$backend} and
      exists $self->{'_cache'}->{$backend}->{$database} and
      ref $self->{'_cache'}->{$backend}->{$database}->{'master'}) {
    return $self->{'_cache'}->{$backend}->{$database}->{'master'};
  }
  
  return undef;
}


=pod

=item * B<object_to_cache> (I<DBObject>)

Stores an object in the cache.

=cut

sub object_to_cache {
  my ($self, $object) = @_;
  
  unless (ref $object and $object->isa('DBObject')) {
    die 'No DBObject given.';
  }
  
  my $backend = $object->_master->backend->type;
  my $db = $object->_master->database();

  unless (exists $self->{'_cache'}->{$backend} and
	  exists $self->{'_cache'}->{$backend}->{$db}) {
    die 'Object cache not initialised for this database.';
  }

  my $class = $object->_class();
  unless (exists $self->{'_cache'}->{$backend}->{$db}->{$class}) {
    $self->{'_cache'}->{$backend}->{$db}->{$class} = {};
  }

  my $id = $object->_id();
  unless (ref $self->{'_cache'}->{$backend}->{$db}->{$class}->{$id}) {
    $self->{'_cache'}->{$backend}->{$db}->{$class}->{$id} = $object;

    if (scalar(@{$self->{'recent'}}) > SIZE) {
      $self->delete_object(shift @{$self->{'recent'}});
    }
    push @{$self->{'recent'}}, $object;

  }
  
}


=pod

=item * B<object_from_cache> (I<database_name>, I<class>, I<id>)

If possible, returns the object described by the unique triplet database name, 
class and id. Else it returns undef.

=cut

sub object_from_cache {
  my ($self, $master, $class, $id) = @_;

  unless (defined $master and $master->isa('DBMaster')) {
    die 'No DBMaster given given.';
  }

  unless (defined $class) {
    die 'No class name given.';
  }

  unless (defined $id) {
    die 'No object id given.';
  }
  

  my $backend = $master->backend->type;
  my $db = $master->database();

  unless (exists $self->{'_cache'}->{$backend} and
	  exists $self->{'_cache'}->{$backend}->{$db} and
	  exists $self->{'_cache'}->{$backend}->{$db}->{$class} and
	  ref $self->{'_cache'}->{$backend}->{$db}->{$class}->{$id}
	 ) {
    return $self->{'_cache'}->{$backend}->{$db}->{$class}->{$id};
  }
  
  return undef;
}


=pod

=item * B<delete_object> (I<DBObject>)

Deletes an object from the cache.

=cut

sub delete_object {
  my ($self, $object) = @_;
  
  unless (ref $object and $object->isa('DBObject')) {
    die 'No DBObject given.';
  }
  
  my $backend = $object->_master->backend->type;
  my $db = $object->_master->database();

  unless (exists $self->{'_cache'}->{$backend} and
	  exists $self->{'_cache'}->{$backend}->{$db}) {
    die 'Object cache not initialised for this database.';
  }
  
  my $class = $object->_class();
  my $id = $object->_id();

  if (exists $self->{'_cache'}->{$backend}->{$db}->{$class} and
      exists $self->{'_cache'}->{$backend}->{$db}->{$class}->{$id}) {
    delete $self->{'_cache'}->{$backend}->{$db}->{$class}->{$id};
  }
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3