diff options
author | franck cuny <franck@lumberjaph.net> | 2009-06-30 11:24:57 +0200 |
---|---|---|
committer | franck cuny <franck@lumberjaph.net> | 2009-06-30 11:24:57 +0200 |
commit | 2cbd7056206d1c0f5b8f9f0ded4cda65ed784cb8 (patch) | |
tree | 9dc03b8a57a6dee24629866de30c7cd572087072 | |
parent | initial commit (diff) | |
download | moosex-methodprivate-2cbd7056206d1c0f5b8f9f0ded4cda65ed784cb8.tar.gz |
private and protectd methods and basic tests
Diffstat (limited to '')
-rw-r--r-- | lib/MooseX/MethodPrivate.pm | 43 | ||||
-rw-r--r-- | t/02_pod.t (renamed from xt/03_pod.t) | 0 | ||||
-rw-r--r-- | t/10_method_private.t | 58 | ||||
-rw-r--r-- | t/11_method_protected.t | 39 | ||||
-rw-r--r-- | xt/02_perlcritic.t | 8 | ||||
-rw-r--r-- | xt/perlcriticrc | 2 | ||||
-rw-r--r-- | xt/run.t | 4 | ||||
-rw-r--r-- | xt/tests/Test/MooseX/MethodPrivate.pm | 25 |
8 files changed, 137 insertions, 42 deletions
diff --git a/lib/MooseX/MethodPrivate.pm b/lib/MooseX/MethodPrivate.pm index f7801c0..37cce7a 100644 --- a/lib/MooseX/MethodPrivate.pm +++ b/lib/MooseX/MethodPrivate.pm @@ -1,9 +1,48 @@ package MooseX::MethodPrivate; use Moose; -our $VERSION = '0.01'; +use Moose::Exporter; +our $VERSION = '0.1.0'; +use Carp qw/croak/; + +Moose::Exporter->setup_import_methods( + with_caller => [qw( private protected )], ); + +sub private { + my $caller = shift; + my $name = shift; + my $real_body = shift; + + my $body = sub { + croak "The $caller\::$name method is private" + unless ( scalar caller() ) eq $caller; + + goto &{$real_body}; + }; + + $caller->meta->add_method( $name, $body ); +} + +sub protected { + my $caller = shift; + my $name = shift; + my $real_body = shift; + + my $body = sub { + my $new_caller = caller(); + my @isa = $new_caller->meta->superclasses; + my @check = grep {/$caller/} @isa; + croak "The $caller\::$name method is protected" + unless ( ( scalar caller() ) eq $caller || @check ); + + goto &{$real_body}; + }; + + $caller->meta->add_method( $name, $body ); +} 1; + __END__ =head1 NAME @@ -28,5 +67,3 @@ franck cuny E<lt>franck.cuny {at} rtgi.frE<gt> This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - -=cut diff --git a/xt/03_pod.t b/t/02_pod.t index 437887a..437887a 100644 --- a/xt/03_pod.t +++ b/t/02_pod.t diff --git a/t/10_method_private.t b/t/10_method_private.t new file mode 100644 index 0000000..899d1be --- /dev/null +++ b/t/10_method_private.t @@ -0,0 +1,58 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 6; +use Test::Exception; + +{ + + package Foo; + use Moose; + use MooseX::MethodPrivate; + + private 'bar' => sub { + my $self = shift; + return 'baz'; + }; + + sub baz { + my $self = shift; + return $self->bar; + } + + sub foo { + my $self = shift; + return $self->foobar(shift); + } + + private 'foobar' => sub { + my $self = shift; + my $str = shift; + return 'foobar' . $str; + }; + +} + +{ + + package Bar; + use Moose; + extends 'Foo'; + + sub newbar { + my $self = shift; + return $self->bar; + } +} + +my $foo = Foo->new(); +isa_ok( $foo, 'Foo' ); +dies_ok { $foo->bar } "... can't call bar, method is private"; +is $foo->baz, 'baz', "... got the good value from &baz"; +is $foo->foo('baz'), 'foobarbaz', "... got the good value from &foobar"; + +my $bar = Bar->new(); +isa_ok( $bar, 'Bar' ); +dies_ok { $bar->newbar() } "... can't call bar, method is private"; diff --git a/t/11_method_protected.t b/t/11_method_protected.t new file mode 100644 index 0000000..3b3d35d --- /dev/null +++ b/t/11_method_protected.t @@ -0,0 +1,39 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 4; +use Test::Exception; + +{ + + package Foo; + use Moose; + use MooseX::MethodPrivate; + + protected 'bar' => sub { + my $self = shift; + return 'baz'; + }; +} + +{ + + package Bar; + use Moose; + extends 'Foo'; + + sub baz { + my $self = shift; + return $self->bar; + } +} + +my $foo = Foo->new(); +isa_ok( $foo, 'Foo' ); +dies_ok { $foo->bar } "... can't call bar, method is protected"; + +my $bar = Bar->new(); +isa_ok( $bar, 'Bar' ); +is $bar->baz(), 'baz', "... got the good value from &bar"; diff --git a/xt/02_perlcritic.t b/xt/02_perlcritic.t deleted file mode 100644 index b977df8..0000000 --- a/xt/02_perlcritic.t +++ /dev/null @@ -1,8 +0,0 @@ -use strict; -use Test::More; -eval { - require Test::Perl::Critic; - Test::Perl::Critic->import( -profile => 'xt/perlcriticrc'); -}; -plan skip_all => "Test::Perl::Critic is not installed." if $@; -all_critic_ok('lib'); diff --git a/xt/perlcriticrc b/xt/perlcriticrc deleted file mode 100644 index fa96144..0000000 --- a/xt/perlcriticrc +++ /dev/null @@ -1,2 +0,0 @@ -[TestingAndDebugging::ProhibitNoStrict] -allow=refs diff --git a/xt/run.t b/xt/run.t deleted file mode 100644 index 88e3cd5..0000000 --- a/xt/run.t +++ /dev/null @@ -1,4 +0,0 @@ -use lib 'xt/tests'; -use Test::MooseX::MethodPrivate; - -Test::Class->runtests; diff --git a/xt/tests/Test/MooseX/MethodPrivate.pm b/xt/tests/Test/MooseX/MethodPrivate.pm deleted file mode 100644 index cb8dc4c..0000000 --- a/xt/tests/Test/MooseX/MethodPrivate.pm +++ /dev/null @@ -1,25 +0,0 @@ -package Test::MooseX::MethodPrivate; - -use strict; -use warnings; -use base 'Test::Class'; -use Test::Exception; -use Test::More; - -sub class { 'MooseX::MethodPrivate' } - -sub startup : Tests(startup => 1) { - my $test = shift; - use_ok $test->class, "use ok"; -} - -sub shutdown : Tests(shutdown) { - my $test = shift; -} - -sub constructor : Tests(1) { - my $test = shift; - can_ok $test->class, 'new'; -} - -1; |