Lots of files got moved around,a nd some got added.

[gitmo/MooseX-AttributeHelpers.git] / lib / MooseX / AttributeHelpers / MethodProvider.pm

package MooseX::AttributeHelpers::MethodProvider;

use strict;
use warnings;

use Carp qw(confess);
use Exporter qw(import);
our @EXPORT = qw(get_provider_methods add_method_provider get_provider_type);

our $VERSION   = '0.01';
our $AUTHORITY = 'cpan:STEVAN';

my %REGISTRY;

sub get_provider_type {
    my $name = shift;
    return $REGISTRY{$name}->{type} || confess "No provider named $name";
}

sub get_provider_methods {
    my ($name, $how) = @_;
    $how ||= q();

    my $methods = $REGISTRY{$name}->{provides}
        || confess "No provider named $name";

    if ($how eq ':all') {
        return $methods;
    }

    if (ref $how eq 'ARRAY') {
        return { 
            map { 
                $_ => $methods->{$_} || confess "No factory named $_" 
            } (@$how) 
        };
    }

    if (ref $how eq 'HASH') {
        return { 
            map { 
                my ($old, $new) = ($_, $how->{$_});
                $new => $methods->{$old} || confess "No factory named $old"
            } (keys %$how)
        };
    }

    confess "Don't know to get provider methods by $how";
}

sub add_method_provider ($;%) {
    my ($name, %options) = @_;

    confess "Already a method provider named $name" 
        if exists $REGISTRY{$name};

    my $method_map = $options{provides} or confess "No factories provided";

    my $consumes = $options{consumes};
    foreach my $provider (keys %$consumes) {
        my $methods = get_provider_methods($provider, $consumes->{$provider});
        foreach (keys %$methods) {
            confess "Method $_ already provided" if exists $method_map->{$_};
            $method_map->{$_} = $methods->{$_};
        };
    }

    $REGISTRY{$name} = {
        type     => $options{type} || 'Any',
        provides => $method_map,
    };
}

1;