我想在不同的perl模块之间共享一个变量。所以我创建了一个名为MyCache.pm的perl模块,它保存变量(在我的例子中是一个哈希变量):
package PerlModules::MyCache;
my %cache = ();
sub set {
my ($key, $value) = @_;
$cache{$key} = $value;
}
sub get {
my ($key) = @_;
return $cache{$key};
}
现在我有两个处理程序。一个处理程序将调用set方法,另一个将调用get方法来访问信息。
package PerlModules::MyCacheSetter;
use Apache2::RequestRec();
use Apache2::RequestIO();
use Apache2::Const -compile => qw(OK);
use PerlModules::MyCache;
sub handler {
my $r = shift;
PerlModules::MyCache::set('test1', "true");
PerlModules::MyCache::set('test2', "false");
PerlModules::MyCache::set('test3', "true");
return Apache2::Const::OK;
}
这是getter处理程序:
package PerlModules::MyCacheGetter;
use Apache2::RequestRec();
use Apache2::RequestIO();
use Apache2::Const -compile => qw(OK);
use PerlModules::MyCache;
sub handler {
my $r = shift;
$r->print(PerlModules::MyCache::get('test1'));
$r->print(PerlModules::MyCache::get('test2'));
$r->print(PerlModules::MyCache::get('test3'));
return Apache2::Const::OK;
}
现在我已经配置了apache(通过http.conf)来访问这些perl模块。我运行setter处理程序然后运行getter,但是没有输出。
在error.log中现在有一些条目:
Use of uninitialized value in subroutine entry at ../MyCacheGetter.pm line 14.
Use of uninitialized value in subroutine entry at ../MyCacheGetter.pm line 15.
Use of uninitialized value in subroutine entry at ../MyCacheGetter.pm line 16.
这行是get方法的三次调用。那么我做错了什么?如何解决问题并在不同处理程序之间共享缓存变量?
答案 0 :(得分:0)
您的缓存仅在给定Apache子进程的生命周期内存在。如果你想让其他进程看到它,你需要将它存储在他们都能得到它的地方。
这是未经测试的,但你可以得到一般的想法:(现已测试)。
编辑:好的,似乎您可以通过Storable
获得一些问题,具体取决于您正在运行的perl版本和Storable
版本。在我的示例中,我已将Storable
替换为Data::Serialize
。我还在get
/ set
方法中添加了一行,以便可以使用->
或::
语法。
package PerlModules::MyCache;
use IPC::ShareLite qw/:lock/;
use Data::Serializer;
use 5.10.0;
my $key = 1234; # Your shared memory key (you set this!)
my $ipc = IPC::ShareLite->new(
-key => $key,
-create => 'yes',
-destroy => 'no'
);
my $ser = Data::Serializer->new(
serializer => 'Data::Dumper'
);
sub set {
shift @_ if $_[0] eq __PACKAGE__;
my ($key, $value) = @_;
$ipc->lock(LOCK_EX);
my $frozen; eval { $frozen = $ipc->fetch; };
my $cache = defined($frozen) ? $ser->thaw($frozen) : {};
$cache->{$key} = $value;
$ipc->store($ser->freeze($cache));
$ipc->unlock;
return $value;
}
sub get {
shift @_ if $_[0] eq __PACKAGE__;
my ($key) = @_;
my $frozen; eval { $frozen = $ipc->fetch; };
my $cache = defined($frozen) ? $ser->thaw($frozen) : {};
return $cache->{$key};
}
sub clear {
shift @_ if $_[0] eq __PACKAGE__;
$ipc->store($ser->freeze({}));
return {};
}
1;
您可能希望在测试前运行PerlModules::MyCache->clear
一次,以确保缓存存储的正确结构。