view Lib/IMPL/Config/Class.pm @ 217:bfce101e0a5a

Слияние
author cin
date Mon, 20 Aug 2012 10:27:20 +0400
parents a705e848dcc7
children
line wrap: on
line source

package IMPL::Config::Class;
use strict;
use warnings;

use parent qw(IMPL::Config);
use IMPL::Exception;
use IMPL::Class::Property;
use Carp qw(carp);

BEGIN {
	carp "the module is deprecated";
	
    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;