| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package App::Memcached::CLI::Item; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 2 |  |  | 2 |  | 6 | use strict; | 
|  | 2 |  |  |  |  | 2 |  | 
|  | 2 |  |  |  |  | 45 |  | 
| 4 | 2 |  |  | 2 |  | 4 | use warnings; | 
|  | 2 |  |  |  |  | 3 |  | 
|  | 2 |  |  |  |  | 32 |  | 
| 5 | 2 |  |  | 2 |  | 24 | use 5.008_001; | 
|  | 2 |  |  |  |  | 4 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 2 |  |  | 2 |  | 6 | use POSIX 'strftime'; | 
|  | 2 |  |  |  |  | 2 |  | 
|  | 2 |  |  |  |  | 10 |  | 
| 8 |  |  |  |  |  |  |  | 
| 9 | 2 |  |  | 2 |  | 107 | use App::Memcached::CLI::Util ':all'; | 
|  | 2 |  |  |  |  | 2 |  | 
|  | 2 |  |  |  |  | 193 |  | 
| 10 |  |  |  |  |  |  |  | 
| 11 | 2 |  |  | 2 |  | 7 | use version; our $VERSION = 'v0.9.4'; | 
|  | 2 |  |  |  |  | 2 |  | 
|  | 2 |  |  |  |  | 6 |  | 
| 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__ |