File Coverage

blib/lib/App/Memcached/Tool/Util.pm

Criterion	Covered	Total	%
statement	47	51	92.1
branch	13	18	72.2
condition	1	3	33.3
subroutine	14	15	93.3
pod	0	4	0.0
total	75	91	82.4

package App::Memcached::Tool::Util;

use strict;
use warnings;
use 5.008_001;

use Exporter 'import';
use List::Util qw(first);
use POSIX 'strftime';
use Time::HiRes 'gettimeofday';

our @EXPORT_OK = qw(
    looks_like_addr
    create_addr
    is_unixsocket
    debug
);
our %EXPORT_TAGS = (all => \@EXPORT_OK);

use App::Memcached::Tool;
use App::Memcached::Tool::Constants ':all';

use version; our $VERSION = 'v0.9.4';

sub looks_like_addr {
    my $string = shift;
    return $string if is_unixsocket($string);

    my $hostname = $string;
    if (first { $_ eq $string } MODES()) {
        return;
    }
    if ($hostname =~ m/([^\s:]+):\d+/) {
        $hostname = $1;
    }
    return $string if gethostbyname($hostname);

    return;
}

sub create_addr {
    my $base_addr = shift;
    return DEFAULT_ADDR() unless $base_addr;
    return $base_addr if is_unixsocket($base_addr);
    return $base_addr if ($base_addr =~ m/([^\s:]+):\d+/);
    return join(qw{:}, $base_addr, DEFAULT_PORT());
}

sub debug {
    my $message = shift;
    return unless $App::Memcached::Tool::DEBUG;
    my ($sec, $usec) = gettimeofday;
    printf STDERR "%s.%03d [DEBUG] $message at %s line %d.\n",
        strftime('%F %T', localtime($sec)), $usec/1000, (caller)[1,2];
}

sub is_unixsocket {
    my $file = shift;
    return 1 if (-e $file && -S $file);
    return;
}

1;
__END__