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   458 use strict;
  3         5  
  3         72  
4 3     3   13 use warnings;
  3         4  
  3         53  
5 3     3   36 use 5.008_001;
  3         7  
6              
7 3     3   14 use Exporter 'import';
  3         4  
  3         89  
8 3     3   771 use POSIX 'strftime';
  3         9854  
  3         13  
9 3     3   3199 use Time::HiRes 'gettimeofday';
  3         2081  
  3         14  
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   854 use App::Memcached::CLI;
  3         6  
  3         60  
20 3     3   687 use App::Memcached::CLI::Constants ':all';
  3         6  
  3         259  
21              
22 3     3   317 use version; our $VERSION = 'v0.9.5';
  3         5  
  3         13  
23              
24             sub looks_like_addr {
25 6     6 0 8 my $string = shift;
26 6 50       11 return $string if is_unixsocket($string);
27              
28 6         20 my $hostname = $string;
29 6 100       24 if ($hostname =~ m/([^\s:]+):\d+/) {
30 2         7 $hostname = $1;
31             }
32 6 100       68844 return $string if gethostbyname($hostname);
33              
34 2         40 return;
35             }
36              
37             sub create_addr {
38 11     11 0 3223 my $base_addr = shift;
39 11 100       25 return DEFAULT_ADDR() unless $base_addr;
40 10 50       21 return $base_addr if is_unixsocket($base_addr);
41 10 100       47 return $base_addr if ($base_addr =~ m/([^\s:]+):\d+/);
42 5         20 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 25 my $file = shift;
55 16 50 33     236 return 1 if (-e $file && -S $file);
56 16         54 return;
57             }
58              
59             1;
60             __END__