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