File Coverage

blib/lib/App/Memcached/CLI/Item.pm
Criterion Covered Total %
statement 17 92 18.4
branch 0 26 0.0
condition 0 16 0.0
subroutine 6 19 31.5
pod 0 10 0.0
total 23 163 14.1


line stmt bran cond sub pod time code
1             package App::Memcached::CLI::Item;
2              
3 2     2   937 use strict;
  2         4  
  2         44  
4 2     2   7 use warnings;
  2         3  
  2         44  
5 2     2   24 use 5.008_001;
  2         5  
6              
7 2     2   399 use POSIX 'strftime';
  2         5972  
  2         37  
8              
9 2     2   1438 use App::Memcached::CLI::Util ':all';
  2         4  
  2         171  
10              
11 2     2   11 use version; our $VERSION = 'v0.9.5';
  2         3  
  2         7  
12              
13             my @FIELDS = qw(key value length expire flags cas);
14             my %DISP_METHOD_OF = (
15             value => 'disp_value',
16             length => 'disp_length',
17             expire => 'disp_expire',
18             );
19              
20             my $DISPLAY_DATA_LENGTH = 320;
21              
22             sub new {
23 0     0 0   my $class = shift;
24 0           my %data = @_;
25 0           bless \%data, $class;
26             }
27              
28             sub find {
29 0     0 0   my $class = shift;
30 0           my $keys = shift;
31 0           my $ds = shift;
32 0           my %opt = @_;
33              
34 0   0       my $command = $opt{command} || 'get';
35 0           my $list = $ds->$command($keys);
36 0           my @items;
37 0           for my $data (@$list) {
38 0           push(@items, bless($data, $class));
39             }
40              
41 0           return \@items;
42             }
43              
44             sub save {
45 0     0 0   my $self = shift;
46 0           my $ds = shift;
47 0           my %opt = @_;
48              
49 0           for my $key (qw/flags expire value/) {
50 0 0         if ($opt{$key}) { $self->{$key} = $opt{$key}; }
  0            
51             }
52             my %option = (
53             flags => $self->{flags},
54             expire => $self->{expire},
55 0           );
56              
57 0   0       my $command = $opt{command} || 'set';
58 0 0         if ($command eq 'cas') {
59 0           return $ds->$command(@$self{qw/key value cas/}, %option);
60             } else {
61 0           return $ds->$command(@$self{qw/key value/}, %option);
62             }
63             }
64              
65             sub remove {
66 0     0 0   my $self = shift;
67 0           my $ds = shift;
68 0           my $ret = $ds->delete($self->{key});
69 0           return $ret;
70             }
71              
72             sub output {
73 0     0 0   my $self = shift;
74 0           my $space = q{ } x 4;
75 0           for my $key (@FIELDS) {
76 0           my $value = $self->{$key};
77 0 0         if (my $_method = $DISP_METHOD_OF{$key}) {
78 0           $value = $self->$_method;
79             }
80 0 0         next unless defined $value;
81 0           printf "%s%6s:%s%s\n", $space, $key, $space, $value;
82             }
83             }
84              
85             sub output_line {
86 0     0 0   my $self = shift;
87 0           $self->{disp_max_value_length} = 100;
88              
89 0           my @kv;
90 0           for my $key (@FIELDS) {
91 0           my $value = $self->{$key};
92 0 0         if (my $_method = $DISP_METHOD_OF{$key}) {
93 0           $value = $self->$_method;
94             }
95 0 0         next unless defined $value;
96 0           push @kv, join(q{:}, ucfirst $key, $value);
97             }
98 0           printf "%s\n", join("\t", @kv);
99             }
100              
101             sub disp_length {
102 0     0 0   my $self = shift;
103             $self->{disp_length} ||= sub {
104 0 0   0     return unless (defined $self->{length});
105 0           my $length = $self->{length};
106 0 0         if ($length >= 1024) {
107 0           return sprintf '%.1fKB', $length / 1024.0;
108             }
109 0           return "${length}B";
110 0   0       }->();
111 0           return $self->{disp_length};
112             }
113              
114             sub disp_expire {
115 0     0 0   my $self = shift;
116             $self->{disp_expire} ||= sub {
117 0 0   0     return unless (defined $self->{expire});
118 0           return strftime('%F %T', localtime($self->{expire}));
119 0   0       }->();
120 0           return $self->{disp_expire};
121             }
122              
123             sub disp_value {
124 0     0 0   my $self = shift;
125 0           my $text = $self->value_text;
126 0 0         return unless (defined $text);
127              
128 0   0       my $max_length = $self->{disp_max_value_length} || $DISPLAY_DATA_LENGTH;
129 0 0         return $text if (length $text <= $max_length);
130              
131 0           my $length = length $text;
132 0           my $result = substr($text, 0, $max_length - 1);
133 0           $result .= '...(skipped)';
134 0           return $result;
135             }
136              
137             sub value_text {
138 0     0 0   my $self = shift;
139             $self->{value_text} ||= sub {
140 0 0   0     return unless (defined $self->{value});
141 0 0         if ($self->{value} !~ m/^[\x21-\x7e\s]/) {
142 0           return '(Not ASCII)';
143             }
144 0           return $self->{value};
145 0   0       }->();
146 0           return $self->{value_text};
147             }
148              
149             1;
150             __END__