#!/usr/bin/perl
#
=head1 NAME

Memcached - A Plugin to monitor Memcached Servers

=head1 MUNIN CONFIGURATION

[memcached_*]
 env.host 127.0.0.1     *default*
 env.port 11211         *default*

=head2 MUNIN ENVIRONMENT CONFIGURATION EXPLANATION

 host = host we are going to monitor
 port = port we are connecting to, in order to gather stats

=head1 NODE CONFIGURATION

Please make sure you can telnet to your memcache servers and issue the
 following commands: stats

Available Graphs contained in this Plugin

bytes => This graphs the current network traffic in and out

commands => This graphs the current commands being issued to the memcache machine.

conns => This graphs the current, max connections as well as avg conns per sec avg conns per sec is derived from total_conns / uptime.

evictions => This graphs the current evictions on the node.

items => This graphs the current items and total items in the memcached node.

memory => This graphs the current and max memory allocation. 

The following example holds true for all graphing options in this plugin.
 Example: ln -s /usr/share/munin/plugins/memcached_ /etc/munin/plugins/memcached_bytes

=head1 ACKNOWLEDGEMENTS

The core of this plugin is based on the mysql_ plugin maintained by Kjell-Magne Ãierud

Thanks to dormando as well for putting up with me ;)

=head1 AUTHOR

Matt West < https://code.google.com/p/memcached-munin-plugin/ >

=head1 LICENSE

GPLv2

=head1 MAGIC MARKERS

    #%# family=manual
    #%# capabilities=autoconf suggest

=cut

use strict;
use IO::Socket;

my $host = $ENV{host} || "127.0.0.1";
my $port = $ENV{port} || 11211;

my %stats;
# This hash contains the information contained in two memcache commands
# stats and stats settings.

# So I was trying to figure out how to build this up, and looking at some good examples
# I decided to use the format, or for the most part, the format from the mysql_ munin plugin
# for Innodb by Kjell-Magne Ãierud, it just spoke ease of flexibility especially with multigraphs
# thanks btw ;)
#
# %graphs   is a container for all of the graph definition information. In here is where you'll
#           find the configuration information for munin's graphing procedure.
#   Format:
#
#   $graph{graph_name} => {
#       config => {
#           # You'll find keys and values stored here for graph manipulation
#       },
#       datasrc => [
#           # Name: name given to data value
#           # Attr: Attribute for given value
#           { name => 'Name', (Attr) },
#           { ... },
#       ],
#   }
my %graphs;

$graphs{items} = {
    config => {
        args => '--base 1000 --lower-limit 0',
        vlabel => 'Items in Memcached',
        category => 'memcached',
        title => 'Items',
        info => 'This graph shows the number of items in use by memcached',
    },
    datasrc => [
        { name => 'curr_items', label => 'Current Items', min => '0' },
        { name => 'total_items', label => 'New Items', min => '0', type => 'DERIVE' },
    ],
};

$graphs{memory} = {
    config => {
        args => '--base 1024 --lower-limit 0',
        vlabel => 'Bytes Used',
        category => 'memcached',
        title => 'Memory Usage',
        info => 'This graph shows the memory consumption of memcached',
    },
    datasrc => [
        { name => 'limit_maxbytes', draw => 'AREA', label => 'Maximum Bytes Allocated', min => '0' },
        { name => 'bytes', draw => 'AREA', label => 'Current Bytes Used', min => '0' },
    ],
};

$graphs{bytes} = {
    config => {
        args => '--base 1000',
        vlabel => 'bits in (-) / out (+)',
        title => 'Network Traffic',
        category => 'memcached',
        info => 'This graph shows the network traffic in (-) / out (+) of the machine',
        order => 'bytes_read bytes_written',
    },
    datasrc => [
        { name => 'bytes_read', type => 'DERIVE', label => 'Network Traffic coming in (-)', graph => 'no', cdef => 'bytes_read,8,*', min => '0' },
        { name => 'bytes_written', type => 'DERIVE', label => 'Traffic in (-) / out (+)', negative => 'bytes_read', cdef => 'bytes_written,8,*', min => '0' },
    ],
};

$graphs{conns} = {
    config => {
        args => '--base 1000 --lower-limit 0',
        vlabel => 'Connections per ${graph_period}',
        category => 'memcached',
        title => 'Connections',
        info => 'This graph shows the number of connections being handled by memcached',
        order => 'curr_conns avg_conns',
    },
    datasrc => [
        { name => 'curr_conns', label => 'Current Connections', min => '0' },
        { name => 'avg_conns' , label => 'Avg Connections', min => '0' },
    ],
};

$graphs{commands} = {
    config => {
        args => '--base 1000 --lower-limit 0',
        vlabel => 'Commands per ${graph_period}',
        category => 'memcached',
        title => 'Commands',
        info => 'This graph shows the number of commands being handled by memcached',
    },
    datasrc => [
        { name => 'cmd_get', type => 'DERIVE', label => 'Gets', info => 'Cumulative number of retrieval reqs', min => '0' },
        { name => 'cmd_set', type => 'DERIVE', label => 'Sets', info => 'Cumulative number of storage reqs', min => '0' },
        { name => 'get_hits', type => 'DERIVE', label => 'Get Hits', info => 'Number of keys that were requested and found', min => '0' },
        { name => 'get_misses', type => 'DERIVE', label => 'Get Misses', info => 'Number of keys there were requested and not found', min => '0' },
    ],
};

$graphs{evictions} = {
    config => {
        args => '--base 1000 --lower-limit 0',
        vlabel => 'Evictions per ${graph_period}',
        category => 'memcached',
        title => 'Evictions',
        info => 'This graph shows the number of evictions per second',
    },
    datasrc => [
        { name => 'evictions', label => 'Evictions', info => 'Cumulative Evictions Across All Slabs', type => 'DERIVE', min => '0' },
    ],
};

##
#### Config Check ####
##

if (defined $ARGV[0] && $ARGV[0] eq 'config') {

    $0 =~ /memcached_(.+)*/;
    my $plugin = $1;

    die 'Unknown Plugin Specified: ' . ($plugin ? $plugin : '') unless $graphs{$plugin};

    # We need to fetch the stats before we do any config, cause its needed for multigraph
    fetch_stats();

    # Now lets go ahead and print out our config.
	do_config($plugin);
	exit 0;
}

##
#### Autoconf Check ####
##

if (defined $ARGV[0] && $ARGV[0] eq 'autoconf') {

    my $s = IO::Socket::INET->new(
        Proto    => "tcp",
        PeerAddr => $host,
        PeerPort => $port,
    );

    if (defined($s)) {
        print "yes\n";
        exit 0;
    } else {
        print "no (unable to connect to $host\[:$port\])\n";
        exit 0;
    }
}

##
#### Suggest Check ####
##

if (defined $ARGV[0] && $ARGV[0] eq 'suggest') {

    my $s = IO::Socket::INET->new(
        Proto    => "tcp",
        PeerAddr => $host,
        PeerPort => $port,
    );

    if (defined($s)) {
        my @rootplugins = ('bytes','conns','commands','evictions','items','memory');
        foreach my $plugin (@rootplugins) {
            print "$plugin\n";
        }
        exit 0;
    } else {
        print "no (unable to connect to $host\[:$port\])\n";
        exit 0;
    }
}

##
#### Well We aren't running (auto)config/suggest so lets print some stats ####
##

fetch_output();

##
#### Subroutines for printing info gathered from memcached ####
##

##
#### This subroutine performs the bulk processing for printing statistics.
##

sub fetch_output {

    $0 =~ /memcached_(.+)*/;
    my $plugin = $1;

    die 'Unknown Plugin Specified: ' . ($plugin ? $plugin : '') unless $graphs{$plugin};

    # Well we need to actually fetch the stats before we do anything to them.
    fetch_stats();
    
    # Now lets go ahead and print out our output.
    print_root_output($plugin);

    return;
}

##
#### This subroutine is for the root non-multigraph graphs which render on the main node page ####
##

sub print_root_output {
    my ($plugin) = (@_);

    my $graph = $graphs{$plugin};

    #print "graph memcached_$plugin\n";

    if ($plugin ne 'conns') {
        foreach my $dsrc (@{$graph->{datasrc}}) {
            my %datasrc = %$dsrc;
            while ( my ($key, $value) = each(%datasrc)) {
                next if ($key ne 'name');
                my $output = $stats{$value};
                print "$dsrc->{name}.value $output\n";
            }
        }
    } else {
        my $output;
        foreach my $dsrc (@{$graph->{datasrc}}) {
            my %datasrc = %$dsrc;
            while ( my ($key, $value) = each(%datasrc)) {
                if ($value eq 'curr_conns') {
                    $output = $stats{curr_connections};
                } elsif ($value eq 'avg_conns') {
                    $output = sprintf("%02d", $stats{total_connections} / $stats{uptime});
                } else {
                    next;
                }
                print "$dsrc->{name}.value $output\n";
            }
        }
    }

    return;
}

##
#### Subroutines for printing out config information for graphs ####
##

##
#### This subroutine does the bulk printing the config info per graph ####
##

sub do_config {
    my ($plugin) = (@_);
    print_root_config($plugin);

    return;
}

##
#### This subroutine is for the config info for non multigraph graphs which render on the main node page ####
##

sub print_root_config {
    my ($plugin) = (@_);

    die 'Unknown Plugin Specified: ' . ($plugin ? $plugin : '') unless $graphs{$plugin};

    my $graph = $graphs{$plugin};

    my %graphconf = %{$graph->{config}};

    #print "graph memcached_$plugin\n";

    while ( my ($key, $value) = each(%graphconf)) {
        print "graph_$key $value\n";
    }

    foreach my $dsrc (@{$graph->{datasrc}}) {
        my %datasrc = %$dsrc;
        while ( my ($key, $value) = each(%datasrc)) {
            next if ($key eq 'name');
            print "$dsrc->{name}.$key $value\n";
        }
    }

    return;
}

##
#### This subroutine actually performs the data fetch for us ####
#### These commands do not lock up Memcache at all ####
##

sub fetch_stats {
    my $s = IO::Socket::INET->new(
        Proto    => "tcp",
        PeerAddr => $host,
        PeerPort => $port,
    );

    die "Error: Unable to Connect to $host\[:$port\]\n" unless $s;

    print $s "stats\r\n";

    while (my $line = <$s>) {
        if ($line =~ /STAT\s(.+?)\s(\d+)/) {
            my ($skey,$svalue) = ($1,$2);
            $stats{$skey} = $svalue;
        }
        last if $line =~ /^END/;
    }
}