#!/usr/bin/env perl
# Copyright (c) 2009, Marco Fontani <mfontani@cpan.org>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#     * Redistributions of source code must retain the above copyright
#       notice, this list of conditions and the following disclaimer.
#     * Redistributions in binary form must reproduce the above copyright
#       notice, this list of conditions and the following disclaimer in the
#       documentation and/or other materials provided with the distribution.
#     * The names of its contributors may not be used to endorse or promote products
#       derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED ''AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
# IN NO EVENT SHALL Marco Fontani BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
use strict;
use warnings;
use Cache::Memcached::Fast;
use YAML;
use Getopt::Long;
use File::Slurp;
use 5.010_000;

### Sane defaults
my @servers = ('127.0.0.1:11211');
my $namespace = '';
my $key = '';
my $sfname = '';
my $lfname = '';
my $list = 0;

my $rc = GetOptions(
  'namespace=s' => \$namespace,
  'key=s' => \$key,
  'server=s' => \@servers,
  'save=s' => \$sfname,
  'load=s' => \$lfname,
  'list' => \$list,
);
die "Need at least a server to connect to: use --server\n" if (!@servers);
die "File doesn't exist -- cannot load\n" if ($lfname && ! -f $lfname);
if (@ARGV) {
  $namespace = shift @ARGV;
}
if (@ARGV) {
  $key = shift @ARGV;
}
die "Need a namespace to operate on: use --namespace\n" if ($namespace =~ /^\s*$/);
die "Need a key to operate on: use --key\n" if ($key =~ /^\s*$/);

my $cache = new Cache::Memcached::Fast({
  servers => \@servers,
  namespace => $namespace,
  connect_timeout => 0.2,
  io_timeout => 0.5,
});

say "Server versions:";
say Dump($cache->server_versions);

### Loads the key=>value contents of $lfname on to memcached
### either one key or all keys with --list
if ($lfname)  {
  $cache->set($key,scalar read_file($lfname));
  say "Set $key to contents of file $lfname";
  if ($list) {
    my $data = Load(scalar read_file($lfname . '-list'));
    foreach my $item (keys %$data) {
      $cache->set($item, $data->{$item});
    }
    say "Set " . (scalar keys %$data) . " keys from list";
  }
}

### Saves the key=>value contents of $lfname on to memcached
### either one key or all keys with --list
if ($sfname) {
  write_file($sfname,$cache->get($key));
  say "Saved $key value to $sfname";
  if ($list) {
    my @list = grep { $_ ne '' } split(/\,/,$cache->get($key));
    my $data = {};
    foreach my $item (@list) {
      $data->{$item} = $cache->get($item);
    }
    write_file($sfname . '-list', Dump($data));
    say "Saved all data to $sfname-list";
  }
}

### Just output the contents of the key on that namespace
say "Namespace $namespace key $key:";
say Dump($cache->get($key) // "Key $key not found");