在modperl处理程序的不同模块中使用方法

Question

我想在不同的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方法的三个调用。那么我做错了什么？如何解决问题并在不同的处理程序之间共享缓存变量？

Answer 1

您的缓存将只在给定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一次，以确保缓存存储的结构正确。