49
+ − 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
92
+ − 23 warn "IMPL::Config::Class is absolute, use IMPL::Config::Activator instead";
49
+ − 24 }
+ − 25
+ − 26 sub _is_class {
+ − 27 no strict 'refs';
+ − 28 scalar keys %{"$_[0]::"} ? 1 : 0;
+ − 29 }
+ − 30
+ − 31 sub instance {
+ − 32 my $this = shift;
+ − 33
+ − 34 my $type = $this->Type;
+ − 35
+ − 36 if ($this->IsSingleton) {
+ − 37 if ($this->_Instance) {
+ − 38 return $this->_Instance;
+ − 39 } else {
+ − 40 my %args = (%{$this->Parameters || {}},@_);
+ − 41 eval "require $type" unless _is_class($type);
+ − 42 my $inst = $type->new(%args);
+ − 43 $this->_Instance($inst);
+ − 44 return $inst;
+ − 45 }
+ − 46 } else {
+ − 47 my %args = (%{$this->Parameters || {}},@_);
+ − 48 eval "require $type" unless _is_class($type);
+ − 49 return $type->new(%args);
+ − 50 }
+ − 51 }
+ − 52
+ − 53 1;