view release on metacpan or  search on metacpan

lib/Bot/BasicBot/Pluggable/Store.pm  view on Meta::CPAN

package Bot::BasicBot::Pluggable::Store;
$Bot::BasicBot::Pluggable::Store::VERSION = '1.30';
use strict;
use warnings;
use Carp qw( croak );
use Data::Dumper;
use Storable qw( nfreeze thaw );
use Try::Tiny;
use Module::Load qw();
use Log::Log4perl;

use base qw( );

sub new {
    my $class = shift;
    my $self;
    my $logger = Log::Log4perl->get_logger($class);
    if ( @_ % 2 == 0 ) {
        $self = bless {@_} => $class;
    }
    elsif ( @_ == 1 and ref $_[0] eq 'HASH' ) {
        $self = $class->new_from_hashref( $_[0] );
    }
    elsif ( @_ == 1 and !ref $_[0] ) {
        $self = $class->new_from_hashref( { type => $_[0] } );
    }
    elsif ( !@_ ) {
        $self = bless {} => $class;
    }
    else {
        $logger->warn(
"Argument to new() is neither an argument list, a hashref, a string nor empty"
        );
    }
    $self->init();
    $self->load();
    return $self;
}

sub new_from_hashref {
    my ( $class, $args ) = @_;
    my $logger = Log::Log4perl->get_logger($class);

    if ( ref($args) ne 'HASH' ) {
        $logger->warn('Argument to store_from_hashref must be a hashref');
    }

    my $store_class = delete $args->{type} || 'Memory';

    $store_class = "Bot::BasicBot::Pluggable::Store::$store_class"
      unless $store_class =~ /::/;

    # load the store class
    try { Module::Load::load $store_class; }
    catch { $logger->warn("Couldn't load $store_class - $_"); };

    my $store = $store_class->new( %{$args} );

    croak "Couldn't init a $store_class store\n" unless $store;

    return $store;
}

sub init { undef }

sub load { undef }

sub save { }

sub keys {
    my ( $self, $namespace, %opts ) = @_;
    my $mod = $self->{store}{$namespace} || {};
    return $self->_keys_aux( $mod, $namespace, %opts );
}

sub count_keys {
    my ( $self, $namespace, %opts ) = @_;
    $opts{_count_only} = 1;
    $self->keys( $namespace, %opts );
}

sub _keys_aux {
    my ( $self, $mod, $namespace, %opts ) = @_;

    my @res = ( exists $opts{res} ) ? @{ $opts{res} } : ();

    return CORE::keys %$mod unless @res;