#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Test::Moose;
use Bread::Board;
{
package Logger::Role;
use Moose::Role;
requires 'log';
package My::Logger;
use Moose;
with 'Logger::Role';
has 'level' => ( is => 'ro', isa => 'Str', default => 'warn' );
sub log {}
package My::DBI;
use Moose;
has 'dsn' => (is => 'ro', isa => 'Str');
sub connect {
my ($class, $dsn) = @_;
$class->new( dsn => $dsn );
}
package My::Application;
use Moose;
has 'logger' => (is => 'ro', does => 'Logger::Role', required => 1);
has 'dbh' => (is => 'ro', isa => 'My::DBI', required => 1);
}
my $c = container 'Automat' => as {
service 'dsn' => 'dbi:sqlite:test';
service 'dbh' => (
block => sub {
my $s = shift;
My::DBI->connect( $s->param( 'dsn' ) );
},
dependencies => [ depends_on('dsn') ]
);
# map a type to a service implementation ...
typemap 'My::DBI' => 'dbh';
# ask the container to infer a service,
# but give it some hints ....
typemap 'Logger::Role' => infer( class => 'My::Logger' );
# ask the container to infer the
# entire service ...
typemap 'My::Application' => infer;
};
# check the inference from the top level Application ...
{
my $app = $c->resolve( type => 'My::Application' );
isa_ok($app, 'My::Application');
isa_ok($app->logger, 'My::Logger');
does_ok($app->logger, 'Logger::Role');
is($app->logger->level, 'warn', '... got the default level');
isa_ok($app->dbh, 'My::DBI');
is($app->dbh->dsn, 'dbi:sqlite:test', '... got the right DSN too');
}
# check the inference from the logger object
# and its optional 'level' parameter
{
my $logger = $c->resolve(
type => 'Logger::Role',
parameters => { level => 'debug' }
);
isa_ok($logger, 'My::Logger');
does_ok($logger, 'Logger::Role');
is($logger->level, 'debug', '... got the custom level');
}
done_testing;