From: Matt S Trout 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?p=scpubgit%2FObject-Builder.git;a=commitdiff_plain;h=ff402c4d035d8e3e3e6a3fd35e83505efb377e6f 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) + +=head1 CONTRIBUTORS + +None yet - maybe this software is perfect! (ahahahahahahahahaha) + +=head1 COPYRIGHT + +Copyright (c) 2012 the Object::Builder L and L +as listed above. + +=head1 LICENSE + +This library is free software and may be distributed under the same terms +as perl itself.