Mercurial > pub > Impl
view lib/IMPL/require.pm @ 425:c27434cdd611 ref20150831
sync
author | cin |
---|---|
date | Tue, 03 Apr 2018 19:30:01 +0300 |
parents | b0481c071bea |
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