File Coverage

blib/lib/IO/Iron/IronCache/Cache.pm

Criterion	Covered	Total	%
statement	58	126	46.0
branch	4	18	22.2
condition			n/a
subroutine	15	23	65.2
pod	7	7	100.0
total	84	174	48.2

package IO::Iron::IronCache::Cache;

## no critic (Documentation::RequirePodAtEnd)
## no critic (Documentation::RequirePodSections)
## no critic (ControlStructures::ProhibitPostfixControls)
## no critic (Subroutines::RequireArgUnpacking)

use 5.010_000;
use strict;
use warnings;

# Global creator
BEGIN {
    # Export Nothing
    use parent qw(IO::Iron::IronCache::Policy);    # Inheritance
}

# Global destructor
END {
}

# ABSTRACT: IronCache (Online Item-Value Storage) Client (Cache).

our $VERSION = '0.14'; # VERSION: generated by DZP::OurPkgVersion

use Log::Any qw($log);
use Hash::Util 0.06 qw{lock_keys unlock_keys};
use Carp::Assert::More;
use English '-no_match_vars';
use Params::Validate qw(:all);

use IO::Iron::Common;
use IO::Iron::IronCache::Api;

# CONSTANTS for this module

# DEFAULTS

sub new {
    my ( $class, $params ) = @_;
    $log->tracef( 'Entering new(%s, %s)', $class, $params );
    my $self;
    my @self_keys = (    ## no critic (CodeLayout::ProhibitQuotedWordLists)
        'ironcache_client',         # Reference to IronCache client
        'name',                     # Cache name
        'connection',               # Reference to REST client
        'policy',                   # The policies. (copied from the client.)
        'last_http_status_code',    # After successfull network operation, the return value is here.
    );
    lock_keys( %{$self}, @self_keys );
    $self->{'ironcache_client'} = defined $params->{'ironcache_client'} ? $params->{'ironcache_client'} : undef;
    $self->{'name'}             = defined $params->{'name'}             ? $params->{'name'}             : undef;
    $self->{'connection'}       = defined $params->{'connection'}       ? $params->{'connection'}       : undef;
    $self->{'policy'}           = defined $params->{'policy'}           ? $params->{'policy'}           : undef;
    assert_isa( $self->{'ironcache_client'},
        'IO::Iron::IronCache::Client', 'self->{ironcache_client} is IO::Iron::IronCache::Client.' );
    assert_nonblank( $self->{'name'}, 'self->{name} is defined and is not blank.' );
    assert_isa( $self->{'connection'}, 'IO::Iron::Connection', 'self->{connection} is IO::Iron::Connection.' );
    assert_hashref( $self->{'policy'}, 'self->{policy} is a reference to a hash.' );

    unlock_keys( %{$self} );
    my $blessed_ref = bless $self, $class;
    lock_keys( %{$self}, @self_keys );

    $log->tracef( 'Exiting new: %s', $blessed_ref );
    return $blessed_ref;
}

sub name { return $_[0]->_access_internal( 'name', $_[1] ); }

# TODO Move _access_internal() to IO::Iron::Common.

sub _access_internal {
    my ( $self, $var_name, $var_value ) = @_;
    $log->tracef( '_access_internal(%s, %s)', $var_name, $var_value );
    if ( defined $var_value ) {
        $self->{$var_name} = $var_value;
        return $self;
    }
    else {
        return $self->{$var_name};
    }
}

sub clear {
    my $self   = shift;
    my %params = validate(
        @_,
        {
            # No parameters
        }
    );
    $log->tracef('Entering clear()');

    my $cache_name = $self->name();
    my $connection = $self->{'connection'};
    my ( $http_status_code, $response_message ) = $connection->perform_iron_action(
        IO::Iron::IronCache::Api::IRONCACHE_CLEAR_A_CACHE(),
        {
            '{Cache Name}' => $cache_name,
        }
    );
    $self->{'last_http_status_code'} = $http_status_code;

    $log->tracef( 'Exiting clear: %d', 1 );
    return 1;
}

sub put {
    my $self   = shift;
    my %params = validate(
        @_,
        {
            'key' => {
                type      => SCALAR,
                callbacks => {
                    'RFC 3986 reserved character check' => sub { return !IO::Iron::Common::contains_rfc_3986_res_chars(shift) },
                }
            },    # cache item key.
            'item' => { isa => 'IO::Iron::IronCache::Item', },    # cache item.
        }
    );
    $log->tracef( 'Entering put(%s)', \%params );

    $self->validate_item_key( 'key' => $params{'key'} );
    my $cache_name = $self->name();
    my $connection = $self->{'connection'};
    my %item_body;
    foreach my $field_name ( keys %{ IO::Iron::IronCache::Api::IRONCACHE_PUT_AN_ITEM_INTO_A_CACHE()->{'request_fields'} } ) {
        if ( defined $params{'item'}->{$field_name} ) {
            $item_body{$field_name} = $params{'item'}->{$field_name};
        }
    }
    my ( $http_status_code, $response_message ) = $connection->perform_iron_action(
        IO::Iron::IronCache::Api::IRONCACHE_PUT_AN_ITEM_INTO_A_CACHE(),
        {
            '{Cache Name}' => $cache_name,
            '{Key}'        => $params{'key'},
            'body'         => \%item_body,
        }
    );
    $self->{'last_http_status_code'} = $http_status_code;

    $log->tracef( 'Exiting put: %d', 1 );
    return 1;
}

# TODO Correct documentation: if item does not exist, it is created.

sub increment {
    my $self   = shift;
    my %params = validate(
        @_,
        {
            'key' => {
                type      => SCALAR,
                callbacks => {
                    'RFC 3986 reserved character check' => sub { return !IO::Iron::Common::contains_rfc_3986_res_chars(shift) },
                }
            },    # cache item key.
            'increment' => { type => SCALAR, },    # cache item increment.
        }
    );
    assert_nonblank( $params{'key'}, 'key is defined and is not blank.' );
    assert_integer( $params{'increment'}, 'increment amount is integer.' );
    $log->tracef( 'Entering increment(%s)', \%params );

    $self->validate_item_key( 'key' => $params{'key'} );
    my $cache_name = $self->name();
    my $connection = $self->{'connection'};
    my %item_body;
    $item_body{'amount'} = $params{'increment'};
    my ( $http_status_code, $response_message ) = $connection->perform_iron_action(
        IO::Iron::IronCache::Api::IRONCACHE_INCREMENT_AN_ITEMS_VALUE(),
        {
            '{Cache Name}' => $cache_name,
            '{Key}'        => $params{'key'},
            'body'         => \%item_body,
        }
    );
    $self->{'last_http_status_code'} = $http_status_code;
    my $new_value = $response_message->{'value'};

    $log->tracef( 'Exiting increment: %d', $new_value );
    return $new_value;
}

sub get {
    my $self   = shift;
    my %params = validate(
        @_,
        {
            'key' => { type => SCALAR, },    # cache item key.
        }
    );
    assert_nonblank( $params{'key'}, 'key is defined and is not blank.' );
    $log->tracef( 'Entering get(%s)', \%params );

    my $cache_name = $self->name();
    my $connection = $self->{'connection'};
    my ( $http_status_code, $response_message ) = $connection->perform_iron_action(
        IO::Iron::IronCache::Api::IRONCACHE_GET_AN_ITEM_FROM_A_CACHE(),
        {
            '{Cache Name}' => $cache_name,
            '{Key}'        => $params{'key'},
        }
    );
    $self->{'last_http_status_code'} = $http_status_code;
    my $new_item = IO::Iron::IronCache::Item->new(
        'value' => $response_message->{'value'},
        'cas'   => $response_message->{'cas'},
    );
    $new_item->expires( $response_message->{'expires'} ) if defined $response_message->{'expires'};
    $new_item->replace( $response_message->{'replace'} ) if defined $response_message->{'replace'};
    $new_item->add( $response_message->{'add'} )         if defined $response_message->{'add'};

    $log->tracef( 'Exiting get: %s', $new_item );
    return $new_item;
}

sub delete {    ## no critic (Subroutines::ProhibitBuiltinHomonyms)
    my $self   = shift;
    my %params = validate(
        @_,
        {
            'key' => { type => SCALAR, },    # cache item key.
        }
    );
    assert_nonblank( $params{'key'}, 'key is defined and is not blank.' );
    $log->tracef( 'Entering delete(%s)', \%params );

    my $cache_name = $self->name();
    my $connection = $self->{'connection'};
    my ( $http_status_code, $response_message ) = $connection->perform_iron_action(
        IO::Iron::IronCache::Api::IRONCACHE_DELETE_AN_ITEM_FROM_A_CACHE(),
        {
            '{Cache Name}' => $cache_name,
            '{Key}'        => $params{'key'},
        }
    );
    $self->{'last_http_status_code'} = $http_status_code;

    $log->tracef( 'Exiting delete: %d', 1 );
    return 1;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

IO::Iron::IronCache::Cache - IronCache (Online Item-Value Storage) Client (Cache).

=head1 VERSION

version 0.14

=head1 SYNOPSIS

Please see IO::Iron::IronCache::Client for usage.

=for stopwords IronCache Params IronHTTPCallException Mikko Koivunalho

=head1 REQUIREMENTS

=head1 SUBROUTINES/METHODS

=head2 new

=over

=item Creator function.

=back

=head2 Getters/setters

Set or get a property.
When setting, returns the reference to the object.

=over 8

=item name         Cache name.

=back

=head2 clear

Deletes all items in an IronCache cache.

=over 8

=item Params: [NONE]

=item Return: 1 == success.

=item Exception: IronHTTPCallException if fails. (IronHTTPCallException: status_code=<HTTP status code> response_message=<response_message>)

=back

=head2 put

=over

=item Params: key, IO::Iron::IronCache::Item object.

=item Return: 1 == success.

=item Exception: IronHTTPCallException if fails. (IronHTTPCallException: status_code=<HTTP status code> response_message=<response_message>)

=back

=head2 increment

=over

=item Params: key, increment (integer number, can be negative).

=item Return: the new value.

=item Exception: IronHTTPCallException if fails. (IronHTTPCallException: status_code=<HTTP status code> response_message=<response_message>)

=back

=head2 get

=over

=item Params: key.

=item Return: IO::Iron::IronCache::Item object.

=item Exception: IronHTTPCallException if fails. (IronHTTPCallException: status_code=<HTTP status code> response_message=<response_message>)

=back

=head2 delete

=over

=item Params: key.

=item Return: 1 if successful.

=item Exception: IronHTTPCallException if fails. (IronHTTPCallException: status_code=<HTTP status code> response_message=<response_message>)

=back

=head1 AUTHOR

Mikko Koivunalho <[e-mail]>

=head1 BUGS

Please report any bugs or feature requests to [e-mail] or through the web interface at:
 http://rt.cpan.org/Public/Dist/Display.html?Name=IO-Iron

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2023 by Mikko Koivunalho.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

The full text of the license can be found in the
F<LICENSE> file included with this distribution.

=cut