File Coverage

blib/lib/App/Memcached/CLI/Util.pm
Criterion Covered Total %
statement 41 45 91.1
branch 11 16 68.7
condition 1 3 33.3
subroutine 12 13 92.3
pod 0 4 0.0
total 65 81 80.2


line stmt bran cond sub pod time code
1             package App::Memcached::CLI::Util;
2              
3 3     3   443 use strict;
  3         3  
  3         68  
4 3     3   9 use warnings;
  3         3  
  3         49  
5 3     3   36 use 5.008_001;
  3         12  
6              
7 3     3   9 use Exporter 'import';
  3         3  
  3         74  
8 3     3   1256 use POSIX 'strftime';
  3         13415  
  3         12  
9 3     3   3839 use Time::HiRes 'gettimeofday';
  3         2859  
  3         13  
10              
11             our @EXPORT_OK = qw(
12             looks_like_addr
13             create_addr
14             is_unixsocket
15             debug
16             );
17             our %EXPORT_TAGS = (all => \@EXPORT_OK);
18              
19 3     3   861 use App::Memcached::CLI;
  3         5  
  3         53  
20 3     3   639 use App::Memcached::CLI::Constants ':all';
  3         3  
  3         269  
21              
22 3     3   12 use version; our $VERSION = 'v0.7.1';
  3         4  
  3         8  
23              
24             sub looks_like_addr {
25 6     6 0 35 my $string = shift;
26 6 50       9 return $string if is_unixsocket($string);
27              
28 6         5 my $hostname = $string;
29 6 100       22 if ($hostname =~ m/([^\s:]+):\d+/) {
30 2         4 $hostname = $1;
31             }
32 6 100       34836 return $string if gethostbyname($hostname);
33              
34 2         27 return;
35             }
36              
37             sub create_addr {
38 11     11 0 1565 my $base_addr = shift;
39 11 100       22 return DEFAULT_ADDR() unless $base_addr;
40 10 50       18 return $base_addr if is_unixsocket($base_addr);
41 10 100       42 return $base_addr if ($base_addr =~ m/([^\s:]+):\d+/);
42 5         16 return join(qw{:}, $base_addr, DEFAULT_PORT());
43             }
44              
45             sub debug {
46 0     0 0 0 my $message = shift;
47 0 0       0 return unless $App::Memcached::CLI::DEBUG;
48 0         0 my ($sec, $usec) = gettimeofday;
49 0         0 printf STDERR "%s.%03d [DEBUG] $message at %s line %d.\n",
50             strftime('%F %T', localtime($sec)), $usec/1000, (caller)[1,2];
51             }
52              
53             sub is_unixsocket {
54 16     16 0 15 my $file = shift;
55 16 50 33     187 return 1 if (-e $file && -S $file);
56 16         30 return;
57             }
58              
59             1;
60             __END__