view lib/IMPL/require.pm @ 427:09e0086a82a7 ref20150831 tip

Merge
author cin
date Tue, 15 May 2018 00:51:33 +0300
parents c27434cdd611
children
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 = shift;

	my $aliases;

	if ( @_ == 1 ) {
		my $aliases = shift;
		die "A hash reference is required" unless ref $aliases eq 'HASH';
	}
	else {
		die "A list of pairs is expected" unless @_ % 2 == 0;
		$aliases = {@_};
	}

	my $caller = caller;

	$PENDING{$caller} = 1;

	no strict 'refs';
	while ( my ( $alias, $spec ) = each %$aliases ) {
		my ( $mode, $class ) = m/^(-|~)(.*)/;

		_trace("$alias => $spec [$class]");

		$class =~ s/^SELF(?=\W|$)/${caller}::/;
		$level++;

		if ( $mode eq '-' ) {
			*{"${caller}::$alias"} = sub () {
				$class;
			};
		}
		elsif ( $mode eq '~' ) {
			*{"${caller}::$alias"} = sub () {
				my $c = _require($class);
				*{"${caller}::$alias"} = sub() { $c };
				return $c;
			};
		}
		else {
			my $c = _require($class);
			*{"${caller}::$alias"} = sub () {
				$c;
			};
		}

		$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