1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Test::More tests => 39;
7use Test::Exception;
8
9BEGIN {
10    use_ok('IOC::Config::XML');
11}
12
13can_ok("IOC::Config::XML", 'new');
14
15{
16    my $conf = IOC::Config::XML->new();
17    isa_ok($conf, 'IOC::Config::XML');
18
19    can_ok($conf, 'read');
20}
21
22# real world test ...
23{
24    {
25        package My::DBI;
26
27        sub connect { bless {} }
28
29        package My::DB::Logger;
30
31        sub new { bless {} }
32        sub setDBIConnection {
33            my ($self, $dbi) = @_;
34            $self->{dbi} = $dbi;
35        }
36        sub setDBTableName {
37            my ($self, $db_table_name) = @_;
38            $self->{db_table_name} = $db_table_name;
39        }
40
41        package My::Application;
42
43        sub new { bless {} }
44        sub setLogger {
45            my ($self, $logger) = @_;
46            $self->{logger} = $logger;
47        }
48
49        package My::Template::Factory;
50        sub new { bless { array => $_[1], hash  => $_[2], string => $_[3] } }
51    }
52
53    my $sample_config = q|
54    <Registry>
55        <Container name='Application'>
56            <Container name='Database'>
57                <Service name='dsn'      type='Literal'>dbi:NullP:</Service>
58                <Service name='username' type='Literal'>user</Service>
59                <Service name='password' type='Literal'><![CDATA[****]]></Service>
60                <Service name='connection' type='ConstructorInjection'>
61                    <Class name='My::DBI' constructor='connect' />
62                    <Parameter type='component'>dsn</Parameter>
63                    <Parameter type='component'>username</Parameter>
64                    <Parameter type='component'>password</Parameter>
65                </Service>
66            </Container>
67            <Service name='logger_table' type='Literal'>tbl_log</Service>
68            <Service name='logger' type='SetterInjection'>
69                <Class name='My::DB::Logger' constructor='new' />
70                <Setter name='setDBIConnection'><![CDATA[/Database/connection]]></Setter>
71                <Setter name='setDBTableName'>logger_table</Setter>
72            </Service>
73            <Service name='template_factory' type='ConstructorInjection'>
74                <Class name='My::Template::Factory' constructor='new' />
75                <Parameter type='perl'>[ 1, 2, 3 ]</Parameter>
76                <Parameter type='perl'><![CDATA[{ path => 'test' }]]></Parameter>
77                <Parameter><![CDATA[Testing CDATA here]]></Parameter>
78            </Service>
79            <Service name='app'>
80                <![CDATA[
81                    my $c = shift;
82                    my $app = My::Application->new();
83                    $app->setLogger($c->get('logger'));
84                    return $app;
85                ]]>
86            </Service>
87        </Container>
88    </Registry>
89    |;
90
91    my $conf = IOC::Config::XML->new();
92    isa_ok($conf, 'IOC::Config::XML');
93
94    lives_ok {
95        $conf->read($sample_config);
96    } '... we read the conf okay';
97
98    my $reg = IOC::Registry->new();
99    isa_ok($reg, 'IOC::Registry');
100
101    is_deeply(
102        [ $reg->getRegisteredContainerList() ],
103        [ 'Application' ],
104        '... got the list of registered containers');
105
106    my $app = $reg->getRegisteredContainer('Application');
107    isa_ok($app, 'IOC::Container');
108
109    is($app->name(), 'Application', '... got the right name');
110
111    is_deeply(
112        [ $app->getSubContainerList() ],
113        [ 'Database' ],
114        '... the right sub container list');
115
116    my $db = $app->getSubContainer('Database');
117    isa_ok($db, 'IOC::Container');
118
119    is($db->name(), 'Database', '... got the right name');
120
121    is_deeply(
122        [ sort $db->getServiceList() ],
123        [ 'connection', 'dsn', 'password', 'username' ],
124        '... got the right service list');
125
126    is($db->get('dsn'),      'dbi:NullP:', '... got the right value');
127    is($db->get('username'), 'user',      '... got the right value');
128    is($db->get('password'), '****',      '... got the right value');
129
130    my $dbh = $db->get('connection');
131    isa_ok($dbh, 'My::DBI');
132
133    is_deeply(
134        [ sort $app->getServiceList() ],
135        [ 'app', 'logger', 'logger_table', 'template_factory' ],
136        '... the right service list');
137
138    is($app->get('logger_table'), 'tbl_log', '... got the right logger table');
139
140    my $logger = $app->get('logger');
141    isa_ok($logger, 'My::DB::Logger');
142
143    isa_ok($logger->{dbi}, 'My::DBI');
144    is($logger->{dbi}, $dbh, '... and it is the same database handle too');
145
146    is($logger->{db_table_name}, 'tbl_log', '... got the right logger table');
147
148    {
149        my $app = $reg->locateService('/Application/app');
150        isa_ok($app, 'My::Application');
151
152        is($app->{logger}, $logger, '... got the same logger');
153    }
154
155    my $template_factory = $app->get('template_factory');
156    isa_ok($template_factory, 'My::Template::Factory');
157
158    is_deeply(
159        $template_factory->{array},
160        [ 1, 2, 3 ],
161        '... got the right array value');
162
163    is_deeply(
164        $template_factory->{hash},
165        { path => 'test' },
166        '... got the right hash value');
167
168    is($template_factory->{string}, 'Testing CDATA here', '... got the right string value');
169
170    $reg->DESTROY();
171}
172
173# testing prototypes
174{
175    my $sample_config = q|
176    <Registry>
177        <Container name='test'>
178            <Service name='test_service' prototype='false'>
179            <![CDATA[
180                return bless({}, 'My::Test');
181            ]]>
182            </Service>
183            <Service name='test_service2' prototype='true'>
184            <![CDATA[
185                return bless({}, 'My::Test2');
186            ]]>
187            </Service>
188        </Container>
189    </Registry>
190    |;
191
192    my $conf = IOC::Config::XML->new();
193    isa_ok($conf, 'IOC::Config::XML');
194
195    lives_ok {
196        $conf->read($sample_config);
197    } '... we read the conf okay';
198
199    my $reg = IOC::Registry->new();
200    isa_ok($reg, 'IOC::Registry');
201
202    my $c = $reg->getRegisteredContainer('test');
203    isa_ok($c, 'IOC::Container');
204
205    is($c->name(), 'test', '... got the right name');
206
207    my $test_service = $c->get('test_service');
208    isa_ok($test_service, 'My::Test');
209
210    is($test_service, $c->get('test_service'), '... and if I get it again, it is the same one');
211
212    my $test_service2 = $c->get('test_service2');
213    isa_ok($test_service2, 'My::Test2');
214
215    isnt($test_service2, $c->get('test_service2'), '... and if I get it again, it is not the same one');
216
217    $reg->DESTROY();
218}
219
220