package Sub::Rate;
use strict;
use warnings;
use Any::Moose;
use Carp;
our $VERSION = '0.03';
has max_rate => (
is => 'rw',
default => 100,
);
has rand_func => (
is => 'rw',
default => sub {
return sub { rand($_[0]) };
},
);
has sort => (
is => 'rw',
default => 0,
);
has _func => (
is => 'rw',
default => sub { [] },
);
has _default_func => (
is => 'rw',
);
no Any::Moose;
sub add {
my ($self, $rate, $func) = @_;
if ($rate eq 'default') {
$self->_default_func($func);
}
else {
my $total_rate = 0;
$total_rate += $_->[0] for @{ $self->_func };
if ($total_rate + $rate > $self->max_rate) {
croak sprintf 'Exceed max_rate, current:%s max:%s',
$total_rate + $rate, $self->max_rate;
}
push @{ $self->_func }, [ $rate, $func ];
}
}
sub generate {
my ($self) = @_;
my @sorted_funcs = @{ $self->_func };
@sorted_funcs = sort { $a->[0] <=> $b->[0] } @sorted_funcs if $self->sort;
my $rand = $self->rand_func;
my $max_rate = $self->max_rate;
my $default_func = $self->_default_func;
sub {
my @args = @_;
my $index = $rand->( $max_rate );
my $cursor = 0;
for my $f (@sorted_funcs) {
$cursor += $f->[0];
if ($index <= $cursor) {
return $f->[1]->(@args);
}
}
if ($default_func) {
return $default_func->(@args);
}
else {
return;
}
};
}
sub clear {
my ($self) = @_;
$self->_func([]);
$self->_default_func(undef);
}
__PACKAGE__->meta->make_immutable;
__END__
=for stopwords SUBs sublist
=head1 NAME
Sub::Rate - Rate based sub dispatcher generator
=head1 SYNOPSIS
my $rate = Sub::Rate->new( max_rate => 100 );
$rate->add( 10 => sub { ... } ); # sub1
$rate->add( 20 => sub { ... } ); # sub2
$rate->add( default => sub { ... }); # default sub
my $func = $rate->generate;
# Calling this $func then:
# sub1 will be called by rate about 10/100 (10%),
# sub2 will be called by rate about 20/100 (20%),
# default sub will be called in rest case (70%),
$func->();
=head1 DESCRIPTION
Sub::Rate generates a SUB that will dispatch some SUBs by specified rate.
=head1 CLASS METHODS
=head2 new(%options)
my $obj = Sub::Rate->new;
Create Sub::Rate object.
Available options are:
=over
=item * max_rate => 'Number'
Max rate. (Default: 100)
=item * rand_func => 'CodeRef'
Random calculate function. Default is:
sub {
CORE::rand($_[0]);
};
You can change random function to your own implementation by this option.
C<max_rate> is passed as C<$_[0]> to this function.
=back
=head2 METHODS
=head2 add($rate : Number|Str, $sub :CodeRef)
$obj->add( 10, sub { ... } );
$obj->add( 20, sub { ... } );
$obj->add( 'default', sub { ... } );
Add C<$sub> to internal sublist rate by C<$rate>.
If C<$rate> is not number but "default", then C<$sub> is registered as default sub.
If default sub is already registered, it will be replaced.
=head2 generate()
my $sub = $obj->generate;
Create a new sub that dispatch functions by its rates.
=head2 clear()
$obj->clear;
Clear all registered functions and default function.
=head1 AUTHOR
Daisuke Murase <typester@cpan.org>
=head1 COPYRIGHT AND LICENSE
Copyright (c) 2012 KAYAC Inc. All rights reserved.
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
The full text of the license can be found in the
LICENSE file included with this module.
=cut