annotate _test/temp.pl @ 417:3ed0c58e9da3 ref20150831

working on di container, tests
author cin
date Mon, 02 Nov 2015 01:56:53 +0300
parents 3d24b10dd0d5
children 3f38dabaf5cc
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
210
6adaeb86945d added IMPL::Web::AutoLocator
sergey
parents: 209
diff changeset
1 #!/usr/bin/perl
6adaeb86945d added IMPL::Web::AutoLocator
sergey
parents: 209
diff changeset
2 use strict;
412
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
3 use Carp;
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
4 use Time::HiRes qw(gettimeofday tv_interval);
415
3d24b10dd0d5 working on IMPL::Config::Container
cin
parents: 414
diff changeset
5 use Scalar::Util qw(blessed refaddr);
3d24b10dd0d5 working on IMPL::Config::Container
cin
parents: 414
diff changeset
6 use YAML::XS qw(Dump);
407
c6e90e02dd17 renamed Lib->lib
cin
parents: 406
diff changeset
7
417
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
8 my $t = [gettimeofday];
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
9
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
10 use IMPL::require {
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
11 Container => 'IMPL::Config::Container',
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
12 Service => 'IMPL::Config::ServiceDescriptor',
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
13 Reference => 'IMPL::Config::ReferenceDescriptor',
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
14 Value => 'IMPL::Config::ValueDescriptor'
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
15 };
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
16
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
17 my $c1 = Container->new();
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
18
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
19 $c1->Register('db', Service->new(
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
20 type => 'Foo::Data',
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
21 norequire => 1,
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
22 activation => 'container'
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
23 ) );
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
24
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
25 $c1->Register(['sec', 'ldap'], Reference->new('db') );
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
26
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
27 $c1->Register('mixed', Value->new([
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
28 Reference->new('db'),
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
29 Reference->new('sec'),
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
30 Reference->new('ldap')
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
31 ]));
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
32
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
33 my $c2 = Container->new($c1);
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
34
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
35 my $data = [ $c1->Resolve('mixed')] ;
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
36
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
37 print "Activated: ",tv_interval($t,[gettimeofday]),"\n";
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
38
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
39 print Dump($data);
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
40
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
41
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
42 package Foo::Data;
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
43 use IMPL::declare {
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
44 base => [
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
45 'IMPL::Object' => undef
415
3d24b10dd0d5 working on IMPL::Config::Container
cin
parents: 414
diff changeset
46 ]
3d24b10dd0d5 working on IMPL::Config::Container
cin
parents: 414
diff changeset
47 };
417
3ed0c58e9da3 working on di container, tests
cin
parents: 415
diff changeset
48
407
c6e90e02dd17 renamed Lib->lib
cin
parents: 406
diff changeset
49 1;