Mercurial > pub > Impl
comparison Lib/IMPL/Config/Class.pm @ 0:03e58a454b20
Создан репозитарий
author | Sergey |
---|---|
date | Tue, 14 Jul 2009 12:54:37 +0400 |
parents | |
children | 16ada169ca75 |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:03e58a454b20 |
---|---|
1 package IMPL::Config::Class; | |
2 use strict; | |
3 use warnings; | |
4 | |
5 use base qw(IMPL::Config); | |
6 use IMPL::Exception; | |
7 use IMPL::Class::Property; | |
8 | |
9 BEGIN { | |
10 public property Type => prop_all; | |
11 public property Parameters => prop_all; | |
12 public property IsSingleton => prop_all; | |
13 private property _Instance => prop_all; | |
14 } | |
15 | |
16 __PACKAGE__->PassThroughArgs; | |
17 | |
18 sub CTOR { | |
19 my $this = shift; | |
20 | |
21 die new IMPL::Exception("A Type parameter is required") unless $this->Type; | |
22 | |
23 } | |
24 | |
25 sub _is_class { | |
26 no strict 'refs'; | |
27 scalar keys %{"$_[0]::"} ? 1 : 0; | |
28 } | |
29 | |
30 sub instance { | |
31 my $this = shift; | |
32 | |
33 my $type = $this->Type; | |
34 | |
35 if ($this->IsSingleton) { | |
36 if ($this->_Instance) { | |
37 return $this->_Instance; | |
38 } else { | |
39 my %args = (%{$this->Parameters || {}},@_); | |
40 eval "require $type" unless _is_class($type); | |
41 my $inst = $type->new(%args); | |
42 $this->_Instance($inst); | |
43 return $inst; | |
44 } | |
45 } else { | |
46 my %args = (%{$this->Parameters || {}},@_); | |
47 eval "require $type" unless _is_class($type); | |
48 return $type->new(%args); | |
49 } | |
50 } | |
51 | |
52 1; |