lib/Moo/Object.pm

   1 package Moo::Object;
   2
   3 use strictures 1;
   4
   5 our %NO_BUILD;
   6 our %NO_DEMOLISH;
   7 our $BUILD_MAKER;
   8 our $DEMOLISH_MAKER;
   9
  10 sub new {
  11   my $class = shift;
  12   unless (exists $NO_DEMOLISH{$class}) {
  13     unless ($NO_DEMOLISH{$class} = !$class->can('DEMOLISH')) {
  14       ($DEMOLISH_MAKER ||= do {
  15         require Method::Generate::DemolishAll;
  16         Method::Generate::DemolishAll->new
  17       })->generate_method($class);
  18     }
  19   }
  20   $NO_BUILD{$class} and
  21     return bless({ ref($_[0]) eq 'HASH' ? %{$_[0]} : @_ }, $class);
  22   $NO_BUILD{$class} = !$class->can('BUILD') unless exists $NO_BUILD{$class};
  23   $NO_BUILD{$class}
  24     ? bless({ ref($_[0]) eq 'HASH' ? %{$_[0]} : @_ }, $class)
  25     : do {
  26         my $proto = ref($_[0]) eq 'HASH' ? $_[0] : { @_ };
  27         bless({ %$proto }, $class)->BUILDALL($proto);
  28       };
  29 }
  30
  31 # Inlined into Method::Generate::Constructor::_generate_args() - keep in sync
  32 sub BUILDARGS {
  33     my $class = shift;
  34     if ( scalar @_ == 1 ) {
  35         unless ( defined $_[0] && ref $_[0] eq 'HASH' ) {
  36             die "Single parameters to new() must be a HASH ref"
  37                 ." data => ". $_[0] ."\n";
  38         }
  39         return { %{ $_[0] } };
  40     }
  41     elsif ( @_ % 2 ) {
  42         die "The new() method for $class expects a hash reference or a key/value list."
  43                 . " You passed an odd number of arguments\n";
  44     }
  45     else {
  46         return {@_};
  47     }
  48 }
  49
  50 sub BUILDALL {
  51   my $self = shift;
  52   $self->${\(($BUILD_MAKER ||= do {
  53     require Method::Generate::BuildAll;
  54     Method::Generate::BuildAll->new
  55   })->generate_method(ref($self)))}(@_);
  56 }
  57
  58 sub DEMOLISHALL {
  59   my $self = shift;
  60   $self->${\(($DEMOLISH_MAKER ||= do {
  61     require Method::Generate::DemolishAll;
  62     Method::Generate::DemolishAll->new
  63   })->generate_method(ref($self)))}(@_);
  64 }
  65
  66 sub does {
  67   require Role::Tiny;
  68   { no warnings 'redefine'; *does = \&Role::Tiny::does_role }
  69   goto &Role::Tiny::does_role;
  70 }
  71
  72 sub meta {
  73   require Moo::HandleMoose::FakeMetaClass;
  74   my $class = ref($_[0])||$_[0];
  75   bless({ name => $class }, 'Moo::HandleMoose::FakeMetaClass');
  76 }
  77
  78 1;