view release on metacpan or  search on metacpan

lib/Action/CircuitBreaker.pm  view on Meta::CPAN

package Action::CircuitBreaker;
$Action::CircuitBreaker::VERSION = '0.1';
# ABSTRACT: Module to try to perform an action, with an option to suspend execution after a number of failures.

use Scalar::Util qw(blessed);
use Time::HiRes qw(gettimeofday);
use Carp;

use base 'Exporter';
our @EXPORT = ((caller())[1] eq '-e' ? @EXPORT_OK : ());

use Moo;



has error_if_code => (
    is => 'ro',
    required => 1,
    isa => sub { ref $_[0] eq 'CODE' },
    default => sub { sub { $_[0] }; },
);


has on_failure_code => (
    is => 'ro',
    isa => sub { ref $_[0] eq 'CODE' },
    predicate => 1,
);


has on_circuit_open => (
    is => 'ro',
    isa => sub { ref $_[0] eq 'CODE' },
    predicate => 1,
);


has on_circuit_close => (
    is => 'ro',
    isa => sub { ref $_[0] eq 'CODE' },
    predicate => 1,
);


has max_retries_number => (
    is => 'ro',
    lazy => 1,
    default => sub { 10 },
);

# the current number of retries
has _current_retries_number => (
    is => 'rw',
    lazy => 1,
    default => sub { 0 },
    init_arg => undef,
    clearer => 1,
);


has open_time => (
    is => 'ro',
    lazy => 1,
    default => sub { 10 },
);

# Timestamp at which the circuit is available again
has _circuit_open_until => (
    is => 'rw',
    default => sub { 0 },
    init_arg => undef,
);


sub run {
    my ($self, $attempt_code) = @_;

    if (my $timestamp = $self->_circuit_open_until) {
        # we can't execute until the timestamp has done
        my ($seconds, $microseconds) = gettimeofday;
        $seconds * 1000 + int($microseconds / 1000) >= $timestamp
          or die 'The circuit is open and cannot be executed.';
        $self->_circuit_open_until(0);
        $self->has_on_circuit_close
          and $self->on_circuit_close->();
    }

    my $error;
    my @attempt_result;
    my $attempt_result;
    my $wantarray;
          
    if (wantarray) {
        $wantarray = 1;
        @attempt_result = eval { $attempt_code->(@_) };
        $error = $@;
    } elsif ( ! defined wantarray ) {
        eval { $attempt_code->(@_) };
        $error = $@;
    } else {
        $attempt_result = eval { $attempt_code->(@_) };
        $error = $@;
    }

    my $h = { action_retry => $self,
              attempt_result => ( $wantarray ? \@attempt_result : $attempt_result ),
              attempt_parameters => \@_,
            };


    if ($self->error_if_code->($error, $h)) {
        $self->_current_retries_number($self->_current_retries_number + 1);
        if ($self->_current_retries_number >= $self->max_retries_number) {
            my ($seconds, $microseconds) = gettimeofday;
            my $open_until = ($self->open_time * 1000) + ($seconds * 1000 + int($microseconds / 1000));
            $self->_circuit_open_until($open_until);
            $self->has_on_circuit_open
              and $self->on_circuit_open->();
        }
        die $error;
    } else {
        return $h->{attempt_result};
    }
}


1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Action::CircuitBreaker - Module to try to perform an action, with an option to suspend execution after a number of failures.

=head1 VERSION

version 0.1

=head1 SYNOPSIS

  # Will execute the code, as the circuit will be closed by default.

  # OO interface
  use Action::CircuitBreaker;
  Action::CircuitBreaker->new()->run(sub { do_stuff; });

=head1 ATTRIBUTES

=head2 error_if_code

  ro, CodeRef

The code to run to check if the error should count towards the circuit breaker. It defaults to:

  # Returns true if there were an exception evaluating to something true
  sub { $_[0] }

It will be given these arguments:

=over

=item * 

as first argument, a scalar which is the value of any exception that were
raised by the C<$attempt_code>. Otherwise, undef.

=item *

as second argument, a HashRef, which contains these keys:

=back

=over

=item action_retry

it's a reference on the ActionRetry instance. That way you can have access to
the other attributes.

=item attempt_result

It's a scalar, which is the result of C<$attempt_code>. If C<$attempt_code>
returned a list, then the scalar is the reference on this list.

=item attempt_parameters

It's the reference on the parameters that were given to C<$attempt_code>.

=back

C<error_if_code> return value will be interpreted as a boolean : true return
value means the execution of C<$attempt_code> was a failure and should count
towards breaking the ciruit. False means it went well.

Here is an example of code that gets the arguments properly:

  my $action = Action::CircuitBreaker->new(
    error_if_code => sub {
      my ($error, $h) = @_;

      my $attempt_code_result = $h->{attempt_result};
      my $attempt_code_params = $h->{attempt_parameters};

      my @results = @$attempt_code_result;
      # will contains (2, 4);

      my @original_parameters = @$attempt_code_params;
      # will contains (1, 2);

    }
  );
  my @results = $action->run(sub { print @_; }, 1, 2);

=head2 on_failure_code

  ro, CodeRef, optional

If given, will be executed when an execution fails.

It will be given the same arguments as C<error_if_code>. See C<error_if_code> for their descriptions

=head2 on_circuit_open

  ro, CodeRef, optional