1
# This program is copyright 2009-2011 Percona Inc.
2
# Feedback and improvements are welcome.
4
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
5
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
6
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
8
# This program is free software; you can redistribute it and/or modify it under
9
# the terms of the GNU General Public License as published by the Free Software
10
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
11
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
14
# You should have received a copy of the GNU General Public License along with
15
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
16
# Place, Suite 330, Boston, MA 02111-1307 USA.
17
# ###########################################################################
18
# MemcachedEvent package $Revision: 7096 $
19
# ###########################################################################
20
package MemcachedEvent;
22
# This package creates events suitable for mk-query-digest
23
# from psuedo-events created by MemcachedProtocolParser.
24
# Since memcached is not strictly MySQL stuff, we have to
25
# fabricate MySQL-like query events from memcached.
27
# See http://code.sixapart.com/svn/memcached/trunk/server/doc/protocol.txt
28
# for information about the memcached protocol.
31
use warnings FATAL => 'all';
32
use English qw(-no_match_vars);
35
$Data::Dumper::Indent = 1;
36
$Data::Dumper::Sortkeys = 1;
37
$Data::Dumper::Quotekeys = 0;
39
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
41
# cmds that we know how to handle.
42
my %cmds = map { $_ => 1 } qw(
56
my %cmd_handler_for = (
57
set => \&handle_storage_cmd,
58
add => \&handle_storage_cmd,
59
replace => \&handle_storage_cmd,
60
append => \&handle_storage_cmd,
61
prepend => \&handle_storage_cmd,
62
cas => \&handle_storage_cmd,
63
get => \&handle_retr_cmd,
64
gets => \&handle_retr_cmd,
68
my ( $class, %args ) = @_;
70
return bless $self, $class;
73
# Given an event from MemcachedProtocolParser, returns an event
74
# more suitable for mk-query-digest.
76
my ( $self, %args ) = @_;
77
my $event = $args{event};
80
if ( !$event->{cmd} || !$event->{key} ) {
81
MKDEBUG && _d('Event has no cmd or key:', Dumper($event));
85
if ( !$cmds{$event->{cmd}} ) {
86
MKDEBUG && _d("Don't know how to handle cmd:", $event->{cmd});
90
# For a normal event, arg is the query. For memcached, the "query" is
91
# essentially the cmd and key, so this becomes arg. E.g.: "set mk_key".
92
$event->{arg} = "$event->{cmd} $event->{key}";
93
$event->{fingerprint} = $self->fingerprint($event->{arg});
94
$event->{key_print} = $self->fingerprint($event->{key});
96
# Set every cmd so that aggregated totals will be correct. If we only
97
# set cmd that we get, then all cmds will show as 100% in the report.
98
# This will create a lot of 0% cmds, but --[no]zero-bool will remove them.
99
# Think of events in a Percona-patched log: the attribs like Full_scan are
100
# present for every event.
101
map { $event->{"Memc_$_"} = 'No' } keys %cmds;
102
$event->{"Memc_$event->{cmd}"} = 'Yes'; # Got this cmd.
103
$event->{Memc_error} = 'No'; # A handler may change this.
104
$event->{Memc_miss} = 'No';
105
if ( $event->{res} ) {
106
$event->{Memc_miss} = 'Yes' if $event->{res} eq 'NOT_FOUND';
109
# This normally happens with incr and decr cmds.
110
MKDEBUG && _d('Event has no res:', Dumper($event));
113
# Handle special results, errors, etc. The handler should return the
114
# event on success, or nothing on failure.
115
if ( $cmd_handler_for{$event->{cmd}} ) {
116
return $cmd_handler_for{$event->{cmd}}->($event);
122
# Replace things that look like placeholders with a ?
124
my ( $self, $val ) = @_;
125
$val =~ s/[0-9A-Fa-f]{16,}|\d+/?/g;
129
# Possible results for storage cmds:
130
# - "STORED\r\n", to indicate success.
132
# - "NOT_STORED\r\n" to indicate the data was not stored, but not
133
# because of an error. This normally means that either that the
134
# condition for an "add" or a "replace" command wasn't met, or that the
135
# item is in a delete queue (see the "delete" command below).
137
# - "EXISTS\r\n" to indicate that the item you are trying to store with
138
# a "cas" command has been modified since you last fetched it.
140
# - "NOT_FOUND\r\n" to indicate that the item you are trying to store
141
# with a "cas" command did not exist or has been deleted.
142
sub handle_storage_cmd {
145
# There should be a result for any storage cmd.
146
if ( !$event->{res} ) {
147
MKDEBUG && _d('No result for event:', Dumper($event));
151
$event->{'Memc_Not_Stored'} = $event->{res} eq 'NOT_STORED' ? 'Yes' : 'No';
152
$event->{'Memc_Exists'} = $event->{res} eq 'EXISTS' ? 'Yes' : 'No';
157
# Technically, the only results for a retrieval cmd are the values requested.
158
# "If some of the keys appearing in a retrieval request are not sent back
159
# by the server in the item list this means that the server does not
160
# hold items with such keys (because they were never stored, or stored
161
# but deleted to make space for more items, or expired, or explicitly
162
# deleted by a client)."
163
# Contrary to this, MemcacedProtocolParser will set res='VALUE' on
164
# success, res='NOT_FOUND' on failure, or res='INTERRUPTED' if the get
166
sub handle_retr_cmd {
169
# There should be a result for any retr cmd.
170
if ( !$event->{res} ) {
171
MKDEBUG && _d('No result for event:', Dumper($event));
175
$event->{'Memc_error'} = $event->{res} eq 'INTERRUPTED' ? 'Yes' : 'No';
180
# handle_delete() and handle_incr_decr_cmd() are stub subs in case we
183
# Possible results for a delete cmd:
184
# - "DELETED\r\n" to indicate success
186
# - "NOT_FOUND\r\n" to indicate that the item with this key was not
193
# Possible results for an incr or decr cmd:
194
# - "NOT_FOUND\r\n" to indicate the item with this value was not found
196
# - <value>\r\n , where <value> is the new value of the item's data,
197
# after the increment/decrement operation was carried out.
198
# On success, MemcachedProtocolParser sets res='' and val=the new val.
199
# On failure, res=the result and val=''.
200
sub handle_incr_decr_cmd {
206
my ($package, undef, $line) = caller 0;
207
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
208
map { defined $_ ? $_ : 'undef' }
210
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
215
# ###########################################################################
216
# End MemcachedEvent package
217
# ###########################################################################
added
removed
lib/MemcachedEvent.pm
