[Rt-commit] [svn] r1365 - in DBIx-SearchBuilder/trunk: . SearchBuilder SearchBuilder/Record

jesse at pallas.eruditorum.org jesse at pallas.eruditorum.org
Thu Aug 26 00:11:38 EDT 2004


Author: jesse
Date: Thu Aug 26 00:11:37 2004
New Revision: 1365

Modified:
   DBIx-SearchBuilder/trunk/   (props changed)
   DBIx-SearchBuilder/trunk/Changes
   DBIx-SearchBuilder/trunk/MANIFEST
   DBIx-SearchBuilder/trunk/META.yml
   DBIx-SearchBuilder/trunk/Makefile.PL
   DBIx-SearchBuilder/trunk/SearchBuilder.pm
   DBIx-SearchBuilder/trunk/SearchBuilder/Handle.pm
   DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm
   DBIx-SearchBuilder/trunk/SearchBuilder/Record/Cachable.pm
Log:
 ----------------------------------------------------------------------
 r8386 at tinbook:  jesse | 2004-08-15T16:35:54.518535Z
 
 ----------------------------------------------------------------------
 r8436 at tinbook:  jesse | 2004-08-26T04:09:43.619884Z
 - Reimplemented DBIx::SearchBuilder:::Record::Cachable
           to use Cache::Simple::TimedExpiry. This should make it faster and more
           memory efficient
 
 
 ----------------------------------------------------------------------
 r8437 at tinbook:  jesse | 2004-08-26T04:10:39.266989Z
 Bumping to 1.10_01
 ----------------------------------------------------------------------


Modified: DBIx-SearchBuilder/trunk/Changes
==============================================================================
--- DBIx-SearchBuilder/trunk/Changes	(original)
+++ DBIx-SearchBuilder/trunk/Changes	Thu Aug 26 00:11:37 2004
@@ -1,5 +1,11 @@
 Revision history for Perl extension DBIx::SearchBuilder.
 
+1.10_01 Thu Aug 26 00:08:31 EDT 2004
+        - Reimplemented DBIx::SearchBuilder:::Record::Cachable
+          to use Cache::Simple::TimedExpiry. This should make it faster and more
+          memory efficient.
+
+
 1.02_03 Thu Jul 22 13:29:17 EDT 2004
         - Additional bullet proofing for joins. 
           Now we default to ALIAS1 being "main"  (cubic at acronis.ru)

Modified: DBIx-SearchBuilder/trunk/MANIFEST
==============================================================================
--- DBIx-SearchBuilder/trunk/MANIFEST	(original)
+++ DBIx-SearchBuilder/trunk/MANIFEST	Thu Aug 26 00:11:37 2004
@@ -2,6 +2,7 @@
 Makefile.PL
 MANIFEST
 MANIFEST.SKIP
+Cache/Simple/TimedExpiry.pm
 SearchBuilder.pm
 SearchBuilder/Handle.pm
 SearchBuilder/Union.pm
@@ -9,6 +10,7 @@
 SearchBuilder/Handle/mysql.pm
 SearchBuilder/Handle/mysqlPP.pm
 SearchBuilder/Record/Cachable.pm
+SearchBuilder/Record/CacheCache.pm
 SearchBuilder/Handle/Oracle.pm
 SearchBuilder/Handle/Informix.pm
 SearchBuilder/Handle/SQLite.pm

Modified: DBIx-SearchBuilder/trunk/META.yml
==============================================================================
--- DBIx-SearchBuilder/trunk/META.yml	(original)
+++ DBIx-SearchBuilder/trunk/META.yml	Thu Aug 26 00:11:37 2004
@@ -1,5 +1,5 @@
 name: DBIx-SearchBuilder
-version: 1.02_03
+version: 1.10_01
 license: perl
 distribution_type: module
 build_requires:
@@ -8,6 +8,7 @@
   DBI: 0
   Want: 0
   Class::ReturnValue: 0.4
+  Cache::Simple::TimedExpiry: 0.01
 no_index:
   directory:
     - inc

Modified: DBIx-SearchBuilder/trunk/Makefile.PL
==============================================================================
--- DBIx-SearchBuilder/trunk/Makefile.PL	(original)
+++ DBIx-SearchBuilder/trunk/Makefile.PL	Thu Aug 26 00:11:37 2004
@@ -6,6 +6,7 @@
 requires('DBI');
 requires('Want');
 requires('Class::ReturnValue', 0.40);
+requires( 'Cache::Simple::TimedExpiry' => '0.01');
 build_requires('Test::More');
 
 &Makefile->write;

Modified: DBIx-SearchBuilder/trunk/SearchBuilder.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/SearchBuilder.pm	(original)
+++ DBIx-SearchBuilder/trunk/SearchBuilder.pm	Thu Aug 26 00:11:37 2004
@@ -5,7 +5,7 @@
 use strict;
 use vars qw($VERSION);
 
-$VERSION = "1.02_03";
+$VERSION = "1.10_01";
 
 =head1 NAME
 

Modified: DBIx-SearchBuilder/trunk/SearchBuilder/Handle.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/SearchBuilder/Handle.pm	(original)
+++ DBIx-SearchBuilder/trunk/SearchBuilder/Handle.pm	Thu Aug 26 00:11:37 2004
@@ -6,6 +6,7 @@
 use Class::ReturnValue;
 use vars qw($VERSION @ISA %DBIHandle $PrevHandle $DEBUG $TRANSDEPTH);
 
+
 $TRANSDEPTH = 0;
 
 $VERSION = '$Version$';
@@ -57,6 +58,8 @@
     my $class = ref($proto) || $proto;
     my $self  = {};
     bless ($self, $class);
+
+    @{$self->{'StatementLog'}} = ();
     return $self;
 }
 
@@ -233,6 +236,67 @@
 
 # }}}
 
+=head2 LogSQLStatements BOOL
+
+Takes a boolean argument. If the boolean is true, SearchBuilder will log all SQL
+statements, as well as their invocation times and execution times.
+
+Returns whether we're currently logging or not as a boolean
+
+=cut
+
+sub LogSQLStatements {
+    my $self = shift;
+    if (@_) {
+
+        require Time::HiRes;
+    $self->{'_DoLogSQL'} = shift;
+    return ($self->{'_DoLogSQL'});
+    }
+}
+
+=head2 _LogSQLStatement STATEMENT DURATION
+
+add an SQL statement to our query log
+
+=cut
+
+sub _LogSQLStatement {
+    my $self = shift;
+    my $statement = shift;
+    my $duration = shift;
+    push @{$self->{'StatementLog'}} , ([Time::Hires::time(), $statement, $duration]);
+
+}
+
+=head2 ClearSQLStatementLog
+
+Clears out the SQL statement log. 
+
+
+=cut
+
+sub ClearSQLStatementLog {
+    my $self = shift;
+    @{$self->{'StatementLog'}} = ();
+}   
+
+
+=head2 SQLStatementLog
+
+Returns the current SQL statement log as an array of arrays. Each entry is a triple of 
+
+(Time,  Statement, Duration)
+
+=cut
+
+sub SQLStatementLog {
+    my $self = shift;
+    return  (@{$self->{'StatementLog'}});
+
+}
+
+
 # {{{ AutoCommit
 
 =head2 AutoCommit [MODE]
@@ -406,8 +470,20 @@
             $sth->bind_param($bind_idx+1, undef, $bhash );
         }
     }
-    $self->Log($QueryString. " (".join(',', at bind_values).")") if ($DEBUG);
-    unless ( $sth->execute(@bind_values) ) {
+
+    my $basetime;
+    if ($self->LogSQLStatements) {
+        $basetime = Time::HiRes::time(); 
+    }
+
+    my $executed =$sth->execute(@bind_values);
+
+    if ($self->LogSQLStatements) {
+            $self->_LogSQLStatement($QueryString ,tv_interval ( $basetime ));
+ 
+    }
+
+    unless($executed ) {
         if ($DEBUG) {
             die "$self couldn't execute the query '$QueryString'"
               . $self->dbh->errstr . "\n";

Modified: DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm	(original)
+++ DBIx-SearchBuilder/trunk/SearchBuilder/Record.pm	Thu Aug 26 00:11:37 2004
@@ -896,7 +896,7 @@
     my $id = shift;
 
     $id = 0 if (!defined($id));
-    return ($self->LoadByCols('id',$id));
+    return ($self->LoadByCols(id => $id));
 }
 
 # }}}  
@@ -980,8 +980,6 @@
         $self->{'fetched'}{lc $f} = 1;
     }
 
-    #$self->_DowncaseValuesHash();
-
     ## I guess to be consistant with the old code, make sure the primary  
     ## keys exist.
 
@@ -993,52 +991,6 @@
 
 }
 
-sub _LoadFromSQLold {
-    my $self        = shift;
-    my $QueryString = shift;
-    my @bind_values = (@_);
-
-    my $sth = $self->_Handle->SimpleQuery( $QueryString, @bind_values );
-
-    #TODO this only gets the first row. we should check if there are more.
-
-
-    return($sth) unless ($sth) ;
-
-    my $fetched;
-    eval { $fetched = $sth->fetchrow_hashref() };
-    if ($@) {
-        warn $@;
-    }
-
-    unless ( $fetched ) {
-
-        #warn "something might be wrong here; row not found. SQL: $QueryString";
-        return ( 0, "Couldn't find row" );
-    }
-    
-    foreach my $f ( keys %{$fetched||{}} ) {
-        $self->{'fetched'}->{lc $f} = 1;
-    }
-    
-    $self->{'values'} = $fetched;
-
-    ## I guess to be consistant with the old code, make sure the primary  
-    ## keys exist.
-      #$self->_DowncaseValuesHash();
-    
-        ## I guess to be consistant with the old code, make sure the primary  
-        ## keys exist.
-    
-      eval { $self->PrimaryKeys(); };
-      if ($@) {
-          return ( 0, "Missing a primary key?: $@" );
-      }
-      return ( 1, "Found Object" );
-
-
-}
-
 # }}}
 
 # }}}

Modified: DBIx-SearchBuilder/trunk/SearchBuilder/Record/Cachable.pm
==============================================================================
--- DBIx-SearchBuilder/trunk/SearchBuilder/Record/Cachable.pm	(original)
+++ DBIx-SearchBuilder/trunk/SearchBuilder/Record/Cachable.pm	Thu Aug 26 00:11:37 2004
@@ -1,60 +1,59 @@
 # $Header: /home/jesse/DBIx-SearchBuilder/history/SearchBuilder/Record/Cachable.pm,v 1.6 2001/06/19 04:22:32 jesse Exp $
 # by Matt Knopp <mhat at netlag.com>
 
-package DBIx::SearchBuilder::Record::Cachable; 
+package DBIx::SearchBuilder::Record::Cachable;
 
-use DBIx::SearchBuilder::Record; 
+use DBIx::SearchBuilder::Record;
 use DBIx::SearchBuilder::Handle;
 @ISA = qw (DBIx::SearchBuilder::Record);
 
-my %_RECORD_CACHE = (); 
-my %_KEY_CACHE = (); 
+use Cache::Simple::TimedExpiry;
 
+use strict;
 
-# Function: new 
+my %_CACHES = ();
+
+# Function: new
 # Type    : class ctor
 # Args    : see DBIx::SearchBuilder::Record::new
 # Lvalue  : DBIx::SearchBuilder::Record::Cachable
 
-sub new () { 
-  my ($class, @args) = @_; 
-  my $this = $class->SUPER::new (@args);
- 
-  if ($this->can(_CacheConfig)) { 
-     $this->{'_CacheConfig'}=$this->_CacheConfig();
-  }
-  else {
-     $this->{'_CacheConfig'}=__CachableDefaults::_CacheConfig();
-  }
+sub new () {
+    my ( $class, @args ) = @_;
+    my $self = $class->SUPER::new(@args);
 
-  return ($this);
-}
+    $self->{'_Class'} =
+      ref($self);    # Cache it since we're gonna look at it a _lot_
 
+    if ( $self->can('_CacheConfig') ) {
+        $self->{'_CacheConfig'} = $self->_CacheConfig();
+    }
+    else {
+        $self->{'_CacheConfig'} = __CachableDefaults::_CacheConfig();
+    }
 
+    $self->_SetupCache();
 
-# Function: _RecordCache
-# Type    : private instance
-# Args    : none
-# Lvalue  : hash: RecordCache
-# Desc    : Returns a reference to the record cache hash
-
-sub _RecordCache {
-    my $this = shift;
-    return(\%_RECORD_CACHE);
+    return ($self);
 }
 
-# Function: _KeyCache
-# Type    : private instance
-# Args    : none
-# Lvalue  : hash: KeyCache
-# Desc    : Returns a reference to the Key cache hash
+sub _SetupCache {
+    my $self = shift;
+    $_CACHES{ $self->_Handle->DSN . "-KEYS" } = Cache::Simple::TimedExpiry->new();
+    $_CACHES{ $self->_Handle->DSN   } = Cache::Simple::TimedExpiry->new();
+}
 
 sub _KeyCache {
-    my $this = shift;
-    return(\%_KEY_CACHE);
+    my $self = shift;
+    return ( $_CACHES{ $self->_Handle->DSN . "-KEYS" } );
+
 }
 
+sub _Cache {
+    my $self = shift;
+    return ( $_CACHES{ $self->_Handle->DSN } );
 
+}
 
 # Function: LoadFromHash
 # Type    : (overloaded) public instance
@@ -62,21 +61,21 @@
 # Lvalue  : array(boolean, message)
 
 sub LoadFromHash {
-    my $this = shift;
-    my ($rvalue, $msg) = $this->SUPER::LoadFromHash(@_);
+    my $self = shift;
 
-    my $cache_key = $this->_gen_primary_cache_key();
+    # Blow away the primary cache key since we're loading.
+    $self->{'_SB_Record_Primary_Cache_key'} = undef;
+    my ( $rvalue, $msg ) = $self->SUPER::LoadFromHash(@_);
 
+    $self->{'_id'} = $self->SUPER::id;
+    my $cache_key = $self->_primary_cache_key();
 
-    ## Check the return value, if its good, cache it! 
+    ## Check the return value, if its good, cache it!
     if ($rvalue) {
-     ## Only cache the object if its okay to do so. 
-    if ($this->{'_CacheConfig'}{'cache_p'}) {
-        $this->_store() ;
-    }
+        $self->_store();
     }
 
-    return($rvalue,$msg);
+    return ( $rvalue, $msg );
 }
 
 # Function: LoadByCols
@@ -84,265 +83,217 @@
 # Args    : see DBIx::SearchBuilder::Record::LoadByCols
 # Lvalue  : array(boolean, message)
 
-sub LoadByCols { 
-  my ($this, %attr) = @_; 
+sub LoadByCols {
+    my ( $self, %attr ) = @_;
 
-  ## Generate the cache key
-  my $alternate_key=$this->_gen_alternate_cache_key(%attr);
-  my $cache_key = $this->_lookup_primary_cache_key($alternate_key);
+    # Blow away the primary cache key since we're loading.
+    $self->{'_SB_Record_Primary_Cache_key'} = undef;
+    ## Generate the cache key
+    my $alt_key = $self->_gen_alternate_cache_key(%attr);
+    if ( $self->_fetch( $self->_lookup_primary_cache_key($alt_key) ) ) {
+        return ( 1, "Fetched from cache" );
+    }
 
-  if ($cache_key && exists $this->_RecordCache->{$cache_key}) { 
-    # We should never be caching a record without storing the time
-    $cache_time =( $this->_RecordCache->{$cache_key}{'time'} || 0);
+    ## Fetch from the DB!
+    my ( $rvalue, $msg ) = $self->SUPER::LoadByCols(%attr);
+    ## Check the return value, if its good, cache it!
+    if ($rvalue) {
+        ## Only cache the object if its okay to do so.
+        $self->_store();
+        $self->_KeyCache->set( $alt_key, $self->_primary_cache_key,$self->{'_CacheConfig'}{'cache_for_sec'} + time  );
 
-    ## Decide if the cache object is too old
+        $self->{'_id'} = $self->SUPER::id();
 
-    if ((time() - $cache_time) <= $this->{'_CacheConfig'}{'cache_for_sec'}) {
-	    $this->_fetch($cache_key); 
-	    return (1, "Fetched from cache");
     }
-    else { 
-      $this->_gc_expired();
-    }
-  } 
-
-  ## Fetch from the DB!
-  my ($rvalue, $msg) = $this->SUPER::LoadByCols(%attr);
-  ## Check the return value, if its good, cache it! 
-  if ($rvalue) {
-    ## Only cache the object if its okay to do so. 
-    $this->_store() if ($this->{'_CacheConfig'}{'cache_p'});
-
-    my $new_cache_key = $this->_gen_primary_cache_key();
-    $this->_KeyCache->{$alternate_key} = $new_cache_key;
-    $this->_KeyCache->{$alternate_key}{'time'} = time();
-  } 
-  return ($rvalue, $msg);
+    return ( $rvalue, $msg );
 
 }
 
-
-# Function: _Set
+# Function: __Set
 # Type    : (overloaded) public instance
 # Args    : see DBIx::SearchBuilder::Record::_Set
 # Lvalue  : ?
 
-sub __Set () { 
-  my ($this, %attr) = @_; 
+sub __Set () {
+    my ( $self, %attr ) = @_;
 
-  $this->_expire( $this->_gen_primary_cache_key());
- 
-  return $this->SUPER::__Set(%attr);
+    $self->_expire( $self->_primary_cache_key() );
+    return $self->SUPER::__Set(%attr);
 
 }
 
-
 # Function: Delete
 # Type    : (overloaded) public instance
 # Args    : nil
 # Lvalue  : ?
 
-sub Delete () { 
-  my ($this) = @_; 
-  my $cache_key = $this->_gen_primary_cache_key();
+sub Delete () {
+    my ($self) = @_;
 
-  $this->_expire($cache_key);
- 
-  return $this->SUPER::Delete();
-
-}
+    $self->_expire( $self->_primary_cache_key() );
 
+    return $self->SUPER::Delete();
 
-
-
-
-# Function: _gc_expired
-# Type    : private instance
-# Args    : nil
-# Lvalue  : 1
-# Desc    : Looks at all cached objects and expires if needed. 
-
-sub _gc_expired () { 
-  my ($this) = @_; 
-
-
-  my $time = time();  
-
-  # XXX TODO: do we want to sort the keys beforehand, so we can get out of the loop earlier?
-  foreach my $cache_key (keys %{$this->_KeyCache}, keys %{$this->_RecordCache}) {
-    my $cache_time = $this->_RecordCache->{$cache_key}{'time'} || 0 ;  
-    $this->_expire($cache_key) 
-      if (($time - $cache_time) > $this->{'_CacheConfig'}{'cache_for_sec'});
-  }
 }
 
-
-
-
 # Function: _expire
 # Type    : private instance
 # Args    : string(cache_key)
 # Lvalue  : 1
-# Desc    : Removes this object from the cache. 
+# Desc    : Removes this object from the cache.
 
 sub _expire (\$) {
-  my ($this, $cache_key) = @_; 
-  delete $this->_RecordCache->{$cache_key} if (exists $this->_RecordCache->{$cache_key});
-  return (1);
+    my $self = shift;
+    $self->_Cache->set( $self->_primary_cache_key , undef, time-1);
 }
 
-
-
-
 # Function: _fetch
 # Type    : private instance
 # Args    : string(cache_key)
 # Lvalue  : 1
-# Desc    : Get an object from the cache, and make this object that. 
+# Desc    : Get an object from the cache, and make this object that.
 
-sub _fetch () { 
-  my ($this, $cache_key) = @_;
+sub _fetch () {
+    my ( $self, $cache_key ) = @_;
+    my $data = $self->_Cache->fetch($cache_key);
+    $self->_deserialize($data);
 
-  $this->{'values'}  = $this->_RecordCache->{$cache_key}{'values'};
-  $this->{'fetched'}  = $this->_RecordCache->{$cache_key}{'fetched'};
-  return(1); 
 }
 
-sub __Value {
- my $self = shift;
-  my $field = shift;
-
-    $field = lc $field;
-    my $cache_key = $self->_gen_primary_cache_key();
-    unless ( $cache_key
-           && exists $self->_RecordCache->{$cache_key}{'values'}->{"$field"} ) {
-           return($self->SUPER::__Value($field));
+sub _deserialize {
+    my $self = shift;
+    my $data = shift;
+    foreach my $key ( keys %$data ) {
+        $self->{$key} = $data->{$key};
     }
-   return($self->_RecordCache->{$cache_key}{'values'}->{"$field"});
-
-
 }
 
+sub id {
+    my $self = shift;
+    return ( $self->{'_id'} );
+}
 
+sub __Value {
+    my $self  = shift;
+    my $field = shift;
+    return ( $self->SUPER::__Value($field) );
+}
 
 # Function: _store
 # Type    : private instance
 # Args    : string(cache_key)
 # Lvalue  : 1
-# Desc    : Stores this object in the cache. 
+# Desc    : Stores this object in the cache.
 
-sub _store (\$) { 
-  my ($this) = @_; 
-  my $cache_key = $this->_gen_primary_cache_key();
-  $this->{'_CacheConfig'}{'cache_key'} = $cache_key;
-  $this->_RecordCache->{$cache_key}{'values'} = $this->{'values'};
-  $this->_RecordCache->{$cache_key}{'fetched'} = $this->{'fetched'};
-  $this->_RecordCache->{$cache_key}{'time'} = time();
-  
-  return(1);
+sub _store (\$) {
+    my $self = shift;
+    $self->_Cache->set( $self->_primary_cache_key, $self->_serialize , $self->{'_CacheConfig'}{'cache_for_sec'} + time );
+    return (1);
 }
 
-
-
+sub _serialize {
+    my $self = shift;
+    return (
+        {
+            values  => $self->{'values'},
+            table   => $self->{'table'},
+            fetched => $self->{'fetched'}
+        }
+    );
+}
 
 # Function: _gen_alternate_cache_key
 # Type    : private instance
 # Args    : hash (attr)
 # Lvalue  : 1
-# Desc    : Takes a perl hash and generates a key from it. 
+# Desc    : Takes a perl hash and generates a key from it.
 
 sub _gen_alternate_cache_key {
-    my ( $this, %attr ) = @_;
-    my $cache_key = $this->Table() . ':';
+    my ( $self, %attr ) = @_;
+    my $cache_key = $self->Table() . ':';
     while ( my ( $key, $value ) = each %attr ) {
-        $key ||= '__undef';
+        $key   ||= '__undef';
         $value ||= '__undef';
 
-        if ( ref($value) eq "HASH" ) { 
-            $value = $value->{operator}.$value->{value}; 
-        } else {
-            $value = "=".$value;
-        }    
-        $cache_key .= $key.$value.',';
+        if ( ref($value) eq "HASH" ) {
+            $value = ( $value->{operator} || '=' ) . $value->{value};
+        }
+        else {
+            $value = "=" . $value;
+        }
+        $cache_key .= $key . $value . ',';
     }
     chop($cache_key);
     return ($cache_key);
 }
 
-
 # Function: _fetch_cache_key
 # Type    : private instance
 # Args    : nil
 # Lvalue  : 1
 
 sub _fetch_cache_key {
-    my ($this) = @_;
-    my $cache_key = $this->{'_CacheConfig'}{'cache_key'};
-    return($cache_key);
+    my ($self) = @_;
+    my $cache_key = $self->{'_CacheConfig'}{'cache_key'};
+    return ($cache_key);
 }
 
-
-
-# Function: _gen_primary_cache_key 
+# Function: _primary_cache_key
 # Type    : private instance
 # Args    : none
 # Lvalue: : 1
 # Desc    : generate a primary-key based variant of this object's cache key
-#           primary keys is in the cache 
+#           primary keys is in the cache
 
-sub _gen_primary_cache_key {
-    my ($this) = @_;
+sub _primary_cache_key {
+    my ($self) = @_;
 
+    return undef unless ( $self->Id );
 
-    return undef unless ($this->Id);
+    unless ( $self->{'_SB_Record_Primary_Cache_key'} ) {
 
-    my $primary_cache_key = $this->Table() . ':';
-    my @attributes; 
-    foreach my $key (@{$this->_PrimaryKeys}) {
-        push @attributes, $key.'='.  $this->SUPER::__Value($key);
-    }
+        my $primary_cache_key = $self->Table() . ':';
+        my @attributes;
+        foreach my $key ( @{ $self->_PrimaryKeys } ) {
+            push @attributes, $key . '=' . $self->SUPER::__Value($key);
+        }
 
-    $primary_cache_key .= join(',', at attributes);
+        $primary_cache_key .= join( ',', @attributes );
 
-    return($primary_cache_key);
+        $self->{'_SB_Record_Primary_Cache_key'} = $primary_cache_key;
+    }
+    return ( $self->{'_SB_Record_Primary_Cache_key'} );
 
 }
 
-
-# Function: lookup_primary_cache_key 
+# Function: lookup_primary_cache_key
 # Type    : private class
 # Args    : string(alternate cache id)
 # Lvalue  : string(cache id)
 sub _lookup_primary_cache_key {
-    my $this          = shift;
-    my $alternate_key = shift;  
-    if ( exists $this->_KeyCache->{$alternate_key} ) {
-        $cache_time = $this->_KeyCache->{$alternate_key}{'time'};
-
-        ## Decide if the cache object is too old
-        if ( ( time() - $cache_time ) <=
-             $this->{'_CacheConfig'}{'cache_for_sec'} ) {
-            return $this->_KeyCache->{$alternate_key};
-        }
-        else {
-            $this->_gc_expired();
-        }
+    my $self          = shift;
+    my $alternate_key = shift;
+    my $primary_key   = $self->_KeyCache->fetch($alternate_key);
+    if ($primary_key) {
+        return ($primary_key);
     }
-    # If what we thought was the alternate key was actually the primary key
-    if ($alternate_key && exists $this->_RecordCache->{$alternate_key}) { 
-        return($alternate_key);
+
+    # If the alternate key is really the primary one
+    elsif ( $self->_Cache->fetch($alternate_key) ) {
+        return ($alternate_key);
+    }
+    else {    # empty!
+        return (undef);
     }
-    # not found
-    return (undef);
-}
 
+}
 
-package __CachableDefaults; 
+package __CachableDefaults;
 
-sub _CacheConfig { 
-  { 
-     'cache_p'        => 1,
-     'cache_for_sec'  => 5,
-  }
+sub _CacheConfig {
+    {
+        'cache_p'       => 1,
+        'cache_for_sec' => 5,
+    };
 }
 1;


More information about the Rt-commit mailing list