Toby Inkster avatar Toby Inkster committed 91ecab9

get inflation working; documentation

Comments (0)

Files changed (5)

lib/Method/Generate/ClassAccessor.pm

 
 1;
 
+__END__
+
+=head1 NAME
+
+Method::Generate::ClassAccessor - generate class accessor method
+
+=head1 DESCRIPTION
+
+For an idea of how this works, see the very fine documentation for
+L<Method::Generate::Accessor>.
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=MooX-ClassAttribute>.
+
+=head1 SEE ALSO
+
+L<Method::Generate::Accessor>,
+L<MooX::ClassAttribute>.
+
+=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.
+

lib/MooX/ClassAttribute.pm

 our %ROLE;
 BEGIN { *CLASS = \%Moo::MAKERS }
 our %CLASS;
-
 our %ATTRIBUTES;
 
 sub import
 	};
 }
 
-my %did_setup;
 sub _setup_inflation
 {
 	my ($me, $target) = @_;
-	return if $did_setup{$target}++;
-#	on_inflation
-#		{ $me->_on_inflation($target, @_) }
-#		$target;
-}
-
-my $warning;
-sub _on_inflation
-{
-	my ($me, $target, $meta) = @_;
-	
-	eval { require MooseX::ClassAttribute } or do {
-		carp <<WARNING unless $warning++; return;
-***
-*** MooX::ClassAttribute and Moose, but MooseX::ClassAttribute is not
-*** available. It is strongly recommended that you install this module.
-***
-WARNING
-	};
-	
-	require Moose::Util::MetaRole;
-	if ( is_role($meta->name) )
-	{
-		$meta = Moose::Util::MetaRole::apply_metaroles(
-			for             => $meta->name,
-			role_metaroles  => {
-				role                 => ['MooseX::ClassAttribute::Trait::Role'],
-				application_to_class => ['MooseX::ClassAttribute::Trait::Application::ToClass'],
-				application_to_role  => ['MooseX::ClassAttribute::Trait::Application::ToRole'],
-			},
-		);
-	}
-	else
-	{
-		$meta = Moose::Util::MetaRole::apply_metaroles(
-			for             => $meta->name,
-			class_metaroles => {
-				class => ['MooseX::ClassAttribute::Trait::Class', 'MooseX::ClassAttribute::Hack']
-			},
-		);
-	}
-	
-	my $attrs = $ATTRIBUTES{$target} || [];
-	for (my $i = 0; $i < @$attrs; $i+=2)
-	{
-		my $name = $attrs->[$i+0];
-		my $spec = $attrs->[$i+1];
-		MooseX::ClassAttribute::class_has(
-			$meta,
-			$name,
-			$me->_sanitize_spec($spec),
-		);
-	}
-}
-
-my %ok_options = map { ;$_=>1 } qw(
-	is reader writer accessor clearer predicate handles
-	required isa does coerce trigger
-	default builder lazy_build lazy
-	documentation
-);
-
-sub _sanitize_spec
-{
-	my ($me, $spec) = @_;
-	my @return;
-	for my $key (%$spec)
-	{
-		next unless $ok_options{$key};
-		push @return, $key, $spec->{$key};
-	}
-	return (
-		@return,
-		definition_context => { package => __PACKAGE__ },
-	);
-}
-
-{
-	package MooseX::ClassAttribute::Hack;
-	use Moo::Role;
-	around _post_add_class_attribute => sub {
-		my $orig = shift;
-		my $self = shift;
-		return if $self->definition_context->{package} eq 'MooseX::ClassAttribute';
-		$self->$orig(@_);
-	};
+	on_inflation {
+		require MooX::ClassAttribute::HandleMoose;
+		$me->_on_inflation($target, @_)
+	} $target;
 }
 
 1;
 
 =item *
 
-When Moo classes are inflated to Moose classes, it would be nice to also
-inflate MooX::ClassAttribute attributes to MooseX::ClassAttribute attributes,
-however I have not had much luck with that yet.
+When Moo classes are inflated to Moose classes, this module will I<attempt>
+to load MooseX::ClassAttribute, and use that to provide class attribute
+meta objects.
 
-Currently accessors installed by this module will just appear as plain old
-methods in Moose's introspection API.
+If MooseX::ClassAttribute cannot be loaded, a loud warning will be printed,
+and the inflation will fall back to representing class attribute accessors
+as plain old class methods.
 
 =back
 

lib/MooX/ClassAttribute/HandleMoose.pm

+package MooX::ClassAttribute::HandleMoose;
+
+use 5.008;
+use strict;
+use warnings;
+
+BEGIN {
+	$MooX::ClassAttribute::HandleMoose::AUTHORITY = 'cpan:TOBYINK';
+	$MooX::ClassAttribute::HandleMoose::VERSION   = '0.001';
+}
+
+{
+	package MooX::ClassAttribute;
+	
+	our %ROLE;
+	our %CLASS;
+	our %ATTRIBUTES;
+	
+	my $warning;
+	sub _on_inflation
+	{
+		my ($me, $target, $args) = @_;
+		my $meta = $args->[0];
+		
+		eval { require MooseX::ClassAttribute } or do {
+			carp <<WARNING unless $warning++; return;
+***
+*** MooX::ClassAttribute and Moose, but MooseX::ClassAttribute is not
+*** available. It is strongly recommended that you install this module.
+***
+WARNING
+		};
+		
+		require Moose::Util::MetaRole;
+		if ( is_role($meta->name) )
+		{
+			$meta = Moose::Util::MetaRole::apply_metaroles(
+				for             => $meta->name,
+				role_metaroles  => {
+					role                 => ['MooseX::ClassAttribute::Trait::Role'],
+					application_to_class => ['MooseX::ClassAttribute::Trait::Application::ToClass'],
+					application_to_role  => ['MooseX::ClassAttribute::Trait::Application::ToRole'],
+				},
+			);
+		}
+		else
+		{
+			$meta = Moose::Util::MetaRole::apply_metaroles(
+				for             => $meta->name,
+				class_metaroles => {
+					class => ['MooseX::ClassAttribute::Trait::Class'] #,'MooseX::ClassAttribute::Hack']
+				},
+			);
+		}
+		
+		my $attrs = $ATTRIBUTES{$target} || [];
+		for (my $i = 0; $i < @$attrs; $i+=2)
+		{
+			my $name = $attrs->[$i+0];
+			my $spec = $attrs->[$i+1];
+			MooseX::ClassAttribute::class_has(
+				$meta,
+				$name,
+				$me->_sanitize_spec($name, $spec),
+			);
+		}
+		
+		$args->[0] = $meta; # return new $meta
+	}
+	
+	my %ok_options = map { ;$_=>1 } qw(
+		is reader writer accessor clearer predicate handles
+		required isa does coerce trigger
+		default builder lazy_build lazy
+		documentation
+	);
+	
+	sub _sanitize_spec
+	{
+		my ($me, $name, $spec) = @_;
+		my %spec = %$spec;
+		
+		my $TYPE_MAP = \%Moo::HandleMoose::TYPE_MAP;
+		
+		# Stolen from Moo::HandleMoose
+		$spec{is} = 'ro' if $spec{is} eq 'lazy' || $spec{is} eq 'rwp';
+		if (my $isa = $spec{isa}) {
+			my $tc = $spec{isa} = do {
+				if (my $mapped = $TYPE_MAP->{$isa}) {
+					$mapped->();
+				} else {
+					Moose::Meta::TypeConstraint->new(
+						constraint => sub { eval { &$isa; 1 } }
+					);
+				}
+			};
+			if (my $coerce = $spec{coerce}) {
+				$tc
+					-> coercion(Moose::Meta::TypeCoercion->new)
+					-> _compiled_type_coercion($coerce);
+				$spec{coerce} = 1;
+			}
+		}
+		elsif (my $coerce = $spec{coerce}) {
+			my $attr = perlstring($name);
+			my $tc = Moose::Meta::TypeConstraint->new(
+				constraint => sub { die "This is not going to work" },
+				inlined    => sub { 'my $r = $_[42]{'.$attr.'}; $_[42]{'.$attr.'} = 1; $r' },
+			);
+			$tc
+				-> coercion(Moose::Meta::TypeCoercion->new)
+				-> _compiled_type_coercion($coerce);
+			$spec{isa}    = $tc;
+			$spec{coerce} = 1;
+		}
+		
+		my @return;
+		for my $key (%spec)
+		{
+			next unless $ok_options{$key};
+			push @return, $key, $spec->{$key};
+		}
+		return (
+			@return,
+			definition_context => { package => __PACKAGE__ },
+		);
+	}
+}
+
+## This doesn't actually seem needed any more...
+#{
+#	package MooseX::ClassAttribute::Hack;
+#	use Moo::Role;
+#	around _post_add_class_attribute => sub {
+#		my $orig = shift;
+#		my $self = shift;
+#		return if $self->definition_context->{package} eq 'MooX::ClassAttribute';
+#		$self->$orig(@_);
+#	};
+#}
+
+1;
+
+__END__
+
+=head1 NAME
+
+MooX::ClassAttribute::HandleMoose - Moose inflation stuff
+
+=head1 DESCRIPTION
+
+For an idea of how this works, see the very fine documentation for
+L<Moo::HandleMoose>.
+
+=head1 BUGS
+
+Please report any bugs to
+L<http://rt.cpan.org/Dist/Display.html?Queue=MooX-ClassAttribute>.
+
+=head1 SEE ALSO
+
+L<Moo::HandleMoose>,
+L<MooX::ClassAttribute>.
+
+=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.
+

t/10class_moose.t

 
 is(Bar->bar, "Elephant");
 
-#unless (eval { require MooseX::ClassAttribute })
-#{
-#	diag "no MooseX::ClassAttribute; no further tests";
-#	done_testing;
-#	exit;
-#}
-#
-#can_ok(Foo->meta, 'get_class_attribute');
-#ok(Class::MOP::class_of('Foo')->get_class_attribute('foo'));
-#ok(not Class::MOP::class_of('Foo')->get_class_attribute('foo')->has_default);
-#
-#can_ok(Bar->meta, 'get_class_attribute');
-#ok(Bar->meta->get_class_attribute('bar'));
-#ok(Bar->meta->get_class_attribute('bar')->has_default);
+unless (eval { require MooseX::ClassAttribute })
+{
+	diag "no MooseX::ClassAttribute; no further tests";
+	done_testing;
+	exit;
+}
+
+can_ok(Foo->meta, 'get_class_attribute');
+ok(Foo->meta->get_class_attribute('foo'));
+ok(not Foo->meta->get_class_attribute('foo')->has_default);
+
+can_ok(Bar->meta, 'get_class_attribute');
+ok(Bar->meta->get_class_attribute('bar'));
+ok(Bar->meta->get_class_attribute('bar')->has_default);
 
 done_testing;
 
 is(WithBar->bar, "WithBar XYZ");
 
-#unless (eval { require MooseX::ClassAttribute })
-#{
-#	diag "no MooseX::ClassAttribute; no further tests";
-#	done_testing;
-#	exit;
-#}
+unless (eval { require MooseX::ClassAttribute })
+{
+	diag "no MooseX::ClassAttribute; no further tests";
+	done_testing;
+	exit;
+}
+
+my $_meta = sub {
+	my $pkg = shift;
+	require Class::MOP;
+	Class::MOP::class_of($pkg);
+};
+
+can_ok(Foo->$_meta, 'get_class_attribute');
+ok(Foo->$_meta->get_class_attribute('foo'));
+ok(not Foo->$_meta->get_class_attribute('foo')->has_default);
+
+can_ok(Bar->$_meta, 'get_class_attribute');
+ok(Bar->$_meta->get_class_attribute('bar'));
+ok(Bar->$_meta->get_class_attribute('bar')->has_default);
+
+can_ok(WithFoo->meta, 'get_class_attribute');
+ok(WithFoo->meta->get_class_attribute('foo'));
+ok(not WithFoo->meta->get_class_attribute('foo')->has_default);
+
+can_ok(WithBar->meta, 'get_class_attribute');
+ok(WithBar->meta->get_class_attribute('bar'));
+ok(WithBar->meta->get_class_attribute('bar')->has_default);
 
 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.