Mercurial > pub > Impl
view Lib/IMPL/require.pm @ 337:f4e14f32cf54
fixed bugs with string and local $_
added support for localized labels
author | cin |
---|---|
date | Fri, 14 Jun 2013 15:37:34 +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