Mercurial > pub > Impl

comparison Lib/IMPL/declare.pm @ 251:9f394b27dccf

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
require can handle recursive module references
author sergey
date Fri, 16 Nov 2012 16:44:16 +0400
parents 6d8092d8ce1b
children 34a3f8668b58
comparison
equal deleted inserted replaced
250:129e48bb5afb 251:9f394b27dccf
3 3
4 use Scalar::Util qw(set_prototype); 4 use Scalar::Util qw(set_prototype);
5 use Carp qw(carp); 5 use Carp qw(carp);
6 use IMPL::Class::PropertyInfo(); 6 use IMPL::Class::PropertyInfo();
7 use IMPL::Const qw(:access); 7 use IMPL::Const qw(:access);
8 use IMPL::require();
9
10 BEGIN {
11 *_require = *IMPL::require::_require;
12 *_trace = *IMPL::require::_trace;
13 }
8 14
9 sub import { 15 sub import {
10 my ( $self, $args ) = @_; 16 my ( $self, $args ) = @_;
11 17
12 return unless $args; 18 return unless $args;
16 no strict 'refs'; 22 no strict 'refs';
17 23
18 my $caller = caller; 24 my $caller = caller;
19 25
20 my $aliases = $args->{require} || {}; 26 my $aliases = $args->{require} || {};
27
28 _trace("declare $caller");
29 $IMPL::require::level++;
21 30
22 while ( my ( $alias, $class ) = each %$aliases ) { 31 while ( my ( $alias, $class ) = each %$aliases ) {
32 _trace("$alias => $class");
33 $IMPL::require::level ++;
23 my $c = _require($class); 34 my $c = _require($class);
24 35
25 *{"${caller}::$alias"} = set_prototype( 36 *{"${caller}::$alias"} = set_prototype(
26 sub { 37 sub {
27 $c; 38 $c;
28 }, 39 },
29 '' 40 ''
30 ); 41 );
42 $IMPL::require::level --;
31 } 43 }
32 44
33 my $base = $args->{base} || {}; 45 my $base = $args->{base} || {};
34 46
35 my %ctor; 47 my %ctor;
37 49
38 if ( ref $base eq 'ARRAY' ) { 50 if ( ref $base eq 'ARRAY' ) {
39 carp "Odd elements number in require" 51 carp "Odd elements number in require"
40 unless scalar(@$base) % 2 == 0; 52 unless scalar(@$base) % 2 == 0;
41 while ( my ( $class, $mapper ) = splice @$base, 0, 2 ) { 53 while ( my ( $class, $mapper ) = splice @$base, 0, 2 ) {
54 _trace("parent $class");
55 $IMPL::require::level ++;
42 $class = $aliases->{$class} || _require($class); 56 $class = $aliases->{$class} || _require($class);
57 $IMPL::require::level --;
43 58
44 push @isa, $class; 59 push @isa, $class;
45 $ctor{$class} = $mapper; 60 $ctor{$class} = $mapper;
46 } 61 }
47 } 62 }
48 elsif ( ref $base eq 'HASH' ) { 63 elsif ( ref $base eq 'HASH' ) {
49 while ( my ( $class, $mapper ) = each %$base ) { 64 while ( my ( $class, $mapper ) = each %$base ) {
65 _trace("parent $class");
66 $IMPL::require::level ++;
50 $class = $aliases->{$class} || _require($class); 67 $class = $aliases->{$class} || _require($class);
68 $IMPL::require::level --;
51 69
52 push @isa, $class; 70 push @isa, $class;
53 $ctor{$class} = $mapper; 71 $ctor{$class} = $mapper;
54 } 72 }
55 } 73 }
84 } 102 }
85 ); 103 );
86 $propInfo->Implement(); 104 $propInfo->Implement();
87 } 105 }
88 } 106 }
89 } 107
90 108 $IMPL::require::level--;
91 sub _require {
92 my ($class) = @_;
93
94 if ( not $class =~ s/^-// ) {
95 ( my $file = $class ) =~ s/::|'/\//g;
96 require "$file.pm";
97 }
98 $class;
99 } 109 }
100 110
101 1; 111 1;
102 112
103 __END__ 113 __END__