view lib/IMPL/require.pm @ 407:c6e90e02dd17 ref20150831

renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children b0481c071bea
line wrap: on
line source

package IMPL::require;
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"} = 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