lib/Object/Builder.pm

   1 package Object::Builder;
   2
   3 use Module::Runtime qw(use_module);
   4 use Moo;
   5
   6 our $VERSION = '0.000001'; # 0.0.1
   7
   8 $VERSION = eval $VERSION;
   9
  10 has class => (
  11   is => 'rw', lazy => 1, builder => 1,
  12   trigger => sub { shift->_clear_final_class },
  13 );
  14
  15 sub _build_class { die "No default class set" }
  16
  17 has roles => (
  18   is => 'rw', lazy => 1, builder => 1,
  19   trigger => sub { shift->_clear_final_class },
  20   clearer => 'reset_roles',
  21 );
  22
  23 after reset_roles => sub { shift->_clear_final_class };
  24
  25 sub _build_roles { [] }
  26
  27 has _final_class => (is => 'lazy', clearer => 1);
  28
  29 sub _build__final_class {
  30   my ($self) = @_;
  31   my $class = use_module($self->class);
  32   if (my @roles = @{$self->roles}) {
  33     require Moo::Role;
  34     return Moo::Role->create_class_with_roles($class, @roles);
  35   } else {
  36     return $class;
  37   }
  38 }
  39
  40 after _clear_final_class => sub { shift->clear_object };
  41
  42 has constructor => (is => 'ro', default => sub { 'new' });
  43
  44 has arguments => (
  45   is => 'rw', builder => 1,
  46   trigger => sub { shift->_clear_final_arguments },
  47   clearer => 'reset_arguments',
  48 );
  49
  50 after reset_arguments => sub { shift->_clear_final_arguments };
  51
  52 sub _build_arguments { {} }
  53
  54 has argument_filter => (
  55   is => 'rw', builder => 1,
  56   trigger => sub { shift->_clear_final_arguments },
  57   clearer => 'reset_argument_filter',
  58 );
  59
  60 sub _build_argument_filter { sub { shift } }
  61
  62 has _final_arguments => (is => 'lazy', clearer => 1);
  63
  64 after _clear_final_arguments => sub { shift->_clear_object };
  65
  66 sub _build__final_arguments {
  67   my ($self) = @_;
  68   $self->argument_filter->($self->arguments);
  69 }
  70
  71 has object => (is => 'lazy', clearer => 1);
  72
  73 sub _build_object {
  74   my ($self) = @_;
  75   $self->_final_class->${\$self->constructor}($self->_final_arguments);
  76 }
  77
  78 sub BUILD {
  79   my ($self, $args) = @_;
  80   unless (
  81     $args->{object} or $args->{class}
  82     or ($self->can('_build_class') ne __PACKAGE__->can('_build_class')
  83   ) {
  84     die "No static object passed, and no class supplied or defaulted";
  85   }
  86 }
  87
  88 1;
  89
  90 =head1 NAME
  91
  92 Object::Builder - An object for building other objects.
  93
  94 =head1 SYNOPSIS
  95
  96 =head1 DESCRIPTION
  97
  98 =head1 AUTHOR
  99
 100  mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 101
 102 =head1 CONTRIBUTORS
 103
 104 None yet - maybe this software is perfect! (ahahahahahahahahaha)
 105
 106 =head1 COPYRIGHT
 107
 108 Copyright (c) 2012 the Object::Builder L</AUTHOR> and L</CONTRIBUTORS>
 109 as listed above.
 110
 111 =head1 LICENSE
 112
 113 This library is free software and may be distributed under the same terms
 114 as perl itself.