Mercurial > pub > Impl
view Lib/IMPL/Config/Class.pm @ 118:79cdd6c86409
JSON support (experimental)
author | wizard |
---|---|
date | Mon, 07 Jun 2010 08:21:26 +0400 |
parents | 5f676b61fb8b |
children | 76515373dac0 |
line wrap: on
line source
package IMPL::Config::Class; use strict; use warnings; use base qw(IMPL::Config); use IMPL::Exception; use IMPL::Class::Property; BEGIN { public property Type => prop_all; public property Parameters => prop_all; public property IsSingleton => prop_all; private property _Instance => prop_all; } __PACKAGE__->PassThroughArgs; sub CTOR { my $this = shift; die new IMPL::Exception("A Type parameter is required") unless $this->Type; warn "IMPL::Config::Class is absolute, use IMPL::Config::Activator instead"; } sub _is_class { no strict 'refs'; scalar keys %{"$_[0]::"} ? 1 : 0; } sub instance { my $this = shift; my $type = $this->Type; if ($this->IsSingleton) { if ($this->_Instance) { return $this->_Instance; } else { my %args = (%{$this->Parameters || {}},@_); eval "require $type" unless _is_class($type); my $inst = $type->new(%args); $this->_Instance($inst); return $inst; } } else { my %args = (%{$this->Parameters || {}},@_); eval "require $type" unless _is_class($type); return $type->new(%args); } } 1;