diff 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 diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/require.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,99 @@
+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