File Coverage

blib/lib/Devel/KYTProf/Profiler/Redis/Fast.pm

Criterion	Covered	Total	%
statement	14	32	43.7
branch	0	10	0.0
condition	0	3	0.0
subroutine	5	8	62.5
pod	0	2	0.0
total	19	55	34.5

package Devel::KYTProf::Profiler::Redis::Fast;
use 5.012001;
use strict;
use warnings;
use Redis::Fast;

our $VERSION = "0.01";

sub strip {
    my $s = shift;
    if (length($s) > 255) {
        return substr($s, 0, 252) . "...";
    }
    return $s;
}

sub apply {
    # command for a key
    Devel::KYTProf->add_prof(
        'Redis::Fast',
        '__std_cmd',
        sub {
            my ($orig, $self, $cmd, @args) = @_;
            my $data = {
                command => uc($cmd),
            };
            if (lc($cmd) =~ /get/ && lc($cmd) ne "getset") {
                $data->{key} = strip(join(" ", @args));
            }
            else {
                $data->{key} = @args > 0 ? strip($args[0]) : "";
            }
            return [
                '%s %s',
                ['command', 'key'],
                $data,
            ];
        },
    );

    for my $cmd (qw/ ping quit shutdown keys select info subscribe psubscribe unsubscribe punsubscribe /) {
        Devel::KYTProf->add_prof(
            'Redis::Fast',
            $cmd,
            sub {
                my ($orig, $self, @args) = @_;
                my $data = {
                    command => uc($cmd),
                };
                if (@args > 0) {
                    if ($cmd =~ /subscribe/) {
                        pop @args; # remove subref
                    }
                    $data->{args} = strip(join(" ", @args));
                    return ['%s %s', ['command', 'args'], $data];
                }
                return ['%s', ['command'], $data];
            },
        );
    }
}

1;
__END__