Commits

Toby Inkster committed f5cdcc7

implement class_has

Comments (0)

Files changed (1)

lib/MooX/ClassAttribute.pm

 package MooX::ClassAttribute;
 
-use 5.010;
-use constant { false => 0, true => 1 };
+use 5.008;
 use strict;
 use warnings;
-use utf8;
 
 BEGIN {
 	$MooX::ClassAttribute::AUTHORITY = 'cpan:TOBYINK';
 	$MooX::ClassAttribute::VERSION   = '0.001';
 }
 
+use Carp;
+use Moo ();
+use Moo::Role ();
+use MooX::CaptainHook -all;
 
+BEGIN { *ROLE = \%Role::Tiny::INFO }
+our %ROLE;
+BEGIN { *CLASS = \%Moo::MAKERS }
+our %CLASS;
 
+our %ATTRIBUTES;
 
-# Your code goes here
+sub import
+{
+	my $me     = shift;
+	my $target = caller;
+	
+	my $install_tracked;
+	{
+		no warnings;
+		if ($CLASS{$target})
+		{
+			$install_tracked = \&Moo::_install_tracked;
+		}
+		elsif ($ROLE{$target})
+		{
+			$install_tracked = \&Moo::Role::_install_tracked;
+		}
+		else
+		{
+			croak "MooX::ClassAttribute applied to a non-Moo package"
+				. "(need: use Moo or use Moo::Role)";
+		}
+	}
 
-true;
+	my $is_role = is_role($target);
+	
+	$install_tracked->(
+		$target, class_has => sub
+		{
+			my ($proto, %spec) = @_;
+			for my $name (ref $proto ? @$proto : $proto)
+			{
+				my $spec = +{ %spec }; # shallow clone
+				$is_role
+					? $me->_process_for_role($target, $name, $spec)
+					: $me->_class_accessor_maker_for($target)->generate_method($target, $name, $spec);
+				push @{$ATTRIBUTES{$target}||=[]}, $name, $spec;
+			}
+			return;
+		},
+	);
+	
+	$me->_setup_inflation($target);
+}
+
+sub _process_for_role
+{
+	my ($me, $target, $name, $spec) = @_;
+	on_application {
+		my ($applied_to) = @_;
+		$me
+			-> _class_accessor_maker_for($applied_to)
+			-> generate_method($applied_to, $name, $spec);
+	} $target;
+	'Moo::Role'->_maybe_reset_handlemoose($target);
+}
+
+sub _class_accessor_maker_for
+{
+	my ($me, $target) = @_;
+	$CLASS{$target}{class_accessor} ||= do {
+		require Method::Generate::Accessor::Classy;
+		'Method::Generate::Accessor::Classy'->new;
+	};
+}
+
+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(@_);
+	};
+}
+
+1;
 
 __END__
 
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.