So, once upon a time, I bought the Eagle and realized I had purchased a
small slice of heaven.

One of the shiny golden nuggets I received from said slice was a shared
memory cache.  It was simple, it was elegant, it was perfect.  It was also
based on IPC::Shareable.  GREAT idea.  BAD juju.

The code in expire_old_accounts is creating a new tied ARRAYREF instead of
replacing the value of the hash key on this line:

    $ACCOUNTS{'QUEUE'} = [@accounts]; #also tried \@accounts;

This didn't happen w/ IPC::Shareable 0.52.  But 0.6 is apparently very
different, and I can't make the code look like it wants, so the new
reference is a replacement, not an autovivication.

HELP!

My code follows:

use vars qw/%ACCOUNTS/;

sub handler {

...
    # bind accounts structure to shared memory
    bind_accounts() unless defined(%ACCOUNTS) && tied(%ACCOUNTS);

    my $accountinfo = lookup_account($account)
      or $r->log_reason("no such account: $account"), return
HTTP_NO_CONTENT;

}

# Bind the account variables to shared memory using IPC::Shareable
sub bind_accounts {
    warn "bind_accounts: Binding shared memory" if $debug;

    unless (tied(%ACCOUNTS)) {
        tie (%ACCOUNTS,
             'IPC::Shareable',
             SIGNATURE,
             { create => 1,
               destroy => 0,
               mode => 0666,
             }
            ) or die "Couldn't bind shared memory: $!\n";
    }
    warn "bind_accounts: done" if $debug;
}

# bring the current session to the front and
# get rid of any that haven't been used recently
sub expire_old_accounts {
    my $id = shift;
    warn "expire_old_accounts: entered\n" if $debug;

    tied(%ACCOUNTS)->shlock;
    my @accounts = grep($id ne $_, @{$ACCOUNTS{'QUEUE'}});
    unshift @accounts, $id;
    if (@accounts > MAX_ACCOUNTS) {
        my $to_delete = pop @accounts;
        delete $ACCOUNTS{$to_delete};
    }
    $ACCOUNTS{'QUEUE'} = [@accounts]; #also tried \@accounts;
    tied(%ACCOUNTS)->shunlock;

    warn "expire_old_accounts: done\n" if $debug;
}


sub lookup_account {
   my $id = shift;

   warn "lookup_account: begin" if $debug;
   expire_old_accounts($id);

   warn "lookup_account: Accessing \$ACCOUNTS{$id}" if $debug;
   my $s = $ACCOUNTS{$id};

   if ($s and @{$s->{cat}}) {
       # SUCCESSFUL CACHE HIT
       warn "lookup_account: Retrieved accountinfo from Cache (bypassing
SQL)" if $debug;
       warn Data::Dumper->Dump([$s],[qw/s/]) if $debug;
       return $s;
   }

   ## NOT IN CACHE... refreshing.

   warn "lookup_account: preparing SQL" if $debug;

        # ... look up some data here.  store in $s

   warn "lookup_account: locking shared mem" if $debug;
   tied(%ACCOUNTS)->shlock;
   warn "lookup_account: assigning \$s to shared mem" if $debug;
   $ACCOUNTS{$id} = $s;
   warn "Just stored a value", Data::Dumper->Dump([$ACCOUNTS{$id}],[qw/s/])
if $debug;
   warn "lookup_account: unlocking shared mem" if $debug;
   tied(%ACCOUNTS)->shunlock;

   return $s;

}


TIA!

L8r,
Rob

Reply via email to