package Nephia::Chain;
use strict;
use warnings;
use Carp;
use Scalar::Util ();
sub new {
my ($class, %opts) = @_;
$opts{namespace} = $class.'::Item' unless defined $opts{namespace};
$opts{name_normalize} = 1 unless defined $opts{name_normalize};
bless {chain => [], from => {}, %opts}, $class;
}
sub append {
my $self = shift;
my $from = caller;
my @actions = $self->_inject('Tail', 1, @_);
$self->{from}{$_} = $from for map {ref($_)} @actions;
}
sub prepend {
my $self = shift;
my $from = caller;
my @actions = $self->_inject('Head', 0, @_);
$self->{from}{$_} = $from for map {ref($_)} @actions;
}
sub before {
my ($self, $search, @opts) = @_;
my $from = caller;
my @actions = $self->_inject($search, 0, @opts);
$self->{from}{$_} = $from for map {ref($_)} @actions;
}
sub after {
my ($self, $search, @opts) = @_;
my $from = caller;
my @actions = $self->_inject($search, 1, @opts);
$self->{from}{$_} = $from for map {ref($_)} @actions;
}
sub delete {
my ($self, $search) = @_;
splice( @{$self->{chain}}, $self->index($search), 1);
delete $self->{from}{$self->_normalize_name($search)};
}
sub size {
my $self = shift;
return scalar( @{$self->{chain}} );
}
sub from {
my ($self, $name) = @_;
return $self->{from}{$self->_normalize_name($name)};
}
sub index {
my ($self, $name) = @_;
return 0 if $name eq 'Head';
return $self->size - 1 if $name eq 'Tail';
my $normalized_name = $self->_normalize_name($name);
for my $i (0 .. $self->size -1) {
return $i if $self->{chain}[$i]->isa($normalized_name);
}
}
sub as_array {
my $self = shift;
return @{$self->{chain}};
}
sub fetch {
my ($self, $plugin) = @_;
for my $obj (@{$self->{chain}}) {
return $obj if ref($obj) eq $plugin;
}
return undef;
}
sub _inject {
local $Carp::CarpLevel = $Carp::CarpLevel + 2;
my ($self, $search, $after, @opts) = @_;
my $index = $self->index($search);
$index += $after;
my @actions = $self->_bless_actions(@opts);
splice @{$self->{chain}}, $index, 0, @actions;
return @actions;
}
sub _validate_action_opts {
local $Carp::CarpLevel = $Carp::CarpLevel + 1;
my ($self, $name, $code) = @_;
croak "name is undefined" unless $name;
croak "code for $name is undefined" unless $code;
croak "illegal name $name" if ref($name);
return ( $self->_normalize_name($name), $code );
}
sub _check_duplicates {
local $Carp::CarpLevel = $Carp::CarpLevel + 1;
my ($self, @action) = @_;
for my $name ( map {ref($_)} @action ) {
croak "name $name is already stored" if $self->index($name);
croak "duplicate name $name" if scalar( grep {ref($_) eq $name} @action ) > 1;
}
}
sub _normalize_name {
local $Carp::CarpLevel = $Carp::CarpLevel + 1;
my ($self, $name) = @_;
return $name unless $self->{name_normalize};
my $namespace = $self->{namespace};
return $name =~ /^$namespace\:\:/ ? $name : $namespace.'::'.$name;
}
sub _bless_actions {
local $Carp::CarpLevel = $Carp::CarpLevel + 1;
my ($self, @opts) = @_;
my @rtn;
while (@opts) {
push @rtn, $self->_shift_as_action(\@opts);
}
$self->_check_duplicates(@rtn);
return wantarray ? @rtn : $rtn[0];
}
sub _shift_as_action {
local $Carp::CarpLevel = $Carp::CarpLevel + 1;
my ($self, $opts) = @_;
return shift(@$opts) if Scalar::Util::blessed($opts->[0]);
my $name = shift(@$opts);
my $code = shift(@$opts);
($name, $code) = $self->_validate_action_opts($name, $code);
return bless($code, $name);
}
1;
__END__
=encoding utf-8
=head1 NAME
Nephia::Chain - Abstract code chain for hook mechanism of Nephia
=head1 DESCRIPTION
Nephia::Chain is an abstract code chain class for hook mechanism of Nephia.
=head1 SYNOPSIS
my $chain = Nephia::Chain->new(namespace => 'Foobar::Chain::Item');
$chain->append(incr => sub { $_[0] + 1 }, double => sub { $_[0] * 2 }); ### y = ((x + 1) * 2)
$chain->prepend(power => sub { $_[0] ** 2 }); ### y = (((x ** 2) + 1) * 2)
$chain->before('Head', plus3 => sub { $_[0] + 3 }); ### y = ((((x + 3) ** 2) + 1) * 2)
$chain->after('plus3', half => sub { $_[0] / 2 }); ### y = (((((x + 3) / 2) ** 2) + 1) * 2)
my $x = 3;
for my $item ( $chain->as_array ) {
$x = $item->($x);
}
my $y = $x;
printf "y = %s\n", $y; ### 20
=head1 ATTRIBUTES
=head2 namespace
Prefix of name for coderef-entries
=head2 name_normalize
Enable or Disable name normalization when add and/or search entry.
=head1 METHODS
=head2 append
$chain->append( entryname => sub { ... } );
Add a new coderef to tail of chain.
=head2 prepend
$chain->prepend( entryname => sub { ... } );
Add a new coderef to head of chain.
=head2 before
$chain->before( 'target', entryname => sub { ... } );
Add a new coderef before target entry.
=head2 after
$chain->after( 'target', entryname => sub { ... } );
Add a new coderef after target entry.
=head2 delete
$chain->delete( 'target' );
Delete specified entry.
=head2 from
my $come_from = $chain->from( 'target' );
Returns a class name of origin of specified entry.
=head2 size
my $size = $chain->size;
Returns a number of entries.
=head2 index
my $position = $chain->index( 'target' );
Returns a position number of specified entry.
=head2 as_array
my @coderef_list = $chain->as_array;
Returns each coderef.
=head1 AUTHOR
ytnobody E<lt>ytnobody@gmail.comE<gt>