view Lib/IMPL/Config/Activator.pm @ 197:6b1dda998839

Added IMPL::declare, IMPL::require, to simplify module definitions IMPL::Transform now admires object inheritance while searching for the transformation Added HTTP some exceptions IMPL::Web::Application::RestResource almost implemented
author sergey
date Thu, 19 Apr 2012 02:10:02 +0400
parents 4d0e1962161c
children c8fe3f84feba
line wrap: on
line source

package IMPL::Config::Activator;
use strict;

use parent qw(IMPL::Object IMPL::Object::Autofill IMPL::Object::PublicSerializable);
use IMPL::Class::Property;

BEGIN {
    public property factory => prop_all;
    public property parameters => prop_all;
    public property object => prop_get | owner_set;
}

__PACKAGE__->PassThroughArgs;

sub CTOR {
    my $this = shift;

    die new IMPL::Exception("A Type parameter is required") unless $this->factory;
    
}

sub _is_class {
    no strict 'refs';
    UNIVERSAL::can($_[0],'new') ? 1 : 0;
}

sub activate {
    my $this = shift;
    
    unless ($this->object) {
        my @args;
        
        my $params = $this->parameters;
        if (UNIVERSAL::isa($params,'HASH')) {
            while ( my ($key,$value) = each %$params ) {
                push @args,$key, UNIVERSAL::isa($value,'IMPL::Config::Activator') ? $value->activate : $value;
            }
        } elsif (UNIVERSAL::isa($params,'ARRAY')) {
            push @args, map UNIVERSAL::isa($_,'IMPL::Config::Activator') ? $_->activate : $_, @$params;
        } else {
            push @args, UNIVERSAL::isa($params,'IMPL::Config::Activator') ? $params->activate : $params;
        }
        
        push @args,  map UNIVERSAL::isa($_,'IMPL::Config::Activator') ? $_->activate : $_, @_ if @_;
        
        my $factory = $this->factory;
        eval "require $factory; 1;" unless (ref $factory or _is_class($factory));
        
        return $this->object($factory->new(@args));
    } else {
        return $this->object;
    }
}

1;