File Coverage

blib/lib/App/Memcached/Tool/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::Tool::Util;
2              
3 3     3   503 use strict;
  3         5  
  3         92  
4 3     3   14 use warnings;
  3         5  
  3         75  
5 3     3   48 use 5.008_001;
  3         13  
6              
7 3     3   12 use Exporter 'import';
  3         3  
  3         84  
8 3     3   1465 use POSIX 'strftime';
  3         16250  
  3         16  
9 3     3   4507 use Time::HiRes 'gettimeofday';
  3         3285  
  3         10  
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   882 use App::Memcached::Tool;
  3         26  
  3         68  
20 3     3   340 use App::Memcached::Tool::Constants ':all';
  3         4  
  3         318  
21              
22 3     3   14 use version; our $VERSION = 'v0.9.2';
  3         3  
  3         12  
23              
24             sub looks_like_addr {
25 14     14 0 19 my $string = shift;
26 14 50       31 return $string if is_unixsocket($string);
27              
28 14         21 my $hostname = $string;
29 14 100       46 if ($hostname =~ m/([^\s:]+):\d+/) {
30 2         4 $hostname = $1;
31             }
32 14 100       470760 return $string if gethostbyname($hostname);
33              
34 9         160 return;
35             }
36              
37             sub create_addr {
38 20     20 0 4054 my $base_addr = shift;
39 20 100       80 return DEFAULT_ADDR() unless $base_addr;
40 11 50       24 return $base_addr if is_unixsocket($base_addr);
41 11 100       76 return $base_addr if ($base_addr =~ m/([^\s:]+):\d+/);
42 6         23 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::Tool::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 25     25 0 31 my $file = shift;
55 25 50 33     569 return 1 if (-e $file && -S $file);
56 25         58 return;
57             }
58              
59             1;
60             __END__