Permalink
Browse files

implement match option

  • Loading branch information...
1 parent 270a779 commit 90834d4632261dad0f1157946a13d161c5019728 @shelling committed Apr 10, 2009
Showing with 67 additions and 17 deletions.
  1. +2 −2 dist.ini
  2. +18 −9 examples/simple
  3. +28 −5 lib/Class/Implant.pm
  4. +1 −1 t/03-outside.t
  5. +17 −0 t/04-match.t
  6. +1 −0 t/lib/Foo.pm
View
@@ -1,5 +1,5 @@
name = Class-Implant
-version = 0.01
+version = 0.02_01
author = shelling <shelling@cpan.org>
license = MIT
copyright_holder = shelling <shelling@cpan.org>
@@ -11,4 +11,4 @@ Class::Inspector = 0
[PodWeaver]
-
+[PkgVersion]
View
@@ -5,8 +5,10 @@ use lib qw(lib);
package Foo::Bar;
-sub foo { "foo" }
-sub bar { "bar" }
+sub foo { "foo" }
+sub bar { "bar" }
+sub hello { "hello" }
+sub hill { "hill" }
package Less::More;
@@ -15,16 +17,23 @@ sub more { "more" }
package Hello;
-use Class::Implant;
-use Data::Dumper;
-implant qw(Less::More Foo::Bar), { inherit => 1, exclude => [qw(import)] };
-sub isa { @ISA }
package main;
-for (qw(foo bar less more)) {
- eval qq{ print Hello::$_, "\n" };
+use Class::Implant;
+implant qw(Foo::Bar Less::More), { into => "Hello", match => qr{h\w+} };
+
+for (qw(foo bar less more hello hill)) {
+ eval qq{ print Hello->$_, "\n" };
}
-print Hello::isa(), "\n";
+
+if ( Hello->can("foo") ) {
+ print "can_ok foo()\n";
+} else {
+ print "cannot_ok foo()\n";
+}
+
+print Hello->can("foo"), "\n";
+
View
@@ -7,32 +7,47 @@ no strict "refs";
use warnings;
use Class::Inspector;
-our $VERSION = '0.01';
-
sub import {
*{(caller)[0] . "::implant"} = \&implant;
}
+
sub implant (@) {
my $option = ( ref($_[-1]) eq "HASH" ? pop(@_) : undef );
my @class = @_;
my $target = caller;
if (defined($option)) {
+ # options preprocessing
+
$target = $option->{into} if defined($option->{into});
eval qq{ package $target; use base qw(@class); } if $option->{inherit};
+
+ if (defined($option->{spec})) {
+ for (qw(match include exclude)) {
+ $option->{$_} = undef;
+ }
+ }
+
}
+
for my $class (reverse @class) {
- for my $function (@{ _get_methods($class) }) {
+
+ my @methods = @{ get_methods($class) };
+ @methods = grep /$option->{match}/, @methods if $option->{match};
+
+ for my $function (@methods) {
*{ $target . "::" . $function } = \&{ $class . "::" . $function };
}
+
}
}
-sub _get_methods { Class::Inspector->functions(shift) }
+sub get_methods { Class::Inspector->functions(shift) }
+
1;
@@ -81,6 +96,14 @@ target package for injection.
give 1 or any value to mark the inheritance
+=head2 spec
+
+specify what methods you want to import
+
+=head2 match
+
+give a pattern to import methods which match this pattern
+
=head2 include
this option is not available in 0.01
@@ -90,7 +113,7 @@ this option is not available in 0.01
this option is not available in 0.01
-=head2 EXPORT
+=head1 EXPORT
implant()
View
@@ -9,4 +9,4 @@ use Class::Implant;
implant qw(Foo), { into => "Bar" };
-use_ok("Bar", qw(hello world));
+can_ok("Bar", qw(hello world));
View
@@ -0,0 +1,17 @@
+use Test::More 'no_plan';
+
+use File::Basename;
+use lib dirname(__FILE__) . "/lib";
+use Foo;
+use Bar;
+use Spam;
+
+use Class::Implant;
+use Class::Inspector;
+
+implant qw(Foo Spam), { into => 'Bar', match => qr{h\w+} };
+
+can_ok("Bar", qw(hello hill));
+
+ok(!defined(Bar->can("world")));
+ok(!defined(Bar->can("spam")));
View
@@ -2,5 +2,6 @@ package Foo;
sub hello {"hello"}
sub world {"world"}
+sub hill {"hill"}
1;

0 comments on commit 90834d4

Please sign in to comment.