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', required => 1,
  12   trigger => sub { shift->_clear_final_class },
  13 );
  14
  15 has roles => (
  16   is => 'rw', builder => 1,
  17   trigger => sub { shift->_clear_final_class },
  18   clearer => 'reset_roles',
  19 );
  20
  21 sub _build_roles { [] }
  22
  23 has _final_class => (is => 'lazy', clearer => 1);
  24
  25 sub _build__final_class {
  26   my ($self) = @_;
  27   my $class = use_module($self->class);
  28   if (my @roles = @{$self->roles}) {
  29     require Moo::Role;
  30     return Moo::Role->create_class_with_roles($class, @roles);
  31   } else {
  32     return $class;
  33   }
  34 }
  35
  36 after _clear_final_class => sub { shift->clear_object };
  37
  38 has constructor => (is => 'ro', default => sub { 'new' });
  39
  40 has arguments => (
  41   is => 'rw', builder => 1,
  42   trigger => sub { shift->_clear_final_arguments },
  43   clearer => 'reset_arguments',
  44 );
  45
  46 sub _build_arguments { {} }
  47
  48 has argument_filter => (
  49   is => 'rw', builder => 1,
  50   trigger => sub { shift->_clear_final_arguments },
  51   clearer => 'reset_argument_filter',
  52 );
  53
  54 sub _build_argument_filter { sub { shift } }
  55
  56 has _final_arguments => (is => 'lazy', clearer => 1);
  57
  58 after _clear_final_arguments => sub { shift->_clear_object };
  59
  60 sub _build__final_arguments {
  61   my ($self) = @_;
  62   $self->argument_filter->($self->arguments);
  63 }
  64
  65 has object => (is => 'lazy', clearer => 1);
  66
  67 sub _build_object {
  68   my ($self) = @_;
  69   $self->_final_class->${\$self->constructor}($self->_final_arguments);
  70 }
  71
  72 1;
  73
  74 =head1 NAME
  75
  76 Object::Builder - An object for building other objects.
  77
  78 =head1 SYNOPSIS
  79
  80 =head1 DESCRIPTION
  81
  82 =head1 AUTHOR
  83
  84  mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
  85
  86 =head1 CONTRIBUTORS
  87
  88 None yet - maybe this software is perfect! (ahahahahahahahahaha)
  89
  90 =head1 COPYRIGHT
  91
  92 Copyright (c) 2012 the Object::Builder L</AUTHOR> and L</CONTRIBUTORS>
  93 as listed above.
  94
  95 =head1 LICENSE
  96
  97 This library is free software and may be distributed under the same terms
  98 as perl itself.