1
2package Devel::InheritNamespace;
3use Moose;
4use Module::Pluggable::Object;
5use Class::Load;
6use namespace::clean -except => qw(meta);
7
8our $VERSION = '0.00003';
9
10has search_options => (
11    is => 'ro',
12    isa => 'HashRef',
13    predicate => 'has_search_options'
14);
15
16has on_class_found => (
17    is => 'ro',
18    isa => 'CodeRef',
19    predicate => 'has_on_class_found',
20);
21
22has except => (
23    is => 'ro',
24    isa => 'RegexpRef',
25    lazy_build => 1,
26);
27
28sub _build_except {
29    return qr/::SUPER$/;
30}
31
32# from a given list of namespaces, load everything
33# however, if names clash, the first one to be loaded wins
34
35sub search_components_in_namespace {
36    my ($self, $namespace) = @_;
37
38    my @search_path = ($namespace);
39    my %config;
40    if ($self->has_search_options) {
41        %config = %{ $self->search_options };
42    }
43
44    my $locator = Module::Pluggable::Object->new(
45        %config,
46        search_path => [ @search_path ],
47    );
48
49    my @comps;
50    my $except = $self->except;
51    if ($except) {
52        @comps = sort grep { !/$except/ } $locator->plugins;
53    } else {
54        @comps = sort $locator->plugins;
55    }
56
57    return @comps;
58}
59
60
61sub all_modules {
62    my ($self, @namespaces) = @_;
63
64    my @comps;
65    my $main_namespace = $namespaces[0];
66    foreach my $namespace (@namespaces) {
67        push @comps,
68            map {
69                [ $namespace, $_ ]
70            }
71            $self->search_components_in_namespace( $namespace );
72    }
73
74    my %comps;
75    foreach my $comp (@comps) {
76        my ($comp_namespace, $comp_class) = @$comp;
77
78        my $is_virtual;
79        my $base_class;
80
81        if ($comp_namespace eq $main_namespace ) {
82            if (! Class::Load::is_class_loaded($comp_class)) {
83                Class::Load::load_class($comp_class);
84            }
85        } else {
86            $base_class = $comp_class;
87
88            # see if we can make a subclass out of it
89            $comp_class =~ s/^$comp_namespace/$main_namespace/;
90
91            next if $comps{ $comp_class };
92            eval { Class::Load::load_class($comp_class) };
93            if (my $e = $@) {
94                if ($e =~ /Can't locate/) {
95                    # if the module is NOT found in the current app ($class),
96                    # then we build a virtual component. But don't do this
97                    # if $base_class is a role
98                    Class::Load::load_class($base_class);
99                    next if $base_class->can('meta') && $base_class->meta->isa('Moose::Meta::Role');
100
101                    my $meta = Moose::Meta::Class->create(
102                        $comp_class => ( superclasses => [ $base_class ] )
103                    );
104                    $is_virtual = 1;
105                } else {
106                    confess "Failed to load class $comp_class: $e";
107                }
108            }
109        }
110        $comps{ $comp_class } = {
111            is_virtual => $is_virtual,
112            base_class => $base_class
113        };
114
115        if ($self->has_on_class_found) {
116            $self->on_class_found->( $comp_class );
117        }
118    }
119    return \%comps;
120}
121
1221;
123
124__END__
125
126=head1 NAME
127
128Devel::InheritNamespace - Inherit An Entire Namespace
129
130=head1 SYNOPSIS
131
132    use Devel::InheritNamespace;
133
134    my $din = Devel::InheritNamespace->new(
135        on_class_found => sub { ... },
136    );
137    my @modules =
138        $din->all_modules( 'MyApp', 'Parent::Namespace1', 'Parent::Namespace2' );
139
140=head1 DESCRIPTION
141
142WARNING: YMMV using this module.
143
144This module allows you to dynamically "inherit" an entire namespace.
145
146For example, suppose you have a set of packages under MyApp::Base:
147
148    MyApp::Base::Foo
149    MyApp::Base::Bar
150    MyApp::Base::Baz
151
152Then some time later you start writing MyApp::Extend.
153You want to reuse MyApp::Base::Foo and MyApp::Base::Bar by subclassing
154(because somehow the base namespace matters -- say, in Catalyst), but
155you want to put a little customization for MyApp::Base::Baz
156
157Normally you achieve this by manually creating MyApp::Extended:: modules:
158
159    # in MyApp/Extended/Foo.pm
160    package MyApp::Extended::Foo;
161    use Moose;
162    extends 'MyApp::Base::Foo';
163
164    # in MyApp/Extended/Bar.pm
165    package MyApp::Extended::Bar;
166    use Moose;
167    extends 'MyApp::Base::Bar';
168
169    # in MyApp/Extended/Baz.pm
170    package MyApp::Extended::Baz;
171    use Moose;
172    extends 'MyApp::Base::Baz';
173
174    ... whatever customization you need ...
175
176This is okay for a small number of modules, or if you are only doing this once
177or twice. But perhaps you have tens of these modules, or maybe you do this
178on every new project you create to inherit from a base applicatin set.
179
180In that case you can use Devel::InheritNamespace.
181
182=head1 METHODS
183
184=head2 C<< $class->new(%options) >>
185
186Constructs a new Devel::InheritNamespace instance. You may pass the following
187options:
188
189=over 4
190
191=item except
192
193Regular expression to stop certain modules to be included in the search list.
194Note: This option will probably be deleted in the future releases: see
195C<search_options> and Module::Pluggable for a way to achieve this.
196
197=item on_class_found
198
199Callback that gets called when a new class was loaded.
200
201=item search_options
202
203Extra arguments to pass to Module::Pluggable::Object to search for modules.
204
205=back
206
207=head2 C<< $self->all_modules( $main_namespace, @namespaces_to_inherit ) >>;
208
209Loads modules based on the following heuristics:
210
211    1. Search all modules in $main_namespace using Module::Pluggable.
212    2. Load those modules
213    3. Repease searching in namespaces declared in the @namespaces_to_inherit
214    4. Check if the corresponding module in the $main_namespace exists.
215       (we basically do $class =~ s/^$current_namespace/$main_namespace/)
216    5. If the module is already loaded, skip and check the module
217    6. If the module has not been loaded, dynamically create a module in
218       the $main_namespace, inheriting from the original one.
219    7. Repeat above for all namespaces.
220
221=head1 TODO
222
223Documentation. Samples. Tests.
224
225=head1 AUTHOR
226
227Daisuke Maki C<< <daisuke@endeworks.jp> >>
228
229=head1 LICENSE
230
231This program is free software; you can redistribute it and/or modify it
232under the same terms as Perl itself.
233
234See http://www.perl.com/perl/misc/Artistic.html
235
236=cut
237
238