Toby Inkster avatar Toby Inkster committed 5f6b2e5

MooX::HandlesVia support

Comments (0)

Files changed (2)

 	}
 };
 
+sub _processors
+{
+	qw( isa lazy_build traits );
+}
+
 sub import
 {
 	my $me = shift;
 	my $orig = $caller->can('has')  # lolcat
 		or croak "Could not locate 'has' function to alter";
 	
+	my @processors = $me->_processors;
+	
 	$install_tracked->(
 		$caller, has => sub
 		{
 			for my $name (ref $proto ? @$proto : $proto)
 			{
 				my $spec = +{ %spec }; # shallow clone
-				$me->_process_isa($name, $spec, $context, $caller)
-					if exists $spec->{isa} && !ref $spec->{isa};
-				$me->_process_lazy_build($name, $spec, $context, $caller)
-					if exists $spec->{lazy_build} && $spec->{lazy_build};
+				
+				for my $option (@processors)
+				{
+					next unless exists $spec->{$option};
+					my $handler = $me->can("_process_$option");
+					$handler->($me, $name, $spec, $context, $caller);
+				}
 				
 				$orig->($name, %$spec);
 			}
 my %registry;
 sub _process_isa
 {
-	my ($me, $name, $spec, $context, $class) = @_;
+	my $me = shift;
+	my ($name, $spec, $context, $class) = @_;
+	return if ref $spec->{isa};
+	
 	my $reg = (
 		$registry{$class} ||= do {
 			require MooX::late::TypeRegistry;
 		}
 	);
 	$spec->{isa} = $reg->lookup($spec->{isa});
+	
 	return;
 }
 
 sub _process_lazy_build
 {
-	my ($me, $name, $spec, $context) = @_;
-	delete $spec->{lazy_build};
+	my $me = shift;
+	my ($name, $spec) = @_;
+	return unless delete $spec->{lazy_build};
 	
 	$spec->{is}      ||= "ro";
 	$spec->{lazy}    ||= 1;
 	return;
 }
 
+sub _setup_handlesvia
+{
+	my $me = shift;
+	my ($name, $spec, $context, $class) = @_;
+	
+	eval "require MooX::HandlesVia"
+		or croak("Requires MooX::HandlesVia for attribute trait defined at $context");
+}
+
+sub _process_traits
+{
+	my $me = shift;
+	my ($name, $spec) = @_;
+	
+	my @new;
+	foreach my $trait (@{ $spec->{traits} || [] })
+	{
+		my $handler = $me->can("_process_traits__$trait");
+		croak "$me cannot process trait $trait" unless $handler;
+		push @new, $me->$handler(@_);
+	}
+	
+	$spec->{traits} = \@new;
+	
+	# Pass through MooX::HandlesVia
+	if ($spec->{handles_via})
+	{
+		require MooX::HandlesVia;
+		my ($name, %spec) = MooX::HandlesVia::process_has($name, %$spec);
+		%$spec = %spec;
+	}
+	
+	return;
+}
+
+sub _process_traits__Array
+{
+	my $me = shift;
+	my ($name, $spec, $context, $class) = @_;
+	$me->_setup_handlesvia(@_);
+	$spec->{handles_via} = "Data::Perl::Collection::Array::MooseLike";
+	return;
+}
+
+sub _process_traits__Hash
+{
+	my $me = shift;
+	my ($name, $spec, $context, $class) = @_;
+	$me->_setup_handlesvia(@_);
+	$spec->{handles_via} = "Data::Perl::Collection::Hash::MooseLike";
+	return;
+}
+
+sub _process_traits__Code
+{
+	my $me = shift;
+	my ($name, $spec, $context, $class) = @_;
+	$me->_setup_handlesvia(@_);
+	$spec->{handles_via} = "Data::Perl::Code";
+	
+	# Special handling for execute_method!
+	while (my ($k, $v) = each %{ $spec->{handles} })
+	{
+		next unless $v eq q(execute_method);
+		
+		# MooX::HandlesVia can't handle this right yet.
+		delete $spec->{handles}{$k};
+		
+		eval qq{
+			package ${class};
+			sub ${k} {
+				my \$self = shift;
+				return \$self->${name}->(\$self, \@_);
+			}
+		};
+	}
+	
+	return;
+}
+
 1;
 
 __END__
 
 Exports C<blessed> and C<confess> functions to your namespace.
 
+=item 5.
+
+Handles certain attribute traits. Currently C<Hash>, C<Array> and C<Code>
+are supported. This feature requires L<MooX::HandlesVia>. 
+
+C<String>, C<Number>, C<Counter> and C<Bool> are unlikely to ever be
+supported because of internal implementation details of Moo. If you need
+another attribute trait to be supported, let me know and I will consider
+it.
+
 =back
 
-Three features. It is not the aim of C<MooX::late> to make every aspect of
+Four features. It is not the aim of C<MooX::late> to make every aspect of
 Moo behave exactly identically to Moose. It's just going after the low-hanging
 fruit. So it does four things right now, and I promise that future versions
 will never do more than seven.
 
 C<MooX::late> uses L<Types::Standard> to check type constraints.
 
+C<MooX::late> uses L<MooX::HandlesVia> to provide native attribute traits
+support.
+
 The following modules bring additional Moose functionality to Moo:
 
 =over
 
 =back
 
-L<MooX::HandlesVia> provides a native-traits-like feature for Moo. There
-are plans afoot to add MooX::HandlesVia magic to MooX::late. 
-
 L<MooX> allows you to load Moo plus multiple MooX extension modules in a
 single line.
 
+=head1 PURPOSE
+
+See if L<MooX::HandlesVia> support works.
+
+=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 "MooX::HandlesVia";
+
+{
+	package Local::ThingyContainer;
+	use Moo;
+	use MooX::late;
+	
+	has _thingies => (
+		traits  => ['Array'],
+		is      => 'ro',
+		isa     => 'ArrayRef[Str]',
+		default => sub { [] },
+		handles => {
+			all   => 'elements',
+			add   => 'push',
+			count => 'count',
+		},
+	);
+}
+
+{
+	package Local::Foo;
+	use Moo;
+	use MooX::late;
+	
+	has code => (
+		traits  => ['Code'],
+		is      => 'ro',
+		isa     => 'CodeRef',
+		handles => {
+			e  => 'execute',
+			em => 'execute_method',
+		},
+	);
+}
+
+my $c = 'Local::ThingyContainer'->new;
+
+is($c->count, 0);
+
+$c->add(qw/ Foo Bar Baz /);
+$c->add(qw/ Quux /);
+
+is($c->count, 4);
+
+is_deeply(
+	[ $c->all ],
+	[qw/ Foo Bar Baz Quux /],
+);
+
+my $x = 'Local::Foo'->new(code => sub { [@_] });
+
+is_deeply(
+	$x->e(1..3),
+	[1..3],
+);
+
+is_deeply(
+	$x->em(1..3),
+	[$x, 1..3],
+);
+
+done_testing;
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.