Я довольно новичок в Perl и пытаюсь преобразовать некоторый PHP-код в Perl.То, что поражало мой разум все утро, - это ссылки на массивы (де), всевозможные скобки и т. Д. Я где-то ошибаюсь здесь, но не могу понять, что именно.Ниже приведен код PHP, который я пытаюсь преобразовать в perl:
$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 имеет частное свойство $ records, в котором хранятсяРезультаты DNS;они извлекаются из Memcache или DNS-сервера, когда ключ Memcache не может быть найден.
Это то, что у меня есть в 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] и всеми видами вариаций с @, [], () и {}, но не могу заставить его работать.
Мои вопросы:
- Как должен выглядеть оператор return в RetrieveSRVrecords для возврата полезного массива (возвращаярезультаты из оператора grep тоже подойдут, так как это (должно быть) массив записей DNS).Во время всех моих бездельников я заканчивал тем, что нажимал «анонимные хэши» (?) На переменную массива
- Каким должен быть синтаксис оператора $ memd-> set для хранения точного результата записей RetrieveSRVrecords ине массив массива результатов и т. д.
- Как должен выглядеть оператор возврата GetSRVRecords?
Я знаю, что это много, но после прочтения многоресурсов и поисков и игр весь день, я подозреваю, что мне не хватает клика здесь.