Permalink
Browse files

minor tweaks here and there... add validation, start on tests

  • Loading branch information...
1 parent b7aac98 commit 68fe4b9968f4f4ba98b71c28d8fda9dba623fd25 @lestrrat committed Mar 11, 2009
View
@@ -95,7 +95,12 @@ sub inject_namespace {
sub inject_classes {
my $self = shift;
+ my $injected = 0;
foreach my $class (@_) {
+ print STDERR "Injecting class $class\n" if DEBUG();
+
+ Class::MOP::load_class($class);
+
my $meta = $class->meta;
if (! $meta) {
confess "$class does not have a meta object associated with it";
@@ -104,37 +109,54 @@ sub inject_classes {
# confess "$class does not implement MooseX::Bread::Board::Meta::Class";
# }
+ my $code;
my $attrs = $meta->bind_attrs;
- my @depends_on;
- my $code =
- "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
- "sub {\n" .
- " my (\$self, \$c) = \@_;\n " .
- " $class->new(\n"
- ;
- while (my($name, $path) = each %$attrs) {
- # If the value we're looking for is a literal, we want to be
- # able to
+ my @depends_on = @{ $meta->depends_on };
+ my $constructor = $meta->bind_constructor;
+ if ($constructor) {
+ # simply load the constructor
+ $code =
+ "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
+ "sub {\n" .
+ " my (\$self, \$c) = \@_;\n " .
+ " \$constructor->('$class', \$c);\n " .
+ "}\n"
+ ;
+ } else {
+ $code =
+ "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
+ "sub {\n" .
+ " my (\$self, \$c) = \@_;\n " .
+ " $class->new(\n"
+ ;
+ while (my($name, $path) = each %$attrs) {
+ # If the value we're looking for is a literal, we want to be
+ # able to handle it ... sanely
+ $code .=
+ "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
+ " '$name' => \$c->value('$path') || undef,\n"
+ ;
+ push @depends_on, $path;
+ }
$code .=
"#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
- " '$name' => \$c->value('$path') || undef,\n"
+ " );\n" .
+ "}\n"
;
- push @depends_on, $path;
}
- $code .=
- "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
- " );\n" .
- "}\n"
- ;
+ print STDERR "generated injection code:\n$code\n" if DEBUG();
$code = eval $code;
confess if $@;
+
$self->inject($meta->bind_name,
$self->deferred($code, {
depends_on => \@depends_on
}
));
+ $injected++;
}
+ return $injected;
}
sub deferred {
@@ -42,19 +42,21 @@ sub process {} # noop
sub validate_dependency {
my $self = shift;
+ print STDERR "validate_dependncy for $self\n" if Bread::Board::DEBUG();
if (!$self->dependency_met && $self->has_dependency) {
my $c = $self->root;
my $params = $c->params;
foreach my $depends (@{$self->depends_on}) {
+ print " depends on $depends\n" if Bread::Board::DEBUG();
# XXX - checking if a dependency is a param or a service is a bad idea
# what's a better way? -lestrrat
if ($depends =~ /^\//) {
- if (! $c->get($depends)) {
- return ();
+ if (! $c->value($depends)) {
+ confess "Dependency $depends has not bee fullfilled";
}
} else {
if (! exists $params->{$depends}) {
- return ();
+ confess "Dependency $depends has not bee fullfilled";
}
}
}
@@ -12,6 +12,7 @@ with 'Bread::Board::Service';
sub compute {
my $self = shift;
+
my $code = $self->code;
if (! ref $code) {
$code = $self->can($code);
@@ -20,6 +21,7 @@ sub compute {
}
}
+ $self->validate_dependency();
$code->($self, @_);
}
View
@@ -5,7 +5,7 @@ use Moose::Exporter;
use MooseX::Bread::Board::Meta::Class;
Moose::Exporter->setup_import_methods(
- with_caller => [ qw(bind_name bind_attr) ]
+ with_caller => [ qw(bind_name bind_attr depends_on bind_constructor) ]
);
sub init_meta {
@@ -27,6 +27,16 @@ sub bind_attr {
$caller->meta->add_bind_attr($name, @args);
}
+sub depends_on {
+ my ($caller, @args) = @_;
+ $caller->meta->add_depends_on(@args);
+}
+
+sub bind_constructor {
+ my ($caller, $sub) = @_;
+ $caller->meta->bind_constructor($sub);
+}
+
1;
=head1 NAME
@@ -105,7 +115,7 @@ The rest of the classes works mostly the same way. Here's MyApp::Model::Foo, and
bind_name '/MyApp/Logger';
bind_attr filename => literal '/config/log/filename';
-MyApp::Schema is a bit different, in that it DBIx::Class::Schema based, and you won't be calling new() to instantiate it (you'd call C<connection()>), and you don't pass a name => value pair (you'd pass @connect_info).
+MyApp::Schema is a bit different, in that it is DBIx::Class::Schema based, and you won't be calling new() to instantiate it (you'd call C<connection()>), and you don't pass a name => value pair (you'd pass @connect_info).
package MyApp::Schema;
use Moose;
@@ -130,7 +140,14 @@ Finally, we need to put everything together by registering these classes to our
'MyApp::Model::Foo',
'MyApp',
);
+ # or $c->inject_namespace('MyApp');
my $app = $c->value('/MyApp');
-
+
+There are sometimes those modules that you just can touch from outside.
+In those cases, you will have to provide the objects yourself:
+
+ $c->inject('/path/to/another/dependency' =>
+ $c->deferred( sub { ... } ) );
+
=cut
@@ -5,7 +5,9 @@ use namespace::clean -except => 'meta';
has 'bind_name' => (
is => 'rw',
- isa => 'Str'
+ isa => 'Str',
+ lazy_build => 1,
+
);
has 'bind_attrs' => (
@@ -14,9 +16,33 @@ has 'bind_attrs' => (
default => sub { +{} },
);
+has 'depends_on' => (
+ is => 'rw',
+ isa => 'ArrayRef',
+ default => sub { +[] }
+);
+
+has 'bind_constructor' => (
+ is => 'rw',
+ isa => 'CodeRef'
+);
+
+sub _build_bind_name {
+ my $self = shift;
+ my $pkg = $self->{package};
+ $pkg = "/$pkg";
+ $pkg =~ s{::}{/}g;
+ $pkg;
+}
+
sub add_bind_attr {
my ($self, $name, $path) = @_;
$self->bind_attrs->{$name} = $path;
}
+sub add_depends_on {
+ my ($self, @list) = @_;
+ push @{ $self->depends_on }, @list;
+}
+
1;
@@ -0,0 +1,18 @@
+package Test::MXBB::Basic::App;
+use Moose;
+use MooseX::Bread::Board;
+
+bind_attr schema => '/Test/MXBB/Basic/Schema';
+bind_attr logger => '/Test/MXBB/Basic/Logger';
+
+has 'schema' => (
+ is => 'ro',
+ required => 1,
+);
+
+has 'logger' => (
+ is => 'rw',
+ required => 1
+);
+
+1;
@@ -0,0 +1,14 @@
+
+package Test::MXBB::Basic::Schema;
+use Moose;
+use MooseX::Bread::Board;
+
+extends 'DBIx::Class::Schema';
+
+depends_on '/Test/MXBB/Basic/config/connect_info';
+bind_constructor sub {
+ my ($class, $c) = @_;
+ return $class->connection(@{ $c->value('/Test/MXBB/Basic/config/connect_info' ) } );
+};
+
+1;
View
@@ -0,0 +1,15 @@
+use strict;
+use lib "t/lib";
+use Test::More;
+use Test::Exception;
+
+plan tests => 9;
+use_ok("Bread::Board");
+
+my $c = Bread::Board->new();
+
+lives_and {
+ is($c->inject_namespace('Test::MXBB::Basic'), 3, "3 components injected");
+} "inject_namespace works";
+
+isa_ok( $c->value('/Test/MXBB/Basic/App'), 'Test::MXBB::Basic::App');

0 comments on commit 68fe4b9

Please sign in to comment.