Rob*_*III 0 arrays perl memcached
我对Perl很新,并试图将一些PHP代码转换为Perl.整个早上我的想法都是阵列(de)引用,各种括号等等.我在这里犯了一个错误,但似乎无法找出究竟是什么.下面是我试图转换为perl的PHP代码:
$sp = new SRVPicker('_foo._bar.mydomain.com', 30);
class SRVPicker {
private $records = array();
public function SRVPicker($host, $expireseconds = 30) {
$this->records = $this->GetSRVRecords($host, $expireseconds);
}
private function GetSRVRecords($host, $expireseconds) {
return MCache::GetCached(sprintf('srvrecord.%s', strtolower($host)), new MCachedFunction(array($this,'RetrieveSRVRecords'), array($host)), $expireseconds);
}
public function RetrieveSRVRecords($host) {
$result = array();
$records = dns_get_record($host, DNS_SRV);
foreach ($records as $r) {
$rec = new SRVRecord($r);
$result[$rec->priority][] = $rec;
}
ksort($result); //Sort by priority
return array_values($result); //Return sorted array but strip array key (not needed anymore)
}
}
class MCache {
public static function GetCached($cachekey, $cachedfunction, $expireseconds = -1) {
if (!($cachedfunction instanceof MCachedFunction))
throw new Exception('cachedfunction parameter is not of type CachedFunction');
//Can we resort to the cache?
if (_USEMEMCACHED && ($expireseconds>=0)) {
$memcache = self::GetMemCache();
$cacheitem = $memcache->get(self::GetKey($cachekey));
if ($cacheitem===false) { //Cache miss
//Go to backend
$result = call_user_func_array($cachedfunction->callback, $cachedfunction->params);
$memcache->set(self::GetKey($cachekey), $result, MEMCACHE_COMPRESSED, $expireseconds); //Store in cache
} else { //Cache hit
$result = $cacheitem;
}
$memcache->close();
return $result;
} else {
//Bypass cache altogether
return call_user_func_array($cachedfunction->callback, $cachedfunction->params);
}
}
private static function GetMemCache() {
$memcache = new Memcache();
$memcache->connect(_MEMCACHEDHOST, _MEMCACHEDPORT);
return $memcache;
}
private static function GetKey($cachekey) {
return _MEMCACHEDPREFIX . $cachekey;
}
}
class MCachedFunction {
public $callback;
public $params;
public function MCachedFunction($callback, $params = array()) {
$this->callback = $callback;
$this->params = $params;
}
}
这样做,基本上如下:它检索一些DNS记录(类型== SRV)并将它们存储在memcache中(最多30秒,因此我们不会遇到DNS提供TTL超过30秒的麻烦).SRVPicker(和MCache)类确实有一些其他方法,我已经从这个例子中剥离了,因为它们并不重要.
这里的本质是SRVPicker有一个存储DNS结果的私有属性$ records; 当找不到Memcache密钥时,会从Memcache或DNS服务器检索这些内容.
这是我到目前为止在Perl中得到的:Test.pl:
use strict;
use warnings;
use SRVPicker;
use Data::Dumper::Concise;
my $picker = SRVPicker->new('_foo._bar.mydomain.com');
SRVPicker.pm:
use strict;
use warnings;
package SRVPicker;
use Net::DNS;
use Cache::Memcached::Fast;
use Data::Dumper::Concise;
use constant _DEFAULTEXPIRESECONDS => 30;
use constant _DEFAULTNAMESPACE => 'pbxos';
sub new {
my $class = shift;
my ($host, $expireseconds, $memcachedservers) = @_;
my $self = bless({
_pointer => 0,
_records => []
}, $class);
$self->{_records} = $self->GetSRVRecords(
$host,
$expireseconds || _DEFAULTEXPIRESECONDS,
$memcachedservers || [ { address => 'localhost:11211' } ]
);
print "*********\n", Dumper($self->{_records}), "==========\n";
return $self;
}
sub Reset {
my $self = shift;
$self->{_pointer} = 0;
}
sub GetSRVRecords {
my $self = shift;
my ($host, $expireseconds, $servers) = @_;
if ($servers) {
my $memd = new Cache::Memcached::Fast({
servers => $servers,
namespace => _DEFAULTNAMESPACE,
connect_timeout => 0.2,
io_timeout => 0.5,
close_on_error => 1,
max_failures => 3,
failure_timeout => 2,
ketama_points => 150,
nowait => 1,
hash_namespace => 1,
utf8 => ($^V ge v5.8.1 ? 1 : 0)
});
my $key = 'srvrecord.' . $host;
my @result = $memd->get($key);
print "*** FROM CACHE:", Dumper(@result), "\n";
if (!@result) {
@result = $self->RetrieveSRVRecords($host);
if (@result) {
$memd->set($key, \@result, $expireseconds);
}
}
$memd->disconnect_all();
return @result;
} else {
return $self->RetrieveSRVRecords($host);
}
}
sub RetrieveSRVRecords {
my $self = shift;
my ($host) = @_;
my $res = Net::DNS::Resolver->new;
my $query = $res->query($host, "SRV");
my @result;
if ($query) {
foreach my $rr (grep { $_->type eq 'SRV' } $query->answer) {
push @result, {
target => $rr->target,
port => $rr->port,
priority => $rr->priority,
weight => $rr->weight,
ttl => $rr->ttl
};
}
}
return @result;
}
1; # so the require or use succeeds
据我所知,http://perldoc.perl.org/perlintro.html#OO-Perl和http://www.perlmeme.org/howtos/using_perl/dereferencing.html $ self - > {_ records应该给SRVPicker一个名为_records的私有属性？但这不是手头的问题......
输出如下:首先运行:
$# perl test.pl
*** FROM CACHE:
*********
5
==========
第二轮:
$# perl test.pl
*** FROM CACHE:[
{
port => 8732,
priority => 10,
target => "pbxsrvtst.mydomain.com",
ttl => 300,
weight => 50
},
{
port => 8732,
priority => 10,
target => "pbxsrvtst.mydomain.com",
ttl => 300,
weight => 40
},
{
port => 8732,
priority => 10,
target => "pbxsrvtst.mydomain.com",
ttl => 300,
weight => 10
},
{
port => 8732,
priority => 0,
target => "pbxsrvtst.mydomain.com",
ttl => 300,
weight => 10
},
{
port => 8732,
priority => 20,
target => "pbxsrvtst.mydomain.com",
ttl => 300,
weight => 10
}
]
*********
1
==========
如您所见,第一次运行结果存储,第二次运行从缓存中正确检索(？).我无法理解的是为什么
print "*********\n", Dumper($self->{_records}), "==========\n";
继续给我一个计数而不是数组内容.我玩过各种各样的符号,试图正确地存储结果并且弄乱了[{@var}],$ var,($ var),[$ var]和@,[]的各种变化,( )和{}但无法使其工作.
我知道这有很多要求但是在阅读了大量资源并在谷歌上搜索并且整天都玩之后我怀疑我在这里错过了一次点击.
小智 7
这是列表与标量上下文的问题.这行在new()中:
$self->{_records} = $self->GetSRVRecords( ... )
是标量上下文.从memcached中检索时,这没关系,因为它将返回一个带有对数组引用的标量.但是当它调用RetrieveSRVRecords()时,它返回一个列表,通过显示列表的长度将其转换为标量.
解决方案就像让RetrieveSRVRecords()返回对数组的引用一样简单:
return \@result;