File Coverage

lib/Peco/Container.pm

Criterion	Covered	Total	%
statement	45	81	55.5
branch	11	30	36.6
condition	8	11	72.7
subroutine	14	18	77.7
pod	7	13	53.8
total	85	153	55.5

package Peco::Container;

use strict;

use Carp ();
use Peco::Spec;

our $VERSION = '1.2';

sub new {
    my ( $class ) = @_;
    my $self = bless {
        specs => { },
    }, $class;
    $self;
}

sub register {
    my ( $self, $key, $class, $deps, $ctor, $attrs ) = @_;
    $class ||= $key;
    $deps  ||= [ ];
    $ctor  ||= 'new';
    $attrs ||= { };

    $self->_assert_not_exists( $key );

    my $spec;
    my @spec = ( $class, $deps, $ctor, $attrs );

    if ( ref $class ) {
        if ( ref $class eq 'CODE' ) {
            $spec = Peco::Spec::Code->new( @spec );
        }
        else {
            $spec = Peco::Spec::Const->new( @spec );
        }
    } else {
        if ( UNIVERSAL::isa( $class, 'Peco::Spec' ) ) {
            $spec = $class->new( @spec );
        }
        elsif ( UNIVERSAL::isa( $class, 'UNIVERSAL' ) ) {
            $spec = Peco::Spec::Class->new( @spec );
        }
        elsif ( index( $class, '::' ) != -1 ) {
            # we get here if the class looks like a class but hasn't
            # been `require'd or `use'd... it's a bit of a nasty
            # heuristic, but a dumb machine can be only so smart
            eval "require $class; $class->import();";
            if ( $@ ) {
                my $file = join( '/', split /::/, $class ).'.pm';
                if ( exists $INC{ $file } ) {
                    Carp::croak $@;
                } else {
                    $spec = Peco::Spec::Const->new( @spec );
                }
            } else {
                if ( UNIVERSAL::isa( $class, 'Peco::Spec' ) ) {
                    $spec = $class->new( @spec );
                } else {
                    $spec = Peco::Spec::Class->new( @spec );
                }
            }
        }
        else {
            $spec = Peco::Spec::Const->new( @spec );
        }
    }

    $self->specs->{$key} = $spec;
}

sub unregister {
    my ( $self, $key ) = @_;
    $self->_assert_exists( $key );
    return delete $self->specs->{$key};
}

sub service {
    my ( $self, $key, %seen ) = @_;
    if ( $self->contains( $key ) ) {
        return $self->spec( $key )->instance( $self, $key, %seen );
    }
    elsif ( UNIVERSAL::isa( $key, 'UNIVERSAL' ) ) {
        my $type = $key;
        foreach my $key ( $self->keys ) {
            if ( UNIVERSAL::isa( $self->specs->{$key}->class, $type ) ) {
                return $self->specs->{$key}->instance( $self, $type, %seen );
            }
        }
    }
    $self->_assert_exists( $key );
    return ();
}

sub contains {
    my ( $self, $key ) = @_;
    exists $self->specs->{ $key };
}

sub services {
    my ( $self ) = @_;
    map { $self->service( $_ ) } $self->keys();
}

sub keys { CORE::keys %{ $_[0]->specs } }

sub spec {
    my ( $self, $key ) = @_;
    $self->_assert_exists( $key );
    $self->specs->{ $key };
}

sub specs { $_[0]{specs} ||= { } }
sub count { scalar( $_[0]->keys() ) }

sub clone {
    my ( $self, $deep ) = @_;
    my $copy  = ref( $self )->new;
    my %specs;
    foreach my $key ( CORE::keys %{ $self->specs } ) {
        if ( $self->specs->{ $key }->can( 'clone' ) ) {
            $specs{ $key } = $self->specs->{ $key }->clone( $deep );
        } else {
            $specs{ $key } = $self->specs->{ $key };
        }
    }
    $copy->{specs} = \%specs;
    return $copy;
}

sub is_empty { $_[0]->count == 0 }

sub multicast {
    my ( $self, $method, @args ) = @_;
    my @keys = $self->keys;
    foreach ( $self->services ) {
        $_->$method( @args ) if UNIVERSAL::can( $_, $method );
    }
}

sub _assert_exists {
    my ( $self, $key ) = @_;
    Carp::confess("no such spec: `$key'") unless $self->contains( $key );
}

sub _assert_not_exists {
    my ( $self, $key ) = @_;
    Carp::confess( "spec already exists: `$key'" ) if $self->contains( $key );
}

1;

__END__