summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--dist.ini2
-rw-r--r--lib/MooseX/Bread/Board.pm25
-rw-r--r--lib/MooseX/Bread/Board/BlockInjection.pm10
-rw-r--r--lib/MooseX/Bread/Board/ConstructorInjection.pm10
-rw-r--r--lib/MooseX/Bread/Board/Literal.pm10
-rw-r--r--lib/MooseX/Bread/Board/Meta/Role/Attribute.pm109
-rw-r--r--lib/MooseX/Bread/Board/Meta/Role/Class.pm19
-rw-r--r--lib/MooseX/Bread/Board/Role/Object.pm27
-rw-r--r--lib/MooseX/Bread/Board/Role/Service.pm32
-rw-r--r--t/01-basic.t79
-rw-r--r--t/02-deps.t45
11 files changed, 368 insertions, 0 deletions
diff --git a/dist.ini b/dist.ini
index d9964b4..a8bc513 100644
--- a/dist.ini
+++ b/dist.ini
@@ -7,3 +7,5 @@ copyright_holder = Jesse Luehrs
dist = MooseX-Bread-Board
[Prereqs]
+Moose = 1.21
+Bread::Board = 0
diff --git a/lib/MooseX/Bread/Board.pm b/lib/MooseX/Bread/Board.pm
index e69de29..f40797e 100644
--- a/lib/MooseX/Bread/Board.pm
+++ b/lib/MooseX/Bread/Board.pm
@@ -0,0 +1,25 @@
+package MooseX::Bread::Board;
+use Moose::Exporter;
+
+my (undef, undef, $init_meta) = Moose::Exporter->build_import_methods(
+ install => ['import', 'unimport'],
+ class_metaroles => {
+ attribute => ['MooseX::Bread::Board::Meta::Role::Attribute'],
+ class => ['MooseX::Bread::Board::Meta::Role::Class'],
+ },
+ base_class_roles => ['MooseX::Bread::Board::Role::Object'],
+);
+
+sub init_meta {
+ my $package = shift;
+ my %options = @_;
+ if (my $meta = Class::MOP::class_of($options{for_class})) {
+ my @supers = $meta->superclasses;
+ $meta->superclasses('Bread::Board::Container')
+ if @supers == 1 && $supers[0] eq 'Moose::Object';
+ }
+ $package->$init_meta(%options);
+}
+
+
+1;
diff --git a/lib/MooseX/Bread/Board/BlockInjection.pm b/lib/MooseX/Bread/Board/BlockInjection.pm
new file mode 100644
index 0000000..e1dca1e
--- /dev/null
+++ b/lib/MooseX/Bread/Board/BlockInjection.pm
@@ -0,0 +1,10 @@
+package MooseX::Bread::Board::BlockInjection;
+use Moose;
+
+extends 'Bread::Board::BlockInjection';
+with 'MooseX::Bread::Board::Role::Service';
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;
diff --git a/lib/MooseX/Bread/Board/ConstructorInjection.pm b/lib/MooseX/Bread/Board/ConstructorInjection.pm
new file mode 100644
index 0000000..f3b345b
--- /dev/null
+++ b/lib/MooseX/Bread/Board/ConstructorInjection.pm
@@ -0,0 +1,10 @@
+package MooseX::Bread::Board::ConstructorInjection;
+use Moose;
+
+extends 'Bread::Board::ConstructorInjection';
+with 'MooseX::Bread::Board::Role::Service';
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;
diff --git a/lib/MooseX/Bread/Board/Literal.pm b/lib/MooseX/Bread/Board/Literal.pm
new file mode 100644
index 0000000..bf5944a
--- /dev/null
+++ b/lib/MooseX/Bread/Board/Literal.pm
@@ -0,0 +1,10 @@
+package MooseX::Bread::Board::Literal;
+use Moose;
+
+extends 'Bread::Board::Literal';
+with 'MooseX::Bread::Board::Role::Service';
+
+__PACKAGE__->meta->make_immutable;
+no Moose;
+
+1;
diff --git a/lib/MooseX/Bread/Board/Meta/Role/Attribute.pm b/lib/MooseX/Bread/Board/Meta/Role/Attribute.pm
new file mode 100644
index 0000000..a7ecb59
--- /dev/null
+++ b/lib/MooseX/Bread/Board/Meta/Role/Attribute.pm
@@ -0,0 +1,109 @@
+package MooseX::Bread::Board::Meta::Role::Attribute;
+use Moose::Role;
+
+use Bread::Board::Types;
+
+use MooseX::Bread::Board::BlockInjection;
+use MooseX::Bread::Board::ConstructorInjection;
+use MooseX::Bread::Board::Literal;
+
+has class => (
+ is => 'ro',
+ isa => 'Str',
+ predicate => 'has_class',
+);
+
+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',
+);
+
+after attach_to_class => sub {
+ my $self = shift;
+
+ my $meta = $self->associated_class;
+ my $attr_reader = $self->get_read_method;
+
+ my %params = (
+ associated_attribute => $self,
+ name => $self->name,
+ ($self->has_lifecycle
+ ? (lifecycle => $self->lifecycle)
+ : ()),
+ ($self->has_dependencies
+ ? (dependencies => $self->dependencies)
+ : ()),
+ );
+
+ my $service;
+ if ($self->has_class) {
+ $service = MooseX::Bread::Board::ConstructorInjection->new(
+ %params,
+ class => $self->class,
+ )
+ }
+ elsif ($self->has_block) {
+ $service = MooseX::Bread::Board::BlockInjection->new(
+ %params,
+ block => $self->block,
+ )
+ }
+ elsif ($self->has_literal_value) {
+ $service = MooseX::Bread::Board::Literal->new(
+ %params,
+ value => $self->literal_value,
+ )
+ }
+ else {
+ return;
+ }
+
+ $meta->add_service($service);
+};
+
+around get_value => sub {
+ my $orig = shift;
+ my $self = shift;
+ my ($instance) = @_;
+
+ return $self->$orig($instance)
+ if $self->has_value($instance);
+
+ return $instance->get_service($self->name)->get;
+};
+
+around inline_get => sub {
+ my $orig = shift;
+ my $self = shift;
+ my ($instance) = @_;
+
+ return 'return (' . $self->inline_has($instance) . ')' . "\n"
+ . '? (' . $self->$orig($instance) . ')' . "\n"
+ . ': (' . $instance . '->get_service(\'' . $self->name . '\')->get);';
+};
+
+no Moose::Role;
+
+1;
diff --git a/lib/MooseX/Bread/Board/Meta/Role/Class.pm b/lib/MooseX/Bread/Board/Meta/Role/Class.pm
new file mode 100644
index 0000000..652d0b7
--- /dev/null
+++ b/lib/MooseX/Bread/Board/Meta/Role/Class.pm
@@ -0,0 +1,19 @@
+package MooseX::Bread::Board::Meta::Role::Class;
+use Moose::Role;
+
+use Bread::Board::Service;
+
+has services => (
+ traits => ['Array'],
+ isa => 'ArrayRef[Bread::Board::Service]',
+ default => sub { [] },
+ handles => {
+ add_service => 'push',
+ services => 'elements',
+ has_services => 'count',
+ },
+);
+
+no Moose::Role;
+
+1;
diff --git a/lib/MooseX/Bread/Board/Role/Object.pm b/lib/MooseX/Bread/Board/Role/Object.pm
new file mode 100644
index 0000000..552bc75
--- /dev/null
+++ b/lib/MooseX/Bread/Board/Role/Object.pm
@@ -0,0 +1,27 @@
+package MooseX::Bread::Board::Role::Object;
+use Moose::Role;
+use Bread::Board;
+
+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);
+ return unless $meta->has_services;
+
+ for my $service ($meta->services) {
+ $self->add_service($service->clone);
+ }
+};
+
+no Bread::Board;
+no Moose::Role;
+
+1;
diff --git a/lib/MooseX/Bread/Board/Role/Service.pm b/lib/MooseX/Bread/Board/Role/Service.pm
new file mode 100644
index 0000000..8442e3a
--- /dev/null
+++ b/lib/MooseX/Bread/Board/Role/Service.pm
@@ -0,0 +1,32 @@
+package MooseX::Bread::Board::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;
+ until (!defined($container)
+ || ($container->isa('Bread::Board::Container')
+ && $container->does('MooseX::Bread::Board::Role::Object'))) {
+ $container = $container->parent;
+ }
+ die "Couldn't find associated object!" unless defined $container;
+
+ if ($self->associated_attribute->has_value($container)) {
+ return $self->associated_attribute->get_value($container);
+ }
+
+ return $self->$orig(@_);
+};
+
+no Moose::Role;
+
+1;
diff --git a/t/01-basic.t b/t/01-basic.t
new file mode 100644
index 0000000..a679a47
--- /dev/null
+++ b/t/01-basic.t
@@ -0,0 +1,79 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+{
+ package Baz;
+ use Moose;
+}
+
+{
+ package Foo;
+ use Moose;
+ use MooseX::Bread::Board;
+
+ has foo => (
+ is => 'ro',
+ isa => 'Str',
+ default => 'FOO',
+ );
+
+ has bar => (
+ is => 'ro',
+ isa => 'Str',
+ value => 'BAR',
+ );
+
+ has baz => (
+ is => 'ro',
+ isa => 'Baz',
+ class => 'Baz',
+ );
+
+ my $i = 0;
+ has quux => (
+ is => 'ro',
+ isa => 'Str',
+ block => sub { 'QUUX' . $i++ },
+ );
+}
+
+{
+ my $foo = Foo->new;
+ ok($foo->has_service($_), "has service $_")
+ for qw(bar baz quux);
+ ok(!$foo->has_service('foo'), "doesn't have service foo");
+ isa_ok($foo->get_service('bar'), 'MooseX::Bread::Board::Literal');
+ isa_ok($foo->get_service('baz'), 'MooseX::Bread::Board::ConstructorInjection');
+ isa_ok($foo->get_service('quux'), 'MooseX::Bread::Board::BlockInjection');
+}
+
+{
+ my $foo = Foo->new;
+ is($foo->foo, 'FOO', "normal attrs work");
+ is($foo->bar, 'BAR', "literals work");
+ isa_ok($foo->baz, 'Baz');
+ isnt($foo->baz, $foo->baz, "new instance each time");
+ is($foo->quux, 'QUUX0', "block injections work");
+ is($foo->quux, 'QUUX1', "and they are run on each access");
+}
+
+{
+ my $baz = Baz->new;
+ my $foo = Foo->new(
+ foo => 'OOF',
+ bar => 'RAB',
+ baz => $baz,
+ quux => 'XUUQ',
+ );
+ is($foo->foo, 'OOF', "normal attrs work from constructor");
+ is($foo->bar, 'RAB', "constructor overrides literals");
+ isa_ok($foo->baz, 'Baz');
+ is($foo->baz, $baz, "constructor overrides constructor injections");
+ is($foo->baz, $foo->baz, "and returns the same thing each time");
+ is($foo->quux, 'XUUQ', "constructor overrides block injections");
+ is($foo->quux, 'XUUQ', "and returns the same thing each time");
+}
+
+done_testing;
diff --git a/t/02-deps.t b/t/02-deps.t
new file mode 100644
index 0000000..73b3d4a
--- /dev/null
+++ b/t/02-deps.t
@@ -0,0 +1,45 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+{
+ package Baz;
+ use Moose;
+
+ has bar => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+ );
+}
+
+{
+ package Foo;
+ use Moose;
+ use MooseX::Bread::Board;
+
+ my $i = 0;
+ has bar => (
+ is => 'ro',
+ isa => 'Str',
+ block => sub { $i++ },
+ );
+
+ has baz => (
+ is => 'ro',
+ isa => 'Baz',
+ class => 'Baz',
+ dependencies => ['bar'],
+ );
+}
+
+{
+ my $foo = Foo->new;
+ my $baz = $foo->baz;
+ is($baz->bar, '0', "deps resolved correctly");
+ is($baz->bar, '0', "doesn't re-resolve, since Baz is a normal class");
+ is($foo->baz->bar, '1', "re-resolves since the baz attr isn't a singleton");
+}
+
+done_testing;
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-25 00:03:19 +0000