line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::Memcached::Tool::CLI; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
15363
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
64
|
|
4
|
2
|
|
|
2
|
|
9
|
use warnings; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
54
|
|
5
|
2
|
|
|
2
|
|
36
|
use 5.008_001; |
|
2
|
|
|
|
|
5
|
|
6
|
|
|
|
|
|
|
|
7
|
2
|
|
|
2
|
|
1609
|
use Getopt::Long qw(:config posix_default no_ignore_case no_ignore_case_always); |
|
2
|
|
|
|
|
20308
|
|
|
2
|
|
|
|
|
11
|
|
8
|
2
|
|
|
2
|
|
460
|
use List::Util qw(first); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
184
|
|
9
|
|
|
|
|
|
|
|
10
|
2
|
|
|
2
|
|
294
|
use App::Memcached::Tool; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
45
|
|
11
|
2
|
|
|
2
|
|
339
|
use App::Memcached::Tool::DataSource; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
55
|
|
12
|
2
|
|
|
2
|
|
8
|
use App::Memcached::Tool::Util ':all'; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
219
|
|
13
|
|
|
|
|
|
|
|
14
|
2
|
|
|
2
|
|
10
|
use version; our $VERSION = 'v0.9.2'; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
10
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
my @MODES = qw(display dump stats settings sizes help man); |
17
|
|
|
|
|
|
|
my $DEFAULT_MODE = $MODES[0]; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub new { |
20
|
0
|
|
|
0
|
0
|
0
|
my $class = shift; |
21
|
0
|
|
|
|
|
0
|
my %params = @_; |
22
|
|
|
|
|
|
|
$params{ds} |
23
|
|
|
|
|
|
|
= App::Memcached::Tool::DataSource->connect( |
24
|
|
|
|
|
|
|
$params{addr}, timeout => $params{timeout} |
25
|
0
|
|
|
|
|
0
|
); |
26
|
|
|
|
|
|
|
|
27
|
0
|
|
|
|
|
0
|
bless \%params, $class; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub parse_args { |
31
|
15
|
|
|
15
|
0
|
18517
|
my $class = shift; |
32
|
|
|
|
|
|
|
|
33
|
15
|
|
|
|
|
25
|
my %params; # will be passed to new() |
34
|
15
|
100
|
100
|
|
|
72
|
if (defined $ARGV[0] and looks_like_addr($ARGV[0])) { |
35
|
5
|
|
|
|
|
31
|
$params{addr} = shift @ARGV; |
36
|
|
|
|
|
|
|
} |
37
|
15
|
100
|
100
|
66
|
|
235
|
if (defined $ARGV[0] and first { $_ eq $ARGV[0] } @MODES) { |
|
66
|
|
|
|
|
204
|
|
38
|
8
|
|
|
|
|
46
|
$params{mode} = shift @ARGV; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
GetOptions( |
42
|
15
|
50
|
|
|
|
143
|
\my %opts, 'addr|a=s', 'mode|m=s', 'timeout|t=i', |
43
|
|
|
|
|
|
|
'debug|d', 'help|h', 'man', |
44
|
|
|
|
|
|
|
) or return +{}; |
45
|
15
|
50
|
|
|
|
7049
|
warn "Unevaluated args remain: @ARGV" if (@ARGV); |
46
|
|
|
|
|
|
|
|
47
|
15
|
100
|
|
|
|
91
|
if (defined $opts{man}) { |
48
|
2
|
|
|
|
|
5
|
$params{mode} = 'man'; |
49
|
|
|
|
|
|
|
} |
50
|
15
|
100
|
|
|
|
48
|
if (defined $opts{help}) { |
51
|
3
|
|
|
|
|
7
|
$params{mode} = 'help'; |
52
|
|
|
|
|
|
|
} |
53
|
15
|
50
|
|
|
|
35
|
if (defined $opts{debug}) { |
54
|
0
|
|
|
|
|
0
|
$App::Memcached::Tool::DEBUG = 1; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
%params = ( |
58
|
|
|
|
|
|
|
addr => create_addr($params{addr} || $opts{addr}), |
59
|
|
|
|
|
|
|
mode => $params{mode} || $opts{mode} || $DEFAULT_MODE, |
60
|
|
|
|
|
|
|
timeout => $opts{timeout}, |
61
|
|
|
|
|
|
|
debug => $opts{debug}, |
62
|
15
|
|
66
|
|
|
91
|
); |
|
|
|
66
|
|
|
|
|
63
|
15
|
50
|
|
63
|
|
307
|
unless (first { $_ eq $params{mode} } @MODES) { |
|
63
|
|
|
|
|
83
|
|
64
|
0
|
|
|
|
|
0
|
warn "Invalid mode! $params{mode}"; |
65
|
0
|
|
|
|
|
0
|
delete $params{mode}; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
15
|
|
|
|
|
83
|
return \%params; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub run { |
72
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
73
|
0
|
|
|
|
|
|
debug "[start] $self->{mode} $self->{addr}"; |
74
|
0
|
|
|
|
|
|
my $method = $self->{mode}; |
75
|
0
|
|
|
|
|
|
my $ret = $self->$method; |
76
|
0
|
|
|
|
|
|
$self->{ds}->disconnect; |
77
|
0
|
0
|
|
|
|
|
unless ($ret) { |
78
|
0
|
|
|
|
|
|
warn "Command '$self->{mode}' seems failed. Set '--debug' option if you want to see debug logs."; |
79
|
0
|
|
|
|
|
|
exit 1; |
80
|
|
|
|
|
|
|
} |
81
|
0
|
|
|
|
|
|
debug "[end] $self->{mode} $self->{addr}"; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub display { |
85
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
86
|
|
|
|
|
|
|
|
87
|
0
|
|
|
|
|
|
my %stats; |
88
|
0
|
|
|
|
|
|
my $max = 1; |
89
|
|
|
|
|
|
|
|
90
|
0
|
|
|
|
|
|
my $resp_items = $self->{ds}->query('stats items'); |
91
|
0
|
|
|
|
|
|
for my $line (@$resp_items) { |
92
|
0
|
0
|
|
|
|
|
if ($line =~ m/^STAT items:(\d+):(\w+) (\d+)/) { |
93
|
0
|
|
|
|
|
|
$stats{$1}{$2} = $3; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
0
|
|
|
|
|
|
my $resp_slabs = $self->{ds}->query('stats slabs'); |
98
|
0
|
|
|
|
|
|
for my $line (@$resp_slabs) { |
99
|
0
|
0
|
|
|
|
|
if ($line =~ m/^STAT (\d+):(\w+) (\d+)/) { |
100
|
0
|
|
|
|
|
|
$stats{$1}{$2} = $3; |
101
|
0
|
|
|
|
|
|
$max = $1; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
0
|
|
|
|
|
|
print " # Item_Size Max_age Pages Count Full? Evicted Evict_Time OOM\n"; |
106
|
0
|
|
|
|
|
|
for my $class (1..$max) { |
107
|
0
|
|
|
|
|
|
my $slab = $stats{$class}; |
108
|
0
|
0
|
|
|
|
|
next unless $slab->{total_pages}; |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
my $size |
111
|
|
|
|
|
|
|
= $slab->{chunk_size} < 1024 ? "$slab->{chunk_size}B" |
112
|
0
|
0
|
|
|
|
|
: sprintf("%.1fK", $slab->{chunk_size} / 1024.0) ; |
113
|
|
|
|
|
|
|
|
114
|
0
|
0
|
|
|
|
|
my $full = ($slab->{free_chunks_end} == 0) ? 'yes' : 'no'; |
115
|
|
|
|
|
|
|
printf( |
116
|
|
|
|
|
|
|
"%3d %8s %9ds %7d %7d %7s %8d %8d %4d\n", |
117
|
|
|
|
|
|
|
$class, $size, $slab->{age} || 0, $slab->{total_pages}, |
118
|
|
|
|
|
|
|
$slab->{number} || 0, $full, $slab->{evicted} || 0, |
119
|
0
|
|
0
|
|
|
|
$slab->{evicted_time} || 0, $slab->{outofmemory} || 0, |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
120
|
|
|
|
|
|
|
); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
0
|
|
|
|
|
|
return 1; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub stats { |
127
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
128
|
0
|
|
|
|
|
|
my $response = $self->{ds}->query('stats'); |
129
|
0
|
|
|
|
|
|
my %stats; |
130
|
0
|
|
|
|
|
|
for my $line (@$response) { |
131
|
0
|
0
|
|
|
|
|
if ($line =~ m/^STAT\s+(\S*)\s+(.*)/) { |
132
|
0
|
|
|
|
|
|
$stats{$1} = $2; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
} |
135
|
0
|
|
|
|
|
|
print "# stats - $self->{addr}\n"; |
136
|
0
|
|
|
|
|
|
printf "#%23s %16s\n", 'Field', 'Value'; |
137
|
0
|
|
|
|
|
|
for my $field (sort {$a cmp $b} (keys %stats)) { |
|
0
|
|
|
|
|
|
|
138
|
0
|
|
|
|
|
|
printf ("%24s %16s\n", $field, $stats{$field}); |
139
|
|
|
|
|
|
|
} |
140
|
0
|
|
|
|
|
|
return 1; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
sub settings { |
144
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
145
|
0
|
|
|
|
|
|
my $response = $self->{ds}->query('stats settings'); |
146
|
0
|
|
|
|
|
|
my %stats; |
147
|
0
|
|
|
|
|
|
for my $line (@$response) { |
148
|
0
|
0
|
|
|
|
|
if ($line =~ m/^STAT\s+(\S*)\s+(.*)/) { |
149
|
0
|
|
|
|
|
|
$stats{$1} = $2; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
} |
152
|
0
|
|
|
|
|
|
print "# stats settings - $self->{addr}\n"; |
153
|
0
|
|
|
|
|
|
printf "#%23s %16s\n", 'Field', 'Value'; |
154
|
0
|
|
|
|
|
|
for my $field (sort {$a cmp $b} (keys %stats)) { |
|
0
|
|
|
|
|
|
|
155
|
0
|
|
|
|
|
|
printf ("%24s %16s\n", $field, $stats{$field}); |
156
|
|
|
|
|
|
|
} |
157
|
0
|
|
|
|
|
|
return 1; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub dump { |
161
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
162
|
0
|
|
|
|
|
|
my %items; |
163
|
|
|
|
|
|
|
my $total; |
164
|
|
|
|
|
|
|
|
165
|
0
|
|
|
|
|
|
my $response = $self->{ds}->query('stats items'); |
166
|
0
|
|
|
|
|
|
for my $line (@$response) { |
167
|
0
|
0
|
|
|
|
|
if ($line =~ m/^STAT items:(\d*):number (\d*)/) { |
168
|
0
|
|
|
|
|
|
$items{$1} = $2; |
169
|
0
|
|
|
|
|
|
$total += $2; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
0
|
|
|
|
|
|
print STDERR "Dumping memcache contents\n"; |
174
|
0
|
|
|
|
|
|
printf STDERR " Number of buckets: %d\n", scalar(keys(%items)); |
175
|
0
|
|
|
|
|
|
print STDERR " Number of items : $total\n"; |
176
|
|
|
|
|
|
|
|
177
|
0
|
|
|
|
|
|
for my $bucket (sort(keys %items)) { |
178
|
0
|
|
|
|
|
|
print STDERR "Dumping bucket $bucket - " . $items{$bucket} . " total items\n"; |
179
|
0
|
|
|
|
|
|
$response = $self->{ds}->query("stats cachedump $bucket $items{$bucket}"); |
180
|
|
|
|
|
|
|
|
181
|
0
|
|
|
|
|
|
my %expires; |
182
|
0
|
|
|
|
|
|
for my $line (@$response) { |
183
|
|
|
|
|
|
|
# Ex) ITEM foo [6 b; 1176415152 s] |
184
|
0
|
0
|
|
|
|
|
if ($line =~ m/^ITEM (\S+) \[.* (\d+) s\]/) { |
185
|
0
|
|
|
|
|
|
$expires{$1} = $2; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
0
|
|
|
|
|
|
for my $key (keys %expires) { |
190
|
0
|
|
|
|
|
|
my $data = $self->{ds}->get($key); |
191
|
0
|
|
|
|
|
|
print "add $key $data->{flags} $expires{$key} $data->{length}\r\n$data->{value}\r\n"; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
0
|
|
|
|
|
|
return 1; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
sub sizes { |
199
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
200
|
0
|
|
|
|
|
|
my $response = $self->{ds}->query('stats sizes'); |
201
|
0
|
|
|
|
|
|
my %stats; |
202
|
0
|
|
|
|
|
|
for my $line (@$response) { |
203
|
0
|
0
|
|
|
|
|
if ($line =~ m/^STAT\s+(\S*)\s+(.*)/) { |
204
|
0
|
|
|
|
|
|
$stats{$1} = $2; |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
} |
207
|
0
|
|
|
|
|
|
print "# stats sizes - $self->{addr}\n"; |
208
|
0
|
|
|
|
|
|
printf "#%17s %12s\n", 'Size', 'Count'; |
209
|
0
|
|
|
|
|
|
for my $field (sort {$a cmp $b} (keys %stats)) { |
|
0
|
|
|
|
|
|
|
210
|
0
|
|
|
|
|
|
printf ("%18s %12s\n", $field, $stats{$field}); |
211
|
|
|
|
|
|
|
} |
212
|
0
|
|
|
|
|
|
return 1; |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
1; |
216
|
|
|
|
|
|
|
__END__ |