From b274df4c9da24b117a22e287acd03b3fa87233a8 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Mon, 21 Feb 2011 16:04:51 -0600 Subject: rename MooseX::Bread::Board -> Bread::Board::Declare --- lib/Bread/Board/Declare/BlockInjection.pm | 10 ++ lib/Bread/Board/Declare/ConstructorInjection.pm | 10 ++ lib/Bread/Board/Declare/Literal.pm | 10 ++ lib/Bread/Board/Declare/Meta/Role/Accessor.pm | 26 ++++ lib/Bread/Board/Declare/Meta/Role/Attribute.pm | 185 ++++++++++++++++++++++++ lib/Bread/Board/Declare/Meta/Role/Class.pm | 32 ++++ lib/Bread/Board/Declare/Meta/Role/Instance.pm | 9 ++ lib/Bread/Board/Declare/Role/Object.pm | 36 +++++ lib/Bread/Board/Declare/Role/Service.pm | 40 +++++ 9 files changed, 358 insertions(+) create mode 100644 lib/Bread/Board/Declare/BlockInjection.pm create mode 100644 lib/Bread/Board/Declare/ConstructorInjection.pm create mode 100644 lib/Bread/Board/Declare/Literal.pm create mode 100644 lib/Bread/Board/Declare/Meta/Role/Accessor.pm create mode 100644 lib/Bread/Board/Declare/Meta/Role/Attribute.pm create mode 100644 lib/Bread/Board/Declare/Meta/Role/Class.pm create mode 100644 lib/Bread/Board/Declare/Meta/Role/Instance.pm create mode 100644 lib/Bread/Board/Declare/Role/Object.pm create mode 100644 lib/Bread/Board/Declare/Role/Service.pm (limited to 'lib/Bread/Board/Declare') diff --git a/lib/Bread/Board/Declare/BlockInjection.pm b/lib/Bread/Board/Declare/BlockInjection.pm new file mode 100644 index 0000000..9219206 --- /dev/null +++ b/lib/Bread/Board/Declare/BlockInjection.pm @@ -0,0 +1,10 @@ +package Bread::Board::Declare::BlockInjection; +use Moose; + +extends 'Bread::Board::BlockInjection'; +with 'Bread::Board::Declare::Role::Service'; + +__PACKAGE__->meta->make_immutable; +no Moose; + +1; diff --git a/lib/Bread/Board/Declare/ConstructorInjection.pm b/lib/Bread/Board/Declare/ConstructorInjection.pm new file mode 100644 index 0000000..38499fb --- /dev/null +++ b/lib/Bread/Board/Declare/ConstructorInjection.pm @@ -0,0 +1,10 @@ +package Bread::Board::Declare::ConstructorInjection; +use Moose; + +extends 'Bread::Board::ConstructorInjection'; +with 'Bread::Board::Declare::Role::Service'; + +__PACKAGE__->meta->make_immutable; +no Moose; + +1; diff --git a/lib/Bread/Board/Declare/Literal.pm b/lib/Bread/Board/Declare/Literal.pm new file mode 100644 index 0000000..50b4229 --- /dev/null +++ b/lib/Bread/Board/Declare/Literal.pm @@ -0,0 +1,10 @@ +package Bread::Board::Declare::Literal; +use Moose; + +extends 'Bread::Board::Literal'; +with 'Bread::Board::Declare::Role::Service'; + +__PACKAGE__->meta->make_immutable; +no Moose; + +1; diff --git a/lib/Bread/Board/Declare/Meta/Role/Accessor.pm b/lib/Bread/Board/Declare/Meta/Role/Accessor.pm new file mode 100644 index 0000000..e38236b --- /dev/null +++ b/lib/Bread/Board/Declare/Meta/Role/Accessor.pm @@ -0,0 +1,26 @@ +package Bread::Board::Declare::Meta::Role::Accessor; +use Moose::Role; + +around _inline_get => sub { + my $orig = shift; + my $self = shift; + my ($instance) = @_; + + my $attr = $self->associated_attribute; + + return 'do {' . "\n" + . 'my $val;' . "\n" + . 'if (' . $self->_inline_has($instance) . ') {' . "\n" + . '$val = ' . $self->$orig($instance) . ';' . "\n" + . '}' . "\n" + . 'else {' . "\n" + . '$val = ' . $instance . '->get_service(\'' . $attr->name . '\')->get;' . "\n" + . $self->_inline_check_constraint('$val') + . '}' . "\n" + . '$val' . "\n" + . '}'; +}; + +no Moose::Role; + +1; diff --git a/lib/Bread/Board/Declare/Meta/Role/Attribute.pm b/lib/Bread/Board/Declare/Meta/Role/Attribute.pm new file mode 100644 index 0000000..5cd4434 --- /dev/null +++ b/lib/Bread/Board/Declare/Meta/Role/Attribute.pm @@ -0,0 +1,185 @@ +package Bread::Board::Declare::Meta::Role::Attribute; +use Moose::Role; +Moose::Util::meta_attribute_alias('Service'); + +use Bread::Board::Types; +use List::MoreUtils qw(any); + +use Bread::Board::Declare::BlockInjection; +use Bread::Board::Declare::ConstructorInjection; +use Bread::Board::Declare::Literal; + +has service => ( + is => 'ro', + isa => 'Bool', + default => 1, +); + +has block => ( + is => 'ro', + isa => 'CodeRef', + predicate => 'has_block', +); + +# has_value is already a method +has literal_value => ( + is => 'ro', + isa => 'Str|CodeRef', + init_arg => 'value', + predicate => 'has_literal_value', +); + +has lifecycle => ( + is => 'ro', + isa => 'Str', + predicate => 'has_lifecycle', +); + +has dependencies => ( + is => 'ro', + isa => 'Bread::Board::Service::Dependencies', + coerce => 1, + predicate => 'has_dependencies', +); + +has constructor_name => ( + is => 'ro', + isa => 'Str', + predicate => 'has_constructor_name', +); + +has associated_service => ( + is => 'rw', + isa => 'Bread::Board::Service', + predicate => 'has_associated_service', +); + +after attach_to_class => sub { + my $self = shift; + + return unless $self->service; + + my %params = ( + associated_attribute => $self, + name => $self->name, + ($self->has_lifecycle + ? (lifecycle => $self->lifecycle) + : ()), + ($self->has_dependencies + ? (dependencies => $self->dependencies) + : ()), + ($self->has_constructor_name + ? (constructor_name => $self->constructor_name) + : ()), + ); + + my $service; + if ($self->has_block) { + $service = Bread::Board::Declare::BlockInjection->new( + %params, + block => $self->block, + ); + } + elsif ($self->has_literal_value) { + $service = Bread::Board::Declare::Literal->new( + %params, + value => $self->literal_value, + ); + } + elsif ($self->has_type_constraint) { + my $tc = $self->type_constraint; + if ($tc->isa('Moose::Meta::TypeConstraint::Class')) { + $service = Bread::Board::Declare::ConstructorInjection->new( + %params, + class => $tc->class, + ); + } + } + + $self->associated_service($service) if $service; +}; + +after _process_options => sub { + my $class = shift; + my ($name, $opts) = @_; + + return unless exists $opts->{default} + || exists $opts->{builder}; + return unless exists $opts->{class} + || exists $opts->{block} + || exists $opts->{value}; + + # XXX: uggggh + return if any { $_ eq 'Moose::Meta::Attribute::Native::Trait::String' + || $_ eq 'Moose::Meta::Attribute::Native::Trait::Counter' } + @{ $opts->{traits} }; + + my $exists = exists($opts->{default}) ? 'default' : 'builder'; + die "$exists is not valid when Bread::Board service options are set"; +}; + +around get_value => sub { + my $orig = shift; + my $self = shift; + my ($instance) = @_; + + return $self->$orig($instance) + if $self->has_value($instance); + + my $val = $instance->get_service($self->name)->get; + + $self->verify_against_type_constraint($val, instance => $instance) + if $self->has_type_constraint; + + if ($self->should_auto_deref) { + if (ref($val) eq 'ARRAY') { + return wantarray ? @$val : $val; + } + elsif (ref($val) eq 'HASH') { + return wantarray ? %$val : $val; + } + else { + die 'XXX'; + } + } + else { + return $val; + } +}; + +if (Moose->VERSION > 1.9900) { + around _inline_instance_get => sub { + my $orig = shift; + my $self = shift; + my ($instance) = @_; + return 'do {' . "\n" + . 'my $val;' . "\n" + . 'if (' . $self->_inline_instance_has($instance) . ') {' . "\n" + . '$val = ' . $self->$orig($instance) . ';' . "\n" + . '}' . "\n" + . 'else {' . "\n" + . '$val = ' . $instance . '->get_service(\'' . $self->name . '\')->get;' . "\n" + . $self->_inline_check_constraint( + '$val', '$type_constraint', '$type_constraint_obj' + ) + . '}' . "\n" + . '$val' . "\n" + . '}'; + }; +} +else { + around accessor_metaclass => sub { + my $orig = shift; + my $self = shift; + + return Moose::Meta::Class->create_anon_class( + superclasses => [ $self->$orig(@_) ], + roles => [ 'Bread::Board::Declare::Meta::Role::Accessor' ], + cache => 1 + )->name; + }; +} + +no Moose::Role; + +1; diff --git a/lib/Bread/Board/Declare/Meta/Role/Class.pm b/lib/Bread/Board/Declare/Meta/Role/Class.pm new file mode 100644 index 0000000..2869f7e --- /dev/null +++ b/lib/Bread/Board/Declare/Meta/Role/Class.pm @@ -0,0 +1,32 @@ +package Bread::Board::Declare::Meta::Role::Class; +use Moose::Role; + +use Bread::Board::Service; +use List::MoreUtils qw(any); + +sub get_all_services { + my $self = shift; + return map { $_->associated_service } + grep { $_->has_associated_service } + grep { Moose::Util::does_role($_, 'Bread::Board::Declare::Meta::Role::Attribute') } + $self->get_all_attributes; +} + +before superclasses => sub { + my $self = shift; + + return unless @_; + + die "Multiple inheritance is not supported for Bread::Board::Declare classes" + if @_ > 1; + + return if $_[0]->isa('Bread::Board::Container'); + + die "Cannot inherit from " . join(', ', @_) + . " because Bread::Board::Declare classes must inherit" + . " from Bread::Board::Container"; +}; + +no Moose::Role; + +1; diff --git a/lib/Bread/Board/Declare/Meta/Role/Instance.pm b/lib/Bread/Board/Declare/Meta/Role/Instance.pm new file mode 100644 index 0000000..3745b82 --- /dev/null +++ b/lib/Bread/Board/Declare/Meta/Role/Instance.pm @@ -0,0 +1,9 @@ +package Bread::Board::Declare::Meta::Role::Instance; +use Moose::Role; + +# XXX: ugh, this should be settable at the attr level, fix this in moose +sub inline_get_is_lvalue { 0 } + +no Moose::Role; + +1; diff --git a/lib/Bread/Board/Declare/Role/Object.pm b/lib/Bread/Board/Declare/Role/Object.pm new file mode 100644 index 0000000..f0f0048 --- /dev/null +++ b/lib/Bread/Board/Declare/Role/Object.pm @@ -0,0 +1,36 @@ +package Bread::Board::Declare::Role::Object; +use Moose::Role; + +has name => ( + is => 'rw', + isa => 'Str', + lazy => 1, + default => sub { shift->meta->name }, +); + +sub BUILD { } +after BUILD => sub { + my $self = shift; + + my $meta = Class::MOP::class_of($self); + + for my $service ($meta->get_all_services) { + if ($service->isa('Bread::Board::Declare::BlockInjection')) { + my $block = $service->block; + $self->add_service( + $service->clone( + block => sub { + $block->(@_, $self) + }, + ) + ); + } + else { + $self->add_service($service->clone); + } + } +}; + +no Moose::Role; + +1; diff --git a/lib/Bread/Board/Declare/Role/Service.pm b/lib/Bread/Board/Declare/Role/Service.pm new file mode 100644 index 0000000..b25069f --- /dev/null +++ b/lib/Bread/Board/Declare/Role/Service.pm @@ -0,0 +1,40 @@ +package Bread::Board::Declare::Role::Service; +use Moose::Role; + +has associated_attribute => ( + is => 'ro', + isa => 'Class::MOP::Attribute', + required => 1, + weak_ref => 1, +); + +around get => sub { + my $orig = shift; + my $self = shift; + + my $container = $self->parent_container; + + if ($self->associated_attribute->has_value($container)) { + return $self->associated_attribute->get_value($container); + } + + return $self->$orig(@_); +}; + +sub parent_container { + my $self = shift; + + my $container = $self; + until (!defined($container) + || ($container->isa('Bread::Board::Container') + && $container->does('Bread::Board::Declare::Role::Object'))) { + $container = $container->parent; + } + die "Couldn't find associated object!" unless defined $container; + + return $container; +} + +no Moose::Role; + +1; -- cgit v1.2.3