File Coverage

blib/lib/Sub/Throttler/algo.pm

Criterion	Covered	Total	%
statement	57	61	93.4
branch	21	32	65.6
condition	3	6	50.0
subroutine	16	17	94.1
pod	3	3	100.0
total	100	119	84.0

package Sub::Throttler::algo;
use 5.010001;
use warnings;
use strict;
use utf8;
use Carp;
our @CARP_NOT = qw( Sub::Throttler );

our $VERSION = 'v0.2.2';

use Scalar::Util qw( blessed );
use List::Util qw( any );
use Sub::Throttler qw( throttle_add );


use constant DEFAULT_KEY    => 'default';


sub apply_to {
    goto &throttle_add;
}

sub apply_to_functions {
    my ($self, @func) = @_;
    my %func = map { $_ => DEFAULT_KEY }
        map {/::/ms ? $_ : caller().q{::}.$_} @func;
    $self->apply_to(sub {
        my ($this, $name) = @_;
        my $key
          = $this   ? undef
          : @func   ? $func{$name}
          :           DEFAULT_KEY
          ;
        return $key ? {$key=>1} : undef;
    });
    return $self;
}

sub apply_to_methods {
    my ($self, $class_or_obj, @func) = @_;
    croak 'require class or object'
        if ref $class_or_obj && !blessed($class_or_obj);
    croak 'method must not contain ::' if any {/::/ms} @func;
    my %func = map { $_ => DEFAULT_KEY } @func;
    if (1 == @_) {
        $self->apply_to(sub {
            my ($this) = @_;
            my $key = $this ? DEFAULT_KEY : undef;
            return $key ? {$key=>1} : undef;
        });
    } elsif (ref $class_or_obj) {
        my $obj = $class_or_obj;
        $self->apply_to(sub {
            my ($this, $name) = @_;
            my $key
              = !$this || !ref $this || $this != $obj           ? undef
              : @func                                           ? $func{$name}
              :                                                   DEFAULT_KEY
              ;
            return $key ? {$key=>1} : undef;
        });
    } else {
        my $class = $class_or_obj;
        $self->apply_to(sub {
            my ($this, $name) = @_;
            my $key
              = !eval {local $SIG{__DIE__}; $this->isa($class)} ? undef
              : @func                                           ? $func{$name}
              :                                                   DEFAULT_KEY
              ;
            return $key ? {$key=>1} : undef;
        });
    }
    return $self;
}


1; # Magic true value required at end of module
__END__