view Lib/IMPL/Code/Loader.pm @ 399:753e981782ce

sync
author cin
date Mon, 12 May 2014 18:04:40 +0400
parents 4ddb27ff4a0b
children
line wrap: on
line source

package IMPL::Code::Loader;
use strict;
use warnings;

use IMPL::Const qw(:prop);
use File::Spec;
use IMPL::declare {
	require => {
		Exception => 'IMPL::Exception',
		ArgumentException => '-IMPL::InvalidArgumentException' 
	},
	base => {
		'IMPL::Object' => undef,
		'IMPL::Object::Autofill' => '@_'
	},
	props => [
	   verifyNames => PROP_RO,
	   prefix => PROP_RO,
	   _pending => PROP_RW
	]
};

my $default;
sub default {
	$default ||= new IMPL::Code::Loader;
}

my $safe;
sub safe {
	$safe ||= new IMPL::Code::Loader(verifyNames => 1);
}

sub CTOR {
    my ($this) = @_;
    
    $this->_pending({});
}

sub Require {
    my ($this,$package) = @_;
    
    if ($this->verifyNames) {
    	$package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/
    	   or die ArgumentException->new(package => 'Invalid package name') ;
    	$package = $1;
    }
    
    $package = $this->prefix . '::' . $package if $this->prefix;
    
    my $file = join('/', split(/::/,$package)) . ".pm";
    
    require $file;
        
    return $package;
}

sub ModuleExists {
    my ($this,$package) = @_;
    
    my $file = join('/', split(/::/,$this->GetFullName($package))) . ".pm";
    
    -f File::Spec->catfile($_,$file) and return 1 foreach @INC;
    
    return 0;
}

sub GetFullName {
    my ($this,$package) = @_;
    
    if ($this->verifyNames) {
        $package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/
           or die ArgumentException->new(package => 'Invalid package name') ;
    }
    
    return $this->prefix . '::' . $package if $this->prefix;
}

1;