Question

I’m pretty new to Perl and trying to convert some PHP code to Perl. What has my mind boggled all morning is the array (de)referencing, all kinds of brackets etc. I am making a mistake in here somewhere, but can’t seem to find out what exactly. Below is the PHP code I’m trying to convert to 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;
    }
}

What this does, essentially is the following:
It retrieves some DNS records (type==SRV) and stores them in memcache (max. 30 seconds, so we won’t get in trouble with DNS provided TTL’s any more than 30 seconds).
The SRVPicker (and MCache) Class(es) do have some other methods wich I’ve stripped from this example because they don’t matter.

The essence here is that SRVPicker has a private property $records which stores DNS results; these are retrieved from Memcache or the DNS server when the Memcache key cannot be found.

This is what I’ve got in Perl so far:
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

As far as I’ve understood from http://perldoc.perl.org/perlintro.html#OO-Perl and http://www.perlmeme.org/howtos/using_perl/dereferencing.html the $self->{_records} should give the SRVPicker a private property named _records? But that is not the issue at hand…

The output is as follows:
First run:

$# perl test.pl 
*** FROM CACHE:
*********
5
==========

Second run:

$# 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
==========

As you can see, the first run the results get stored and the second run retrieved correctly(?) from the cache. What I can’t get my head around is why

print "*********\n", Dumper($self->{_records}), "==========\n";

Keeps giving me a count instead of the array contents. I’ve played with all kind of notations trying to store the results correctly and been messing with [{@var}], $var, ($var), [$var] and all kinds of variations with @, [], () and {} but can’t get it to work.

My questions:

1. What exactly would the return statement in RetrieveSRVrecords have to look like to return a useful array (returning the results from the grep statement would be fine too, as that (should be) an array of DNS records). In all my messing around I ended up with pushing “anonymous hashes”(?) on an array variable
2. What should the sytax of the $memd->set statement be to store the exact result of the RetrieveSRVrecords records and not an array of an array of the results etc.
3. What should the return statement of GetSRVRecords look like?

I know this is a lot to ask for but after reading a lot of resources and googling around and playing all day I’m suspecting that I’m missing a click here.

Answer 1

It’s a problem of list vs. scalar context. This line in new():

$self->{_records} = $self->GetSRVRecords( ... )

Is scalar context. When retrieving from memcached, that’s OK because it’s going to return a scalar with a reference to an array. But when it calls RetrieveSRVRecords(), it returns a list, which is converted to a scalar by showing the length of the list.

The solution is as simple as having RetrieveSRVRecords() return a reference to an array:

return \@result;