From: Matt S Trout <mst@shadowcat.co.uk>
Date: Fri, 11 May 2012 21:39:31 +0000 (+0000)
Subject: first sketch of Object::Builder
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ff402c4d035d8e3e3e6a3fd35e83505efb377e6f;p=scpubgit%2FObject-Builder.git

first sketch of Object::Builder
---

ff402c4d035d8e3e3e6a3fd35e83505efb377e6f
diff --git a/lib/Object/Builder.pm b/lib/Object/Builder.pm
new file mode 100644
index 0000000..2f27771
--- /dev/null
+++ b/lib/Object/Builder.pm
@@ -0,0 +1,98 @@
+package Object::Builder;
+
+use Module::Runtime qw(use_module);
+use Moo;
+
+our $VERSION = '0.000001'; # 0.0.1
+
+$VERSION = eval $VERSION;
+
+has class => (
+  is => 'rw', required => 1,
+  trigger => sub { shift->_clear_final_class },
+);
+
+has roles => (
+  is => 'rw', builder => 1,
+  trigger => sub { shift->_clear_final_class },
+  clearer => 'reset_roles',
+);
+
+sub _build_roles { [] }
+
+has _final_class => (is => 'lazy', clearer => 1);
+
+sub _build__final_class {
+  my ($self) = @_;
+  my $class = use_module($self->class);
+  if (my @roles = @{$self->roles}) {
+    require Moo::Role;
+    return Moo::Role->create_class_with_roles($class, @roles);
+  } else {
+    return $class;
+  }
+}
+
+after _clear_final_class => sub { shift->clear_object };
+
+has constructor => (is => 'ro', default => sub { 'new' });
+
+has arguments => (
+  is => 'rw', builder => 1,
+  trigger => sub { shift->_clear_final_arguments },
+  clearer => 'reset_arguments',
+);
+
+sub _build_arguments { {} }
+
+has argument_filter => (
+  is => 'rw', builder => 1,
+  trigger => sub { shift->_clear_final_arguments },
+  clearer => 'reset_argument_filter',
+);
+
+sub _build_argument_filter { sub { shift } }
+
+has _final_arguments => (is => 'lazy', clearer => 1);
+
+after _clear_final_arguments => sub { shift->_clear_object };
+
+sub _build__final_arguments {
+  my ($self) = @_;
+  $self->argument_filter->($self->arguments);
+}
+
+has object => (is => 'lazy', clearer => 1);
+
+sub _build_object {
+  my ($self) = @_;
+  $self->_final_class->${\$self->constructor}($self->_final_arguments);
+}
+
+1;
+
+=head1 NAME
+
+Object::Builder - An object for building other objects.
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 AUTHOR
+
+ mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
+
+=head1 CONTRIBUTORS
+
+None yet - maybe this software is perfect! (ahahahahahahahahaha)
+
+=head1 COPYRIGHT
+
+Copyright (c) 2012 the Object::Builder L</AUTHOR> and L</CONTRIBUTORS>
+as listed above.
+
+=head1 LICENSE
+
+This library is free software and may be distributed under the same terms
+as perl itself.