在mod_perl處理程序的不同模塊中使用方法

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 ，然后再進行測試以確保緩存存儲的正確結構。