App-Memcached-Tool

 view release on metacpan or  search on metacpan

lib/App/Memcached/Tool/Util.pm  view on Meta::CPAN

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__

=encoding utf-8

=head1 NAME

App::Memcached::Tool::Util - Utility function set

=head1 SYNOPSIS

    use App::Memcached::Tool::Util ':all';
    if (looks_like_addr($given)) {
        ...
    }
    my $addr = is_unixsocket($given) ? $given : create_addr($hostname);
    debug "foo";

=head1 DESCRIPTION

App::Memcached::Tool::Util provides utility functions for other modules.

=head1 LICENSE

Copyright (C) YASUTAKE Kiyoshi.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR

YASUTAKE Kiyoshi E<lt>yasutake.kiyoshi@gmail.comE<gt>

=cut



( run in 2.034 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )