Commits

Toby Inkster committed dc9c0c5 Draft

misc

Comments (0)

Files changed (3)

 }
 
 use Moose ();
+use MooseX::Singleton ();
 use Moose::Exporter;
 use Carp;
 
 'Moose::Exporter'->setup_import_methods(
-	with_meta => [
-		qw( create_pointcut match after before around whenever ),
-	],
-	as_is => [
-		qw( role ),
-	],
+	with_meta => [qw(
+		create_join_point apply_to optionally_apply_to
+		after before around whenever has requires with
+	)],
+	as_is => [qw(
+		role
+	)],
 );
 
 sub init_meta
 			class => [ 'MooseX::Aspect::Trait::Aspect' ],
 		},
 	);
+	Moose::Util::MetaRole::apply_base_class_roles(
+		for    => $options{for_class},
+		roles  => [qw(
+			MooseX::Aspect::Trait::Employable
+			MooseX::Singleton::Role::Object
+		)],
+	);
 }
 
-sub create_pointcut
+sub create_join_point
 {
 	my $meta = shift;
 	for (@_)
 	{
-		$meta->add_aspect_pointcut(
-			'MooseX::Aspect::Meta::Pointcut::Adhoc'->new(
+		$meta->add_aspect_join_point(
+			'MooseX::Aspect::Meta::JoinPoint::Adhoc'->new(
 				name              => $_,
 				associated_aspect => $meta,
 			),
 	return +{ role => +shift };
 }
 
-sub match
+sub __apply_to
 {
-	my ($meta, $constraint, $builder) = @_;
+	my ($class, $meta, $constraint, $builder) = @_;
 	
-	my $role = 'MooseX::Aspect::Meta::Role'->create_anon_role(
+	my $role = $class->create_anon_role(
 		associated_aspect      => $meta,
 		application_constraint => $constraint,
 	);
 	$meta->add_aspect_role($role);
 }
 
+sub apply_to
+{
+	unshift @_, 'MooseX::Aspect::Meta::Role::Required';
+	goto \&__apply_to;
+}
+
+# Experimental
+sub optionally_apply_to
+{
+	unshift @_, 'MooseX::Aspect::Meta::Role::Optional';
+	goto \&__apply_to;
+}
+
 sub after
 {
 	my ($meta, $method, $coderef) = @_;
-	my $role = $meta->_building_role
-		or confess "Used 'after' outside role";
-	$role->add_after_method_modifier($method, $coderef);
+	($meta->_building_role || $meta)
+		->add_after_method_modifier($method, $coderef);
 }
 
 sub before
 {
 	my ($meta, $method, $coderef) = @_;
-	my $role = $meta->_building_role
-		or confess "Used 'after' outside role";
-	$role->add_before_method_modifier($method, $coderef);
+	($meta->_building_role || $meta)
+		->add_before_method_modifier($method, $coderef);
 }
 
 sub around
 {
 	my ($meta, $method, $coderef) = @_;
+	($meta->_building_role || $meta)
+		->add_around_method_modifier($method, $coderef);
+}
+
+sub with
+{
+	my ($meta, @args) = @_;
+	Moose::Util::apply_all_roles(
+		$meta->_building_role || $meta,
+		@args,
+	);
+}
+
+sub has
+{
+	my ($meta) = @_;
+	confess "Must not use 'has' inside aspect role"
+		if $meta->_building_role;
+	goto \&Moose::has;
+}
+
+sub requires
+{
+	my ($meta, @args) = @_;
 	my $role = $meta->_building_role
-		or confess "Used 'after' outside role";
-	$role->add_around_method_modifier($method, $coderef);
+		or confess "Cannot use 'requires' in aspect outside role";
+	$role->add_required_methods(@args);
 }
 
 sub whenever
 {
-	my ($meta, $pointcut, $coderef) = @_;
+	my ($meta, $join_point, $coderef) = @_;
 	my $role = $meta->_building_role
 		or confess "Used 'whenever' outside role";
-	$role->add_whenever_modifier($pointcut, $coderef);
+	$role->add_whenever_modifier($join_point, $coderef);
 }
 
 BEGIN {
 	use Moose::Role;
 	use Class::Load qw(load_class);
 	use Moose::Util qw(apply_all_roles);
+	use Carp;
 	use namespace::sweep;
 	
 	has _building_role => (
 		},
 	);
 
-	has aspect_pointcuts => (
+	has aspect_join_points => (
 		traits    => [qw/ Array /],
 		is        => 'ro',
-		isa       => 'ArrayRef[MooseX::Aspect::Meta::Pointcut]',
+		isa       => 'ArrayRef[MooseX::Aspect::Meta::JoinPoint]',
 		default   => sub { [] },
 		handles   => {
-			add_aspect_pointcut => 'push',
+			add_aspect_join_point => 'push',
 		},
 	);
 	
-	sub find_aspect_pointcut
+	sub find_aspect_join_point
 	{
 		my ($meta, $name) = @_;
 		return $name if blessed $name;
-		my ($r) = grep { $_->name eq $name } @{ $meta->aspect_pointcuts };
+		my ($r) = grep { $_->name eq $name } @{ $meta->aspect_join_points };
 		$r;
 	}
 	
 	sub setup_aspect_employment
 	{
-		my ($meta, $thing) = @_;
+		my ($meta, $thing, $required_only) = @_;
 		load_class $thing unless blessed $thing;
 		
 		my @application;
 		foreach my $role (@{ $meta->aspect_roles })
 		{
+			next
+				if $required_only
+				&& !$role->DOES('MooseX::Aspect::Meta::Role::Required');
+			
 			push @application, $role
 				if $role->should_apply_to($thing);
 		}
 		push @{ $thing->meta->employed_aspects }, $meta;
 	}
 	
-	sub run_pointcut
+	sub run_join_point
 	{
-		my ($meta, $pointcut, $args) = @_;
-		$pointcut = $meta->find_aspect_pointcut($pointcut)
-			or confess "Unknown pointcut";
+		my ($meta, $caller, $join_point, $args) = @_;
+		$join_point = $meta->find_aspect_join_point($join_point)
+			or confess "Unknown join_point '$_[2]'";
 		
 		foreach my $role (@{ $meta->aspect_roles })
 		{
-			foreach my $whenever ($role->get_whenever_modifiers($pointcut))
+			next unless $caller->does_role($role);
+			foreach my $whenever ($role->get_whenever_modifiers($join_point))
 			{
 				$whenever->execute($args);
 			}
 };
 
 BEGIN {
+	package MooseX::Aspect::Trait::Employable;
+	use Moose::Role;
+	use MooseX::ClassAttribute;
+	
+	class_has is_setup => (
+		is       => 'ro',
+		isa      => 'Bool',
+		writer   => '_set_is_setup',
+		default  => sub { 0 },
+	);
+	
+	sub _auto_setup
+	{
+		my $class = shift;
+		return if $class->is_setup;
+		my $meta  = $class->meta;
+		for my $role (@{ $meta->aspect_roles })
+		{
+			next unless $role->DOES('MooseX::Aspect::Meta::Role::Required');
+			Class::Load::load_class( $role->application_constraint );
+			$meta->setup_aspect_employment($role->application_constraint, 1);
+		}
+		$class->_set_is_setup(1);
+	}
+	
+	sub setup
+	{
+		my ($class, @args) = @_;
+		my @isa = $class->meta->linearized_isa;
+		for my $klass (@isa)
+		{
+			next unless $klass->DOES(__PACKAGE__);
+			$klass->_auto_setup;
+			next unless $klass->meta->can('setup_aspect_employment');
+			$klass->meta->setup_aspect_employment($_) for @args;
+		}
+	}
+};
+
+BEGIN {
 	package MooseX::Aspect::Trait::Employer;
 	no thanks;
 	use Moose::Role;
 
 
 BEGIN {
-	package MooseX::Aspect::Meta::Pointcut;
+	package MooseX::Aspect::Meta::JoinPoint;
 	no thanks;
 	use namespace::sweep;
 	use Moose;
 };
 
 BEGIN {
-	package MooseX::Aspect::Meta::Pointcut::Adhoc;
+	package MooseX::Aspect::Meta::JoinPoint::Adhoc;
 	no thanks;
 	use Moose;
 	use namespace::sweep;
-	extends qw( MooseX::Aspect::Meta::Pointcut );
+	extends qw( MooseX::Aspect::Meta::JoinPoint );
 	has name => (is => 'ro', required => 1);
 };
 
 	use namespace::sweep;
 	
 	has associated_role   => (is => 'ro', required => 1);
-	has pointcut          => (is => 'ro', required => 1);
+	has join_point        => (is => 'ro', required => 1);
 	has code              => (is => 'ro', required => 1);
 	
 	sub execute {
 	use Scalar::Does;
 	use namespace::sweep;
 	extends qw( Moose::Meta::Role );
-
+	#with qw( MooseX::RoleQR::Trait::Role );
+	
 	has associated_aspect => (is => 'ro', required => 1);
 	has application_constraint => (
 		is        => 'ro',
 	
 	sub add_whenever_modifier
 	{
-		my ($meta, $pointcut, $code) = @_;
+		my ($meta, $join_point, $code) = @_;
 		
-		$pointcut = $meta->associated_aspect->find_aspect_pointcut($pointcut)
-			unless blessed $pointcut;
+		$join_point = $meta->associated_aspect->find_aspect_join_point($join_point)
+			unless blessed $join_point;
 		
-		confess "Unknown pointcut" unless $pointcut;
+		confess "Unknown join_point" unless $join_point;
 				
 		$code = 'MooseX::Aspect::Meta::WheneverModifier'->new(
 			associated_role => $meta,
-			pointcut        => $pointcut,
+			join_point      => $join_point,
 			code            => $code,
 		) unless blessed $code;
 		
-		push @{ $meta->whenever_modifiers->{ $pointcut->name } }, $code;
+		push @{ $meta->whenever_modifiers->{ $join_point->name } }, $code;
 	}
 	
 	sub get_whenever_modifiers
 	{
-		my ($meta, $pointcut) = @_;
-		$pointcut = $pointcut->name if blessed $pointcut;
-		@{ $meta->whenever_modifiers->{$pointcut} };
+		my ($meta, $join_point) = @_;
+		$join_point = $join_point->name if blessed $join_point;
+		@{ $meta->whenever_modifiers->{$join_point} };
 	}
 	
 	sub should_apply_to
 	}
 };
 
+BEGIN {
+	package MooseX::Aspect::Meta::Role::Required;
+	no thanks;
+	use Moose;
+	extends qw( MooseX::Aspect::Meta::Role );
+	has '+application_constraint' => (isa => 'Str');
+}
+
+BEGIN {
+	package MooseX::Aspect::Meta::Role::Optional;
+	no thanks;
+	use Moose;
+	extends qw( MooseX::Aspect::Meta::Role );
+}
+
 1;
 
 __END__
 
 =head1 SYNOPSIS
 
+  {
+    package User;
+    use Moose;
+    ...;
+  }
+  
+  {
+    package Computer;
+    use Moose;
+    ...;
+  }
+  
+  {
+    package Logging;
+    use MooseX::Aspect;
+    
+    has log_file => (is => 'rw');
+    
+    sub log {
+      $_[0]->log_file->append($_[1]);
+    }
+    
+    apply_to 'User', role {
+      before login => sub {
+        my $self   = shift;
+        my $aspect = __PACKAGE__->instance;
+        $aspect->log($self->name . " logged in");
+      };
+    };
+    
+    apply_to 'Computer', role {
+      after connect  => sub {
+        my $self   = shift;
+        my $aspect = __PACKAGE__->instance;
+        $aspect->log($self->id . " connected to network");
+      };
+      after disconnect  => sub {
+        my $self   = shift;
+        my $aspect = __PACKAGE__->instance;
+        $aspect->log($self->id . " disconnected from network");
+      };
+    };
+  }
+  
+  Logging->setup;  # apply all the aspect's roles to packages
+
 =head1 DESCRIPTION
 
+Certain parts of code are cross-cutting concerns. A classic example is the
+one shown in the example: logging. Other cross-cutting concerns include
+access control, change monitoring (e.g. setting dirty flags) and
+database transaction management. Aspects help you isolate cross-cutting
+concerns into modules.
+
+In Moose terms, an aspect is a package that defines multiple Moose roles,
+along with hints as to what packages the roles should be applied to.
+
 =head1 BUGS
 
 Please report any bugs to
 
 =head1 SEE ALSO
 
+L<Moose>,
+L<Aspect>.
+
+L<http://en.wikipedia.org/wiki/Aspect-oriented_programming>.
+
 =head1 AUTHOR
 
 Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
 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

lib/MooseX/Aspect/Util.pm

 }
 
 'Moose::Exporter'->setup_import_methods(
-	as_is     => [qw( employ trigger_pointcut )],
+	as_is     => [qw( join_point )],
 );
 
-sub trigger_pointcut
+sub join_point
 {
 	my $meta = class_of scalar caller;
-	my ($aspect, $pointcut) = @_;
+	my ($aspect, $join_point) = @_;
 	
-	confess "This package has not had aspect $aspect applied"
-		unless $meta->can('employs_aspect') && $meta->employs_aspect($aspect);
+	return unless $meta->can('employs_aspect') && $meta->employs_aspect($aspect);
 	
 	my $args = [ caller_args(1) ];
-	class_of($aspect)->run_pointcut($pointcut, $args);
-}
-
-sub employ
-{
-	my $aspect = shift;
-	load_class($aspect);
-	class_of($aspect)->setup_aspect_employment($_) for @_;
+	return class_of($aspect)->run_join_point($meta, $join_point, $args);
 }
 
 1;
 use Test::More;
 
-my ($pass1, $pass2);
+my ($pass1, $pass2, $pass3);
 
 BEGIN {
 	package Local::Aspect1;
 	no thanks;
 	use MooseX::Aspect;
 	
-	create_pointcut 'quux';
+	create_join_point 'quux';
 	
-	match 'Local::Class1', role {
+	apply_to 'Local::Class1', role {
 		before foo => sub {
 			$pass1++;
 		};
 			$pass2++ if $_[1] eq 'monkey';
 		};
 	};
+	
+	optionally_apply_to 'Local::Class1', role {
+		whenever quux => sub {
+			$pass3++ if $_[1] eq 'ape';
+		};
+	};
 };
 
 BEGIN {
 	package Local::Class1;
 	no thanks;
 	use Moose;
-	use MooseX::Aspect::Util qw( trigger_pointcut );
+	use MooseX::Aspect::Util qw( join_point );
 	sub foo {
-		trigger_pointcut 'Local::Aspect1' => qw( quux );
+		join_point 'Local::Aspect1' => qw( quux );
 	}
 };
 
 	Local::Class1->meta->employs_aspect('Local::Aspect1')
 );
 
-use MooseX::Aspect::Util qw( employ );
-employ 'Local::Aspect1' => qw( Local::Class1 );
+Local::Aspect1->setup;
 ok( Local::Class1->meta->employs_aspect('Local::Aspect1') );
 
 Local::Class1->new->foo('monkey');
+Local::Class1->new->foo('ape');
 
-ok $pass1;
-ok $pass2;
+ok  $pass1;
+ok  $pass2;
+ok !$pass3;
+
+Local::Aspect1->setup('Local::Class1');
+
+Local::Class1->new->foo('ape');
+ok  $pass3;
 
 done_testing();