view Lib/IMPL/require.pm @ 393:69a1f1508696

minor security refactoring
author cin
date Fri, 14 Feb 2014 16:41:12 +0400
parents 0f59b2de72af
children
line wrap: on
line source

package IMPL::require;
use Scalar::Util qw(set_prototype);
use strict;
#require IMPL::Code::Loader;

use Carp qw(carp);

our %PENDING;
our $LOADER_LOG;

our $level = 0;

sub import {
	my ($self, $aliases) = @_;
	
	return unless $aliases;
	
	die "A hash reference is required" unless ref $aliases eq 'HASH';
	
	my $caller = caller;
	
	$PENDING{$caller} = 1;
	
	no strict 'refs';
	
	while( my ($alias, $class) = each %$aliases ) {
		_trace("$alias => $class");
		$level++;
	    
	    $class = _require($class);
		
		*{"${caller}::$alias"} = set_prototype(sub {
            $class
        }, '');
        
        $level--;
	}
	
	delete $PENDING{$caller};
}

sub _require {
    my ($class) = @_;

    if ( not $class =~ s/^-// ) {
        ( my $file = $class ) =~ s/::|'/\//g;
        _trace("already pending") and return $class
            if $PENDING{$class};
        $PENDING{$class} = 1;
        _trace("loading $file.pm");
        $level++;
        require "$file.pm";
        $level--;
        _trace("loaded $file.pm");
        delete $PENDING{$class};
    }
    $class;
}

sub _trace {
	my ($message) = @_;
	
	$LOADER_LOG->print("\t" x $level ,"$message\n") if $LOADER_LOG;
	
	return 1;
}

1;

__END__

=pod

=head1 NAME

C<IMPL::require> загружает и назначет псевдонимы модулям.

=head1 SYNOPSIS

=begin code

use IMPL::require {
	TFoo => 'My::Nested::Package::Foo',
	FS => 'File::Spec'
};

my $obj = My::Nested::Package::Foo->new('foo');
$obj = TFoo->new('foo'); # ditto

FS->catdir('one','two','three');

=end code

=head1 DESCRIPTION

Загружает модули с помощью C<require> и создает константы которые возвращаю полное имя модуля.


=cut