1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use Test::More; 7use Test::Moose; 8 9use Bread::Board; 10 11{ 12 package Logger::Role; 13 use Moose::Role; 14 15 requires 'log'; 16 17 package My::Logger; 18 use Moose; 19 20 with 'Logger::Role'; 21 22 has 'level' => ( is => 'ro', isa => 'Str', default => 'warn' ); 23 24 sub log {} 25 26 package My::DBI; 27 use Moose; 28 29 has 'dsn' => (is => 'ro', isa => 'Str'); 30 31 sub connect { 32 my ($class, $dsn) = @_; 33 $class->new( dsn => $dsn ); 34 } 35 36 package My::Application; 37 use Moose; 38 39 has 'logger' => (is => 'ro', does => 'Logger::Role', required => 1); 40 has 'dbh' => (is => 'ro', isa => 'My::DBI', required => 1); 41} 42 43my $c = container 'Automat' => as { 44 45 service 'dsn' => 'dbi:sqlite:test'; 46 service 'dbh' => ( 47 block => sub { 48 my $s = shift; 49 My::DBI->connect( $s->param( 'dsn' ) ); 50 }, 51 dependencies => [ depends_on('dsn') ] 52 ); 53 54 # map a type to a service implementation ... 55 typemap 'My::DBI' => 'dbh'; 56 57 # ask the container to infer a service, 58 # but give it some hints .... 59 typemap 'Logger::Role' => infer( class => 'My::Logger' ); 60 61 # ask the container to infer the 62 # entire service ... 63 typemap 'My::Application' => infer; 64}; 65 66# check the inference from the top level Application ... 67{ 68 my $app = $c->resolve( type => 'My::Application' ); 69 isa_ok($app, 'My::Application'); 70 71 isa_ok($app->logger, 'My::Logger'); 72 does_ok($app->logger, 'Logger::Role'); 73 is($app->logger->level, 'warn', '... got the default level'); 74 75 isa_ok($app->dbh, 'My::DBI'); 76 is($app->dbh->dsn, 'dbi:sqlite:test', '... got the right DSN too'); 77} 78 79# check the inference from the logger object 80# and its optional 'level' parameter 81{ 82 my $logger = $c->resolve( 83 type => 'Logger::Role', 84 parameters => { level => 'debug' } 85 ); 86 isa_ok($logger, 'My::Logger'); 87 does_ok($logger, 'Logger::Role'); 88 is($logger->level, 'debug', '... got the custom level'); 89} 90 91done_testing; 92