annotate _test/temp.pl @ 412:30e8c6a74937 ref20150831

working on di container (role based registrations)
author cin
date Mon, 21 Sep 2015 19:54:10 +0300
parents ee36115f6a34
children ec6f2d389d1e
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);
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
5 use Scalar::Util qw(blessed);
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
6 my $slot;
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
7 my $ref = bless \$slot, 'Wrapper';
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
8 sub is {
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
9 my $slot = shift;
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
10 bless \$slot, 'Wrapper';
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
11 }
395
212cc86e470b Code cleanup
sergey
parents: 381
diff changeset
12
412
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
13 sub instanceOf {
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
14 carp "A typename can't be undefined" unless $_[1];
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
15 blessed($_[0]) and $_[0]->isa($_[1])
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
16 }
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
17
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
18 my $bar = Bar->new();
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
19
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
20 my $t = [gettimeofday];
407
c6e90e02dd17 renamed Lib->lib
cin
parents: 406
diff changeset
21
412
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
22 for(my $i =0; $i< 1000000; $i++) {
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
23 is($bar)->instanceOf('Bar');
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
24 }
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
25
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
26 print "Is: ",tv_interval($t,[gettimeofday]),"\n";
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
27
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
28 $t = [gettimeofday];
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
29
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
30 for(my $i =0; $i< 1000000; $i++) {
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
31 instanceOf($bar, 'Bar');
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
32 }
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
33
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
34 print "Is: ",tv_interval($t,[gettimeofday]),"\n";
407
c6e90e02dd17 renamed Lib->lib
cin
parents: 406
diff changeset
35
c6e90e02dd17 renamed Lib->lib
cin
parents: 406
diff changeset
36
412
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
37 package Wrapper;
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
38 use Scalar::Util qw(blessed);
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
39 sub instanceOf {
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
40 blessed(${$_[0]}) and ${$_[0]}->isa($_[1]);
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
41 }
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
42
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
43 package Bar;
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
44 use IMPL::declare {
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
45 base => ['IMPL::Object' => undef]
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
46 };
30e8c6a74937 working on di container (role based registrations)
cin
parents: 411
diff changeset
47
407
c6e90e02dd17 renamed Lib->lib
cin
parents: 406
diff changeset
48 1;