package Dancer2::Plugin::Redis;
use strictures 1;
# ABSTRACT: Perl Dancer2 plugin for interaction with key-value-store Redis.
#
# This file is part of Dancer2-Plugin-Redis
#
# This software is Copyright (c) 2014 by BURNERSK <burnersk@cpan.org>.
#
# This is free software, licensed under:
#
#   The MIT (X11) License
#

BEGIN {
  our $VERSION = '0.001'; # TRIAL VERSION: generated by DZP::OurPkgVersion
}

use Carp qw( carp croak );
use Dancer2::Core::Types qw( Undef AnyOf InstanceOf );
use Dancer2::Plugin;  # makes this a Moo::Role!
use Redis;
use Safe::Isa;
use Try::Tiny;
use Type::Tiny;


############################################################################

my $TYPE_SERIALIZATIONOBJECT = Type::Tiny->new(
  name       => 'SerializationObject',
  constraint => sub { $_->$_call_if_object( 'does' => 'Dancer2::Plugin::Redis::SerializationRole' ) },
  message => sub { qq{$_ does not consume a SerializationRole} },
);

has _serialization => (
  is      => 'lazy',
  isa     => AnyOf [ Undef, $TYPE_SERIALIZATIONOBJECT ],
  builder => sub {
    my ($dsl1) = @_;
    my $conf = plugin_setting;
    my $serialization;

    # Setup serialization.
    if ( my $serialization_module = delete $conf->{serialization}{module} ) {
      $serialization_module =~ s/^/Dancer2::Plugin::Redis::Serialization::/
        if $serialization_module !~ m/^Dancer2::Plugin::Redis::Serialization::/;
      croak qq{Invalid serialization module: $serialization_module}
        if $serialization_module !~ m/^Dancer2::Plugin::Redis::Serialization::[a-zA-Z][a-zA-Z0-9_]*$/;
      try {
        eval "require $serialization_module" or croak $@;
        $serialization = "$serialization_module"->new( %{ $conf->{serialization} } );
      }
      catch {
        $dsl1->error(qq{Unable to set up serialization '$serialization_module': $_});
      };
    }
    return $serialization;
  },
);

has _redis => (
  is      => 'lazy',
  isa     => InstanceOf ['Redis'],
  builder => sub {
    my ($dsl2) = @_;
    my $conf = plugin_setting;
    my %opts;

    # Build Redis->new settings.
    for (qw( server sock password reconnect every name debug )) {
      $opts{$_} = $conf->{$_} if exists $conf->{$_};
    }

    # Cleanup settings.
    delete $opts{server} if $opts{sock};   # prefer UNIX/Linux sockets.
    delete $opts{sock}   if $opts{server};
    delete $opts{password} if exists $opts{password} && ( !defined $opts{password} || $opts{password} eq '' );
    delete $opts{name} unless $opts{name};

    # Validate reconnect settings.
    if ( ( exists $opts{reconnect} || exists $opts{every} ) && ( !$opts{reconnect} || !$opts{every} ) ) {
      $dsl2->error(q{Incomplete Redis configuration for 'reconnect' and 'every', skipping...});
      delete $opts{reconnect};
      delete $opts{every};
    }

    # Validate on_connect settings.
    if ( exists $conf->{on_connect} ) {
      if ( !exists &{ $conf->{on_connect} } ) {
        $dsl2->error(q{Invalid Redis configuration for 'on_connect', skipping...});
      }
      else {
        $opts{on_connect} = \&{ $conf->{on_connect} };
      }
    }

    # Validate connection settings.
    $dsl2->error(q{Incomplete Redis configuration: required is either 'server' or 'sock'})
      if !$opts{server} && !$opts{sock};

    return Redis->new(%opts);
  },
);

############################################################################

sub _plugin {
  my ($dsl) = plugin_args @_;
  return $dsl;
}

############################################################################

sub _get {
  my ( $dsl, $key ) = plugin_args @_;
  croak q{Redis key is required} unless $key;
  my $data = $dsl->_redis->get($key);
  if ( my $serialization = $dsl->_serialization ) {
    $data = $serialization->decode($data);
  }
  return $data;
}

############################################################################

sub _mget {
  my ( $dsl, @keys ) = plugin_args @_;
  croak q{Redis key is required} unless scalar @keys;
  my @data = $dsl->_redis->mget(@keys);
  if ( my $serialization = $dsl->_serialization ) {
    $data[$_] = $serialization->decode( $data[$_] ) for ( 0 .. scalar @data );
  }
  return @data;
}

############################################################################

sub _set {
  my ( $dsl, $key, $data ) = plugin_args @_;
  croak q{Redis key is required} unless $key;
  if ( my $serialization = $dsl->_serialization ) {
    $data = $serialization->encode($data);
  }
  return $dsl->_redis->set( $key => $data );
}

############################################################################

sub _mset {
  my ( $dsl, %key_data ) = plugin_args @_;
  croak q{Redis key is required} unless scalar %key_data;
  if ( my $serialization = $dsl->_serialization ) {
    $key_data{$_} = $serialization->encode( $key_data{$_} ) for ( keys %key_data );
  }
  return $dsl->_redis->mset(%key_data);
}

############################################################################

sub _expire {
  my ( $dsl, $key, $timeout ) = plugin_args @_;
  croak q{Redis key is required} unless $key;
  return $dsl->_redis->persist($key) unless $timeout;
  return $dsl->_redis->expire( $key => $timeout );
}

############################################################################

register redis_plugin => \&_plugin, { is_global => 1 };


register redis_get => \&_get, { is_global => 1 };


register redis_mget => \&_mget, { is_global => 1 };


register redis_set => \&_set, { is_global => 1 };


register redis_mset => \&_mset, { is_global => 1 };


register redis_expire => \&_expire, { is_global => 1 };


register_plugin for_versions => [2];

############################################################################


1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Dancer2::Plugin::Redis - Perl Dancer2 plugin for interaction with key-value-store Redis.

=head1 VERSION

version 0.001

=head1 SYNOPSIS

In your I<config.yml>:

    plugins:
      Redis:
        # if you use TCP/IP:
        server: "localhost:6379"
        # if you use UNIX/Linux sockets:
        sock: "/path/to/sock"
        # (optional) Redis password used with auth:
        password: "Very secure password 123!"
        # (optional) Reconnect up to 60 seconds (reconnect) every 5000 milliseconds (every):
        reconnect: 60
        every: 5000
        # (optional) Redis connection name (NOT the Redis database ID):
        name: "my_connection_name"
        # (optional) Function called on Redis connect:
        on_connect: "MyDancer2App::redis_on_connect"
        # (optional) Use serialization for storing values other than simple scalars with Redis:
        serialization:
          # Use Sereal as serialization module:
          module: "Dancer2::Plugin::Redis::Serialization::Sereal"
          # Serialization module configuration:
          # Use snappy compression
          compression: "snappy"

In your source files:

    package MyDancer2App;
    use Dancer2;
    use Dancer2::Plugin::Redis;
    
    # Outputs the counter value stored in Redis, increments and saves it back to Redis.
    get '/' => sub {
      my $counter = redis_get('counter');  # Get the counter value from Redis.
      redis_set( ++$counter );             # Increment counter value by 1 and save it back to Redis.
      return $counter;
    };
    
    # (optional) Function called on Redis connect.
    sub redis_on_connect {
      my ( $redis ) = @_;
      
      # do some stuff with the bare Redis interface. This is NOT Dancer2::Plugin::Redis!
      
      return;
    }

=head1 DESCRIPTION

This L<Perl Dancer2|Dancer2> plugin adds various Domain-specific language
(I<dsl>) symbols to interact with Redis server configured in I<config.yml>.

It uses the L<Redis> module to communicate internally with the
Redis server. It also provides serialization features to store values which
are more than just simple scalars (I<strings>). By default there is no
serialization used.

I wrote this with my colleague to cover the use cases we're having with our
own Dancer2 application. If you need additional functionality that is not included,
please don't hesitate and create a pull request on GitHub or just file your
feature request with the GitHub issue tracker.

=head2 SEREAL

In order to use the supplied
L<Sereal broker|Dancer2::Plugin::Redis::Serialization::Sereal> you have to
install L<Sereal::Decoder> and L<Sereal::Encoder>. Both modules listed as
runtime recommends with Dancer2::Plugin::Redis.

=head1 METHODS

=head2 redis_plugin

Returns a Dancer2::Plugin::Redis instance. You can use redis_plugin to pass the
plugin instance to 3rd party modules (backend api) so you can access the existing
Redis connection there. You will need to access the actual methods of the the plugin
instance.

    my $business_logic = Business::Logic->new( redis_plugin => redis_plugin() );
    
    # somewhere else ...
    package Business::Logic;
    
    sub frobnicate {
      return $self->redis_plugin->_get( 'key' );
    }

=head2 redis_get

Returns the actual value stored in Redis of a single key.

=head2 redis_mget

Returns the values stored in Redis for one or more keys.

=head2 redis_set

Assign a new value to a singe key in Redis.

=head2 redis_mset

Assign one or more new values to keys in Redis.

=head2 redis_expire

Assign a new expiration timeout to a singe key in Redis. C<undef> or a
false value will turn off expiration.

    redis_expire 'key', 10; # will expire in ten seconds
    
    redis_expire 'key', undef; # removes expire from key
    redis_expire 'key';        # so will this

=head1 SEE ALSO

=over

=item L<Dancer2>

=item L<Redis>

=item L<Sereal>

=back

=head1 AUTHOR

BURNERSK <burnersk@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2014 by BURNERSK <burnersk@cpan.org>.

This is free software, licensed under:

  The MIT (X11) License

=cut
