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   491 use strict;
  3         3  
  3         83  
4 3     3   10 use warnings;
  3         2  
  3         52  
5 3     3   39 use 5.008_001;
  3         12  
6              
7 3     3   8 use Exporter 'import';
  3         3  
  3         74  
8 3     3   1210 use POSIX 'strftime';
  3         19211  
  3         15  
9 3     3   3010 use Time::HiRes 'gettimeofday';
  3         1028  
  3         15  
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   801 use App::Memcached::CLI;
  3         3  
  3         62  
20 3     3   681 use App::Memcached::CLI::Constants ':all';
  3         5  
  3         278  
21              
22 3     3   11 use version; our $VERSION = 'v0.9.4';
  3         3  
  3         9  
23              
24             sub looks_like_addr {
25 6     6 0 8 my $string = shift;
26 6 50       15 return $string if is_unixsocket($string);
27              
28 6         9 my $hostname = $string;
29 6 100       47 if ($hostname =~ m/([^\s:]+):\d+/) {
30 2         5 $hostname = $1;
31             }
32 6 100       107073 return $string if gethostbyname($hostname);
33              
34 2         39 return;
35             }
36              
37             sub create_addr {
38 11     11 0 2211 my $base_addr = shift;
39 11 100       42 return DEFAULT_ADDR() unless $base_addr;
40 10 50       25 return $base_addr if is_unixsocket($base_addr);
41 10 100       58 return $base_addr if ($base_addr =~ m/([^\s:]+):\d+/);
42 5         25 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 23 my $file = shift;
55 16 50 33     298 return 1 if (-e $file && -S $file);
56 16         48 return;
57             }
58              
59             1;
60             __END__