IOC::Registry - Registry singleton for the IOC Framework

  use IOC::Registry;

  my $container = IOC::Container->new('database');
  my $other_container = IOC::Container->new('logging');
  # ... bunch of IOC::Container creation code omitted

  # create a registry singleton
  my $reg = IOC::Registry->new();
  $reg->registerContainer($container);
  $reg->registerContainer($other_container);

  # ... somewhere later in your program

  my $reg = IOC::Registry->instance(); # get the singleton

  # and try and find a service
  my $service = $reg->searchForService('laundry') || die "Could not find the laundry service";

  my $database = $reg->getRegisteredContainer('database');

  # get a list of container names
  my @container_names = $reg->getRegisteredContainerList();

  # and you can unregister containers too
  my $unregistered_container = $reg->unregisterContainer($container);

package IOC::Registry;

use strict;
use warnings;

our $VERSION = '0.05';

use Scalar::Util qw(blessed);

use IOC::Exceptions;
use IOC::Interfaces;

use IOC::Visitor::SearchForService;
use IOC::Visitor::SearchForContainer;

use base 'Class::StrongSingleton';

sub new {
    my ($_class) = @_;
    my $class = ref($_class) || $_class;
    my $registry = {
        containers => {},
        service_aliases => {}
        };
    bless($registry, $class);
    $registry->_init();
    return $registry;
}

# add and remove containers

sub registerContainer {
    my ($self, $container) = @_;
    (blessed($container) && $container->isa('IOC::Container'))
        || throw IOC::InsufficientArguments "You must supply a valid IOC::Container object";
    my $name = $container->name();
    (!exists ${$self->{containers}}{$name})
        || throw IOC::ContainerAlreadyExists "Duplicate Container '$name'";
    $self->{containers}->{$name} = $container;
}

sub unregisterContainer {
    my ($self, $container_or_name) = @_;
    (defined($container_or_name)) || throw IOC::InsufficientArguments "You must supply a name or a container";    
    my $name;
    if (ref($container_or_name)) {
        (blessed($container_or_name) && $container_or_name->isa('IOC::Container'))
            || throw IOC::InsufficientArguments "You must supply a valid IOC::Container object";
        $name = $container_or_name->name();
    }
    else {
        $name = $container_or_name;
    }
    (exists ${$self->{containers}}{$name})
        || throw IOC::ContainerNotFound "Cannot unregister a container we do not have";
    my $container = $self->{containers}->{$name};
    delete $self->{containers}->{$name};    
    return $container;
}

# fetching the containers

sub getRegisteredContainer {
    my ($self, $name) = @_;
    (defined($name)) || throw IOC::InsufficientArguments "You must supply a name of a container";
    (exists ${$self->{containers}}{$name}) 
        || throw IOC::ContainerNotFound "There is no container by the name '${name}'";     
    return $self->{containers}->{$name};
}

sub getRegisteredContainerList {
    my ($self) = @_;
    return keys %{$self->{containers}};
}

sub hasRegisteredContainer {
    my ($self, $name) = @_;
    (defined($name)) || throw IOC::InsufficientArguments "You must supply a name of a container";
    return (exists ${$self->{containers}}{$name}) ? 1 : 0;
}

# aliasing

sub aliasService {
    my ($self, $real_path, $alias_path) = @_;
    (defined($alias_path) && defined($real_path)) 
        || throw IOC::InsufficientArguments "You must supply a alias path and a real path";
    $self->{service_aliases}->{$alias_path} = $real_path;
}

# locate Service by path

sub locateService {
    my ($self, $path, @extra_args) = @_;
    (defined($path)) || throw IOC::InsufficientArguments "You must supply a path to a service";
    # if the service has been aliased, get the real path ...
    $path = $self->{service_aliases}->{$path} if exists ${$self->{service_aliases}}{$path};
    # and go about your normal business ...
    my @path = grep { $_ } split /\// => $path;
    my $registered_container_name = shift @path;
    (exists ${$self->{containers}}{$registered_container_name}) 
        || throw IOC::ContainerNotFound "There is no registered container found at '$registered_container_name' for the path '${path}'"; 
    my $service;
    eval {
        $service = $self->{containers}->{$registered_container_name}->find((join "/" => @path), \@extra_args);
    };
    throw IOC::ServiceNotFound "There is no service found at the path '${path}'" => $@ if $@;    
    return $service;
}

sub locateContainer {
    my ($self, $path) = @_;
    (defined($path)) || throw IOC::InsufficientArguments "You must supply a path to a container";    
    my @path = grep { $_ } split /\// => $path;
    my $registered_container_name = shift @path;
    (exists ${$self->{containers}}{$registered_container_name}) 
        || throw IOC::ContainerNotFound "There is no container found at the path '${path}'"; 
    my $current = $self->{containers}->{$registered_container_name};
    eval {
        $current = $current->getSubContainer(shift @path) while @path;
    };
    throw IOC::ContainerNotFound "There is no container found at the path '${path}'" => $@ if $@;
    # otherwise ...
    return $current;
}

# searching for containers

sub searchForContainer {
    my ($self, $container_to_find) = @_;
    my $container_found;
    foreach my $container (values %{$self->{containers}}) {
        $container_found = $container->accept(IOC::Visitor::SearchForContainer->new($container_to_find));
        last if defined $container_found;
    }
    return $container_found;
}

sub searchForService {
    my ($self, $service_to_find) = @_;
    my $service;
    foreach my $container (values %{$self->{containers}}) {
        $service = $container->accept(IOC::Visitor::SearchForService->new($service_to_find));
        last if $service;
    }
    return $service;
}

sub DESTROY {
    my ($self) = @_;
    # get rid of all our containers
    foreach my $container (values %{$self->{containers}}) {
        defined $container && $container->DESTROY;
    }     
    # let the Singleton do its work
    $self->SUPER::DESTROY();
}

1;

__END__