summaryrefslogtreecommitdiffstats
path: root/lib/Bread/Board/Declare
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2011-02-21 16:04:51 -0600
committerJesse Luehrs <doy@tozt.net>2011-02-21 16:04:51 -0600
commitb274df4c9da24b117a22e287acd03b3fa87233a8 (patch)
tree602aba197c8752ea4253bc8fbb950fb373f92903 /lib/Bread/Board/Declare
parent61839366b807e9e8f6818020508d765efed945b5 (diff)
downloadbread-board-declare-b274df4c9da24b117a22e287acd03b3fa87233a8.tar.gz
bread-board-declare-b274df4c9da24b117a22e287acd03b3fa87233a8.zip
rename MooseX::Bread::Board -> Bread::Board::Declare
Diffstat (limited to 'lib/Bread/Board/Declare')
-rw-r--r--lib/Bread/Board/Declare/BlockInjection.pm10
-rw-r--r--lib/Bread/Board/Declare/ConstructorInjection.pm10
-rw-r--r--lib/Bread/Board/Declare/Literal.pm10
-rw-r--r--lib/Bread/Board/Declare/Meta/Role/Accessor.pm26
-rw-r--r--lib/Bread/Board/Declare/Meta/Role/Attribute.pm185
-rw-r--r--lib/Bread/Board/Declare/Meta/Role/Class.pm32
-rw-r--r--lib/Bread/Board/Declare/Meta/Role/Instance.pm9
-rw-r--r--lib/Bread/Board/Declare/Role/Object.pm36
-rw-r--r--lib/Bread/Board/Declare/Role/Service.pm40
9 files changed, 358 insertions, 0 deletions
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;