File Coverage

blib/lib/DCI/Context.pm

Criterion	Covered	Total	%
statement	34	34	100.0
branch	6	10	60.0
condition	2	6	33.3
subroutine	6	6	100.0
pod	2	2	100.0
total	50	58	86.2

package DCI::Context;
use strict;
use warnings;

use Carp();

sub import {
    my $class = shift;
    my $caller = caller;

    $class->before_import( $class, $caller, \@_ )
        if $class->can( 'before_import' );

    $class->dci_export_to( $caller, @_ );

    $class->after_import_import( $class, $caller, @_ )
        if $class->can( 'after_import' );
}

sub dci_export_to {
    my $class = shift;
    my ( $caller, @export_list ) = @_;

    my %exports = $class->dci_meta->dci_exports;
    @export_list = keys %exports unless @export_list;

    for my $name ( @export_list ) {
        my $sub = $exports{ $name } || Carp::croak "$class does not export '$name'";
        $class->dci_meta->inject( $caller, $name => $sub );
    }
}

sub new {
    my $class = shift;
    my %args = @_;

    my $self = bless {}, $class;

    my %roles = map {( $_ => 1 )} $class->dci_meta->roles;
    my %maybe = map {( $_ => 1 )} $class->dci_meta->maybe_roles;
    for my $arg ( keys %args ) {
        Carp::croak( "$class has no role '$arg' to fill" )
            unless $roles{$arg} || $maybe{$arg};

        delete $roles{$arg};

        # The method takes care of applying the cast.
        $self->$arg( $args{$arg} );
    }

    # Ensure all roles are filled.
    Carp::croak( "No objects provided for roles: " . join( ", ", keys %roles ))
        if keys %roles;

    return $self;
}

1;

__END__