Mercurial > pub > Impl
changeset 251:9f394b27dccf
require can handle recursive module references
author | sergey |
---|---|
date | Fri, 16 Nov 2012 16:44:16 +0400 |
parents | 129e48bb5afb |
children | 34a3f8668b58 |
files | Lib/IMPL/declare.pm Lib/IMPL/require.pm |
diffstat | 2 files changed, 47 insertions(+), 11 deletions(-) [+] |
line wrap: on
line diff
--- a/Lib/IMPL/declare.pm Wed Nov 07 04:17:53 2012 +0400 +++ b/Lib/IMPL/declare.pm Fri Nov 16 16:44:16 2012 +0400 @@ -5,6 +5,12 @@ use Carp qw(carp); use IMPL::Class::PropertyInfo(); use IMPL::Const qw(:access); +use IMPL::require(); + +BEGIN { + *_require = *IMPL::require::_require; + *_trace = *IMPL::require::_trace; +} sub import { my ( $self, $args ) = @_; @@ -18,8 +24,13 @@ my $caller = caller; my $aliases = $args->{require} || {}; + + _trace("declare $caller"); + $IMPL::require::level++; while ( my ( $alias, $class ) = each %$aliases ) { + _trace("$alias => $class"); + $IMPL::require::level ++; my $c = _require($class); *{"${caller}::$alias"} = set_prototype( @@ -28,6 +39,7 @@ }, '' ); + $IMPL::require::level --; } my $base = $args->{base} || {}; @@ -39,7 +51,10 @@ carp "Odd elements number in require" unless scalar(@$base) % 2 == 0; while ( my ( $class, $mapper ) = splice @$base, 0, 2 ) { + _trace("parent $class"); + $IMPL::require::level ++; $class = $aliases->{$class} || _require($class); + $IMPL::require::level --; push @isa, $class; $ctor{$class} = $mapper; @@ -47,7 +62,10 @@ } elsif ( ref $base eq 'HASH' ) { while ( my ( $class, $mapper ) = each %$base ) { + _trace("parent $class"); + $IMPL::require::level ++; $class = $aliases->{$class} || _require($class); + $IMPL::require::level --; push @isa, $class; $ctor{$class} = $mapper; @@ -86,16 +104,8 @@ $propInfo->Implement(); } } -} - -sub _require { - my ($class) = @_; - - if ( not $class =~ s/^-// ) { - ( my $file = $class ) =~ s/::|'/\//g; - require "$file.pm"; - } - $class; + + $IMPL::require::level--; } 1;
--- a/Lib/IMPL/require.pm Wed Nov 07 04:17:53 2012 +0400 +++ b/Lib/IMPL/require.pm Fri Nov 16 16:44:16 2012 +0400 @@ -1,7 +1,12 @@ package IMPL::require; use Scalar::Util qw(set_prototype); use strict; -require IMPL::Code::Loader; +#require IMPL::Code::Loader; + +our %PENDING; +our $LOADER_LOG; + +our $level = 0; sub import { my ($self, $aliases) = @_; @@ -15,11 +20,16 @@ no strict 'refs'; while( my ($alias, $class) = each %$aliases ) { + _trace("$alias => $class"); + $level++; + $class = _require($class); *{"${caller}::$alias"} = set_prototype(sub { $class }, ''); + + $level--; } } @@ -28,11 +38,27 @@ if ( not $class =~ s/^-// ) { ( my $file = $class ) =~ s/::|'/\//g; + _trace("already pending") and return + 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__