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
