Toby Inkster avatar Toby Inkster committed b8f02eb Draft

initial version

Comments (0)

Files changed (18)

+use inc::Module::Package 'RDF:tobyink 0.009';
+

lib/Sub/NonRole.pm

+package Sub::NonRole;
+
+use 5.008;
+use strict;
+
+BEGIN {
+	$Sub::NonRole::AUTHORITY = 'cpan:TOBYINK';
+	$Sub::NonRole::VERSION   = '0.001';
+}
+
+use Hook::AfterRuntime;
+use MooX::CaptainHook -all;
+use Sub::Identify 'get_code_info';
+
+use base 'Sub::Talisman';
+
+sub import
+{
+	shift->setup_for(scalar(caller), @_);
+}
+
+sub setup_for
+{
+	my ($class, $caller) = @_;
+	$class->SUPER::setup_for($caller, { attribute => 'NonRole'});
+	after_runtime { $class->_post_process($caller) };
+}
+
+sub _post_process
+{
+	my ($class, $caller) = @_;
+	
+	my @subs =
+		map { /^\Q$caller\E::([^:]+)$/ ? $1 : () }
+		$class->get_subs("$caller\::NonRole");
+	push @subs, 'FETCH_CODE_ATTRIBUTES';
+	
+	if (exists $Role::Tiny::INFO{$caller})
+	{
+		$Role::Tiny::INFO{$caller}{not_methods}{$_} = $caller->can($_) for @subs;
+		
+		on_application {
+			my ($role, $pkg) = @{ $_[0] };
+		} $caller;
+		
+		on_inflation {
+			if ($_->name eq $caller) {
+				require Moose::Util::MetaRole;
+				_mk_moose_trait();
+				$_[0][0] = Moose::Util::MetaRole::apply_metaroles(
+					for => $caller,
+					role_metaroles => {
+						role => ['Sub::NonRole::Trait::Role'],
+					},
+				);
+				@{ $_[0][0]->non_role_methods } = @subs;
+			}
+		} $caller;
+	}
+	
+	if ($INC{'Class/MOP.pm'}
+	and my $class_of = 'Class::MOP'->can('class_of'))
+	{
+		require Moose::Util::MetaRole;
+		_mk_moose_trait();
+		Moose::Util::MetaRole::apply_metaroles(
+			for => $caller,
+			role_metaroles => {
+				role => ['Sub::NonRole::Trait::Role'],
+			},
+		);
+		@{ $class_of->($caller)->non_role_methods } = @subs;
+	}
+}
+
+my $made_it;
+sub _mk_moose_trait
+{
+	return if $made_it++;
+	eval q{
+		package Sub::NonRole::Trait::Role;
+		use Moose::Role;
+		has non_role_methods => (
+			is      => 'ro',
+			isa     => 'ArrayRef',
+			default => sub { [] },
+		);
+		around _get_local_methods => sub {
+			my $orig = shift;
+			my $self = shift;
+			my %return = map { $_->name => $_ } $self->$orig(@_);
+			delete @return{ @{$self->non_role_methods} };
+			return values %return;
+		};
+		around get_method_list => sub {
+			my $orig = shift;
+			my $self = shift;
+			my %return = map { $_ => 1 } $self->$orig(@_);
+			delete @return{ @{$self->non_role_methods} };
+			return keys %return;
+		};
+	};
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Sub::NonRole - prevent some subs from appearing in a role's API
+
+=head1 SYNOPSIS
+
+   package My::Role {
+      use Moose::Role;
+      use Sub::NonRole;
+      
+      sub some_function {
+         ...;
+      }
+      
+      sub other_function : NonRole {
+         ...;
+      }
+   }
+   
+   package My::Class {
+      use Moose;
+      with 'My::Role';
+   }
+   
+   My::Class->some_function();    # ok
+   My::Class->other_function();   # no such method!
+
+=head1 DESCRIPTION
+
+This module allows you to mark certain subs within a role as not being
+part of the role's API. This means that they will not be copied across
+into packages which consume the role.
+
+The subs can still be called as:
+
+   My::Role->other_function();
+   My::Role::other_function();
+
+It should work with L<Role::Tiny>, L<Moo::Role> and L<Moose::Role>
+roles.
+
+=head2 Developer API
+
+=over
+
+=item C<< Sub::NonRole->setup_for($role) >>
+
+If you wish to import the Sub::NonRole functionality into another package,
+this is how to do it.
+
+=item C<< $role->meta->non_role_methods >>
+
+For Moose roles (but not Moo or Role::Tiny ones) you can access the
+C<non_role_methods> attribute on the role's meta object to get an arrayref
+of non-role method names.
+
+=back
+
+=head1 BUGS
+
+Currently when consuming a Moo role within a Moose class, Sub::NonRole
+can cause a warning to be issued in the global cleanup phase. This is
+unlikely to result in serious problems; it's just annoying.
+
+Please report any other bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=Sub-NonRole>.
+
+=head1 SEE ALSO
+
+L<Role::Tiny>, L<Moo::Role>, L<Moose::Role>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2013 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+

meta/changes.pret

+# This file acts as the project's changelog.
+
+`Sub-NonRole 0.001 cpan:TOBYINK`
+	issued  2013-01-03;
+	label   "Initial release".
+
+# This file contains general metadata about the project.
+
+@prefix : <http://usefulinc.com/ns/doap#>.
+
+`Sub-NonRole`
+	:programming-language "Perl" ;
+	:shortdesc            "prevent some subs from appearing in a role's API";
+	:homepage             <https://metacpan.org/release/Sub-NonRole>;
+	:download-page        <https://metacpan.org/release/Sub-NonRole>;
+	:bug-database         <http://rt.cpan.org/Dist/Display.html?Queue=Sub-NonRole>;
+	:repository           [ a :HgRepository; :browse <https://bitbucket.org/tobyink/p5-sub-nonrole> ];
+	:created              2013-01-03;
+	:license              <http://dev.perl.org/licenses/>;
+	:maintainer           cpan:TOBYINK;
+	:developer            cpan:TOBYINK.
+
+<http://dev.perl.org/licenses/>
+	dc:title  "the same terms as the perl 5 programming language system itself".
+

meta/makefile.pret

+# This file provides instructions for packaging.
+
+`Sub-NonRole`
+	perl_version_from m`Sub::NonRole`;
+	version_from      m`Sub::NonRole`;
+	readme_from       m`Sub::NonRole`;
+	requires          p`Hook::AfterRuntime 0`;
+	requires          p`MooX::CaptainHook 0.004`;
+	requires          p`Sub::Identify 0`;
+	requires          p`Sub::Talisman 0`;
+	test_requires     p`Moo 1.000000`;
+	test_requires     p`Moo::Role 0`;
+	test_requires     p`Test::Requires 0`;
+	.
+
+# This file contains data about the project developers.
+
+@prefix : <http://xmlns.com/foaf/0.1/>.
+
+cpan:TOBYINK
+	:name  "Toby Inkster";
+	:mbox  <mailto:tobyink@cpan.org>.
+
+=head1 PURPOSE
+
+Check Sub::NonRole loads.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2013 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+use Test::More tests => 1;
+
+package Foo;
+use Moo::Role;
+use Sub::NonRole;
+::pass();
+
+=head1 PURPOSE
+
+Check Sub::NonRole works when a Moo role is consumed by a Moo class.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2013 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+use strict;
+use warnings;
+use Test::More;
+
+{
+	package Local::Role;
+	use Moo::Role;
+	use Sub::NonRole;
+	sub a :NonRole { 42 };
+	sub b          { 99 };
+}
+
+{
+	package Local::Class;
+	use Moo;
+	with 'Local::Role';
+}
+
+can_ok 'Local::Role', 'a';
+can_ok 'Local::Role', 'b';
+ok(!'Local::Class'->can('a'), 'method hidden correctly');
+can_ok 'Local::Class', 'b';
+
+ok(!$INC{'Moose.pm'}, 'Moose not inadvertantly loaded');
+
+done_testing;
+=head1 PURPOSE
+
+Check Sub::NonRole works when a Moo role is consumed by a Moose class.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2013 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+
+use strict;
+use warnings;
+use Test::More;
+use Test::Requires { Moose => 2.00 };
+
+{
+	package Local::Role;
+	use Moo::Role;
+	use Sub::NonRole;
+	sub a :NonRole { 42 };
+	sub b          { 99 };
+}
+
+{
+	package Local::Class;
+	use Moose;
+	with 'Local::Role';
+}
+
+can_ok 'Local::Role', 'a';
+can_ok 'Local::Role', 'b';
+ok(!'Local::Class'->can('a'), 'method hidden correctly');
+can_ok 'Local::Class', 'b';
+
+done_testing;
+=head1 PURPOSE
+
+Check Sub::NonRole works when a Moose role is consumed by a Moo class.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2013 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+use strict;
+use warnings;
+use Test::More;
+use Test::Requires { Moose => 2.00 };
+
+{
+	package Local::Role;
+	use Moose::Role;
+	use Sub::NonRole;
+	sub a :NonRole { 42 };
+	sub b          { 99 };
+}
+
+{
+	package Local::Class;
+	use Moo;
+	with 'Local::Role';
+}
+
+can_ok 'Local::Role', 'a';
+can_ok 'Local::Role', 'b';
+ok(!'Local::Class'->can('a'), 'method hidden correctly');
+can_ok 'Local::Class', 'b';
+
+done_testing;
+=head1 PURPOSE
+
+Check Sub::NonRole works when a Moose role is consumed by a Moose class.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2013 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+use strict;
+use warnings;
+use Test::More;
+use Test::Requires { Moose => 2.00 };
+
+{
+	package Local::Role;
+	use Moose::Role;
+	use Sub::NonRole;
+	sub a :NonRole { 42 };
+	sub b          { 99 };
+}
+
+{
+	package Local::Class;
+	use Moose;
+	with 'Local::Role';
+}
+
+can_ok 'Local::Role', 'a';
+can_ok 'Local::Role', 'b';
+ok(!'Local::Class'->can('a'), 'method hidden correctly');
+can_ok 'Local::Class', 'b';
+
+done_testing;
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
+

xt/02pod_coverage.t

+use XT::Util;
+use Test::More;
+use Test::Pod::Coverage;
+
+plan skip_all => __CONFIG__->{skip_all}
+	if __CONFIG__->{skip_all};
+
+if ( __CONFIG__->{modules} )
+{
+	my @modules = @{ __CONFIG__->{modules} };
+	pod_coverage_ok($_, "$_ is covered") for @modules;
+	done_testing(scalar @modules);
+}
+else
+{
+	all_pod_coverage_ok();
+}
+

xt/03meta_uptodate.config

+{"package":"Sub-NonRole"}
+

xt/03meta_uptodate.t

+use XT::Util;
+use Test::More tests => 1;
+use Test::RDF::DOAP::Version;
+doap_version_ok(__CONFIG__->{package}, __CONFIG__->{version_from});
+
+use Test::EOL;
+all_perl_files_ok();
+use Test::Tabs;
+all_perl_files_ok();
+use XT::Util;
+use Test::More;
+use Test::HasVersion;
+
+plan skip_all => __CONFIG__->{skip_all}
+	if __CONFIG__->{skip_all};
+
+if ( __CONFIG__->{modules} )
+{
+	my @modules = @{ __CONFIG__->{modules} };
+	pm_version_ok($_, "$_ is covered") for @modules;
+	done_testing(scalar @modules);
+}
+else
+{
+	all_pm_version_ok();
+}
+
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.