view Lib/IMPL/Config/Class.pm @ 94:79bf75223afe

Fixed security related bugs
author wizard
date Thu, 29 Apr 2010 01:31:27 +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;