I write a new MyMemory.pm module. But we have a error again: BerkeleyDB Aborting: Database is already closed at /home/medievalage/cgi-bin/MyMemory.pm line 68.
package MyMemory;
use strict;
use Storable qw(freeze thaw);
use BerkeleyDB;
use Fcntl qw(:DEFAULT);
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
require Exporter;
$VERSION=0.1;
@ISA=qw(Exporter);
@EXPORT=qw(get_memory set_memory);
my $filename = "/home/test/mem.db";
sub new {
my $Proto = shift;
my $Class = ref($Proto) || $Proto;
my %Cache;
my $env = new BerkeleyDB::Env(
-Home => '/tmp',
-Flags => DB_INIT_CDB | DB_CREATE | DB_INIT_MPOOL,
#-Cachesize => 23152000,
)
or die "can't create BerkelyDB::Env: $!";
my $Obj = tie %Cache, 'BerkeleyDB::Btree',
-Filename => $filename,
-Flags => DB_CREATE,
-Mode => 0640,
-Env => $env
or die ("Can't tie to $filename: $!");
my $Self = {
Cache => \%Cache,
Obj => $Obj
};
bless ($Self, $Class);
return $Self;
}
my $bdbobj = new MyMemory();
sub get_memory {
my $Key=shift;
return $bdbobj->get($Key);
}
sub set_memory {
my $Key=shift;
my %Value = @_;
$bdbobj->set($Key,\%Value);
}
sub set {
$_[0]->{Obj}->db_put( $_[1], freeze($_[2]) );
}
sub get {
my $value;
$_[0]->{Obj}->db_get( $_[1], $value );
return thaw( $value );
}
1;
right code please for mod_perl.
|