view Lib/IMPL/Config/Activator.pm @ 165:76515373dac0

Added Class::Template, Rewritten SQL::Schema 'use parent' directive instead of 'use base'
author wizard
date Sat, 23 Apr 2011 23:06:48 +0400
parents 0667064553ef
children d1676be8afcc
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;