Toby Inkster avatar Toby Inkster committed ecb0b0f Draft

initial work

Comments (0)

Files changed (16)

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

lib/MooseX/ErsatzMethod.pm

+package MooseX::ErsatzMethod;
+
+use 5.008;
+use strict;
+use warnings;
+use utf8;
+
+BEGIN {
+	$MooseX::ErsatzMethod::AUTHORITY = 'cpan:TOBYINK';
+	$MooseX::ErsatzMethod::VERSION   = '0.001';
+}
+
+my %METAROLES;
+BEGIN {
+	%METAROLES = (
+		role                    => [ 'MooseX::ErsatzMethod::Trait::Role' ],
+		application_to_class    => [ 'MooseX::ErsatzMethod::Trait::ApplicationToClass' ],
+		application_to_role     => [ 'MooseX::ErsatzMethod::Trait::ApplicationToRole' ],
+		application_to_instance => [ 'MooseX::ErsatzMethod::Trait::ApplicationToInstance' ],
+	)
+};
+
+use Moose ();
+use Moose::Exporter;
+
+BEGIN {
+	package MooseX::ErsatzMethod::Meta::Method;
+	no thanks;
+	use Moose;
+	has code => (
+		is         => 'ro',
+		isa        => 'CodeRef',
+		required   => 1,
+	);
+	has name => (
+		is         => 'ro',
+		isa        => 'Str',
+		required   => 1,
+	);
+	has associated_role => (
+		is         => 'ro',
+		isa        => 'Object',
+		required   => 0,
+	);
+	sub apply_to_class
+	{
+		my ($self, $class) = @_;
+		return if $class->find_method_by_name($self->name);
+		$class->add_method($self->name, $self->code);
+	}
+}
+
+BEGIN {
+	package MooseX::ErsatzMethod::Trait::Role;
+	no thanks;
+	use Moose::Role;
+	has ersatz_methods => (
+		traits     => ['Hash'],
+		is         => 'ro',
+		isa        => 'HashRef[MooseX::ErsatzMethod::Meta::Method]',
+		lazy_build => 1,
+		handles    => {
+			all_ersatz_methods => 'values',
+			_add_ersatz_method => 'set',
+		},
+	);
+	sub _build_ersatz_methods { +{} };
+	sub add_ersatz_method
+	{
+		my ($meta, $method) = @_;
+		$meta->_add_ersatz_method($method->name => $method);
+	}
+	sub apply_all_ersatz_methods_to_class
+	{
+		my ($self, $class) = @_;
+		$_->apply_to_class($class) for $self->all_ersatz_methods;
+	}
+	sub composition_class_roles
+	{
+		return 'MooseX::ErsatzMethod::Trait::Composite';
+	}
+};
+
+BEGIN {
+	package MooseX::ErsatzMethod::Trait::Composite;
+	no thanks;
+	use Moose::Role;
+	with qw(MooseX::ErsatzMethod::Trait::Role);
+	around apply_params => sub
+	{
+		my $orig = shift;
+		my $self = shift;
+		$self->$orig(@_);
+		
+		$self = Moose::Util::MetaRole::apply_metaroles(
+			for            => $self,
+			role_metaroles => \%METAROLES,
+		);
+		$self->_merge_ersatz_methods;
+		return $self;
+	};
+	sub _merge_ersatz_methods
+	{
+		my $self = shift;
+		foreach my $role (@{ $self->get_roles })
+		{
+			next unless Moose::Util::does_role(
+				$role,
+				'MooseX::ErsatzMethod::Trait::Role',
+			);
+			$self->add_ersatz_method($_) for $role->all_ersatz_methods;
+		}
+	}
+};
+
+BEGIN {
+	package MooseX::ErsatzMethod::Trait::ApplicationToClass;
+	no thanks;
+	use Moose::Role;
+	before apply => sub
+	{
+		my ($meta, $role, $class) = @_;
+		return unless Moose::Util::does_role(
+			$role,
+			'MooseX::ErsatzMethod::Trait::Role',
+		);
+		$role->apply_all_ersatz_methods_to_class($class);
+	};
+};
+
+BEGIN {
+	package MooseX::ErsatzMethod::Trait::ApplicationToRole;
+	no thanks;
+	use Moose::Role;
+	before apply => sub
+	{
+		my ($meta, $role1, $role2) = @_;
+		$role2 = Moose::Util::MetaRole::apply_metaroles(
+			for            => $role2,
+			role_metaroles => \%METAROLES,
+		);
+		$role2->add_ersatz_method($_) for $role1->all_ersatz_methods;
+	};
+};
+
+BEGIN {
+	package MooseX::ErsatzMethod::Trait::ApplicationToInstance;
+	no thanks;
+	use Moose::Role;
+};
+
+Moose::Exporter->setup_import_methods(
+	with_meta      => [ 'ersatz' ],
+	role_metaroles => \%METAROLES,
+);
+
+sub ersatz
+{
+	my ($meta, $name, $coderef) = @_;
+	
+	Carp::confess('Ersatz methods can only be created for Moose roles; not classes. Stopped')
+		unless $meta->isa('Moose::Meta::Role');
+	
+	my $method;
+	if (Scalar::Util::blessed($name))
+	{
+		$method = $name;
+	}
+	else
+	{
+		$method = 'MooseX::ErsatzMethod::Meta::Method'->new(
+			code            => $coderef,
+			name            => $name,
+			associated_role => $meta,
+		);
+	}
+	
+	$meta->add_ersatz_method($method);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+MooseX::ErsatzMethod - provide a method implementation that isn't as good as the real thing
+
+=head1 SYNOPSIS
+
+  package Greetable;
+  use Moose::Role;
+  use MooseX::ErsatzMethod;
+  
+  sub greet {
+    my $self = shift;
+    say "Hello ", $self->name;
+  }
+  
+  ersatz name => sub {
+    my $self = shift;
+    return Scalar::Util::refaddr($self);
+  };
+
+  package Person;
+  use Moose;
+  with 'Greetable';
+  has name => (is => 'ro', isa => 'Str');
+  
+  package Termite;
+  use Moose;
+  with 'Greetable';
+  # no need to implement 'name'.
+
+=head1 DESCRIPTION
+
+MooseX::ErsatzMethod provides a mechanism for Moose roles to provide fallback
+implementations of methods that they really want for consuming classes to
+implement. In the SYNOPSIS section, the C<Greetable> role really wants
+consuming classes to implement a C<name> method. The C<Termite> class doesn't
+implement C<name>, but it's OK, because C<Greetable> provides a fallback
+(albeit rubbish) implementation of the method.
+
+B<< But wait! >> I hear you say. Don't roles already work that way? Can't a
+role provide an implementation of a method which consuming classes can
+override? Yes, they can. However, the precedence is:
+
+  consuming class's implementation (wins)
+  role's implementation
+  inherited implementation (e.g. from parent class)
+
+That is, the role's method implementation overrides methods inherited from the
+parent class. An ersatz method implementation sits right at the bottom of the
+heirarchy; it is only used if the consuming class and its ancestors cannot
+provide the method. (It still beats C<AUTOLOAD> though.)
+
+One other feature of ersatz methods is that they can never introduce role
+composition conflicts. If you compose two different roles which both provide
+ersatz method implementations, an arbitrary method implementation is selected.
+
+=head2 Functions
+
+=over
+
+=item C<< ersatz $name => $coderef >>
+
+Defines an ersatz function.
+
+=back
+
+=head2 Metarole Trait
+
+Your metarole (i.e. C<< $metarole = Greetable->meta >>) will have the
+following additional methods:
+
+=over
+
+=item C<< ersatz_methods >>
+
+Returns a name => object hashref of ersatz methods for this class. The
+objects are instances of L<< MooseX::ErsatzMethod::Meta::Method >>.
+
+=item C<< all_ersatz_methods >>
+
+Returns just the values (objects) from the C<ersatz_methods> hash.
+
+=item C<< add_ersatz_method($name, $coderef) >>
+
+Given a name and coderef, creates a L<< MooseX::ErsatzMethod::Meta::Method >>
+object and adds it to the C<ersatz_methods> hash.
+
+=item C<< apply_all_ersatz_methods_to_class($class) >>
+
+Given a Moose::Meta::Class object, iterates through C<all_ersatz_methods>
+applying each to the class.
+
+=back
+
+=head2 MooseX::ErsatzMethod::Meta::Method
+
+Instances of this class represent an ersatz method.
+
+=over
+
+=item C<< new(%attrs) >>
+
+Standard Moose constructor.
+
+=item C<< code >>
+
+The coderef for the method.
+
+=item C<< name >>
+
+The sub name for the method (not including the package).
+
+=item C<< associated_role >>
+
+The metarole associated with this method (if any).
+
+=item C<< apply_to_class($class) >>
+
+Given a Moose::Meta::Class object, installs this method into the class
+unless the class (or a superclass) already has a method of that name.
+
+=back
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=MooseX-ErsatzMethod>.
+
+=head1 SEE ALSO
+
+L<Moose::Role>.
+
+L<https://speakerdeck.com/u/sartak/p/moose-role-usage-patterns?slide=32>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 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.
+
+`MooseX-ErsatzMethod 0.001 cpan:TOBYINK`
+	issued  2012-10-02;
+	label   "Initial release".
+
+# This file contains general metadata about the project.
+
+@prefix : <http://usefulinc.com/ns/doap#>.
+
+`MooseX-ErsatzMethod`
+	:programming-language "Perl" ;
+	:shortdesc            "provide a method implementation that isn't as good as the real thing";
+	:homepage             <https://metacpan.org/release/MooseX-ErsatzMethod>;
+	:download-page        <https://metacpan.org/release/MooseX-ErsatzMethod>;
+	:repository           [ a :HgRepository; :browse <https://bitbucket.org/tobyink/p5-moosex-ersatzmethod> ];
+	:bug-database         <http://rt.cpan.org/Dist/Display.html?Queue=MooseX-ErsatzMethod>;
+	:created              2012-10-02;
+	: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.
+
+`MooseX-ErsatzMethod`
+	perl_version_from m`MooseX::ErsatzMethod`;
+	version_from      m`MooseX::ErsatzMethod`;
+	readme_from       m`MooseX::ErsatzMethod`;
+	test_requires     p`Test::More 0.61`;
+	requires          p`thanks`;
+	requires          p`Moose 2.00`;
+	.
+
+# 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>.
+
+use Test::More tests => 1;
+BEGIN { use_ok('MooseX::ErsatzMethod') };
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+BEGIN {
+	package Local::Test::Role;
+	no thanks;
+	use Moose::Role;
+	use MooseX::ErsatzMethod;
+	ersatz foo => sub { +__PACKAGE__ };
+}
+
+BEGIN {
+	package Local::Test::Class::NoImplementation;
+	no thanks;
+	use Moose;
+	with qw(Local::Test::Role);
+}
+
+BEGIN {
+	package Local::Test::Class::WithImplementation;
+	no thanks;
+	use Moose;
+	with qw(Local::Test::Role);
+	sub foo { +__PACKAGE__ }
+}
+
+BEGIN {
+	package Local::Test::Class::BaseClass;
+	no thanks;
+	use Moose;
+	sub foo { +__PACKAGE__ }
+}
+
+BEGIN {
+	package Local::Test::Class::InheritedImplementation;
+	no thanks;
+	use Moose;
+	extends qw(Local::Test::Class::BaseClass);
+	with qw(Local::Test::Role);
+}
+
+is(
+	Local::Test::Class::NoImplementation->new->foo,
+	'Local::Test::Role',
+	'class which provides no implementation gets ersatz implementation',
+);
+
+is(
+	Local::Test::Class::WithImplementation->new->foo,
+	'Local::Test::Class::WithImplementation',
+	'class which provides an implementation keeps it',
+);
+
+is(
+	Local::Test::Class::InheritedImplementation->new->foo,
+	'Local::Test::Class::BaseClass',
+	'class which inherits an implementation keeps it',
+);

t/03noconflicts.t

+use strict;
+use warnings;
+use Test::More tests => 6;
+
+BEGIN {
+	package Local::Test::Role1;
+	no thanks;
+	use Moose::Role;
+	use MooseX::ErsatzMethod;
+	ersatz foo => sub { 1 };
+};
+
+BEGIN {
+	package Local::Test::Role2;
+	no thanks;
+	use Moose::Role;
+	use MooseX::ErsatzMethod;
+	ersatz foo => sub { 2 };
+}
+
+BEGIN {
+	package Local::Test::Role3;
+	no thanks;
+	use Moose::Role;
+	with qw(
+		Local::Test::Role1
+		Local::Test::Role2
+	);
+}
+
+BEGIN {
+	package Local::Test::Class::WithRole1;
+	no thanks;
+	use Moose;
+	with qw(
+		Local::Test::Role1
+	);
+}
+
+BEGIN {
+	package Local::Test::Class::WithRole1AndRole2;
+	no thanks;
+	use Moose;
+	with qw(
+		Local::Test::Role1
+		Local::Test::Role2
+	);
+}
+
+BEGIN {
+	package Local::Test::Class::WithRole1ThenRole2;
+	no thanks;
+	use Moose;
+	with qw(
+		Local::Test::Role1
+	);
+	with qw(
+		Local::Test::Role2
+	);
+}
+
+BEGIN {
+	package Local::Test::Class::WithRole3;
+	no thanks;
+	use Moose;
+	with qw(
+		Local::Test::Role3
+	);
+}
+
+BEGIN {
+	package Local::Test::Class::WithRole1AndRole3;
+	no thanks;
+	use Moose;
+	with qw(
+		Local::Test::Role1
+		Local::Test::Role3
+	);
+}
+
+BEGIN {
+	package Local::Test::Class::WithRole1ThenRole3;
+	no thanks;
+	use Moose;
+	with qw(
+		Local::Test::Role1
+	);
+	with qw(
+		Local::Test::Role3
+	);
+}
+
+ok(
+	$_->new->foo ~~ 1,
+	$_,
+) for qw(
+	Local::Test::Class::WithRole1
+);
+
+ok(
+	($_->new->foo ~~ [qw( 1 2 )]),
+	$_,
+) for qw(
+	Local::Test::Class::WithRole1AndRole2
+	Local::Test::Class::WithRole1ThenRole2
+	Local::Test::Class::WithRole3
+	Local::Test::Class::WithRole1AndRole3
+	Local::Test::Class::WithRole1ThenRole3
+);
+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":"MooseX-ErsatzMethod"}
+

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.