lib/Moo/Object.pm

   1 package Moo::Object;
   2
   3 use strictures 1;
   4
   5 our %NO_BUILD;
   6 our $BUILD_MAKER;
   7
   8 sub new {
   9   my $class = shift;
  10   $NO_BUILD{$class} and
  11     return bless({ ref($_[0]) eq 'HASH' ? %{$_[0]} : @_ }, $class);
  12   $NO_BUILD{$class} = !$class->can('BUILD') unless exists $NO_BUILD{$class};
  13   $NO_BUILD{$class}
  14     ? bless({ ref($_[0]) eq 'HASH' ? %{$_[0]} : @_ }, $class)
  15     : do {
  16         my $proto = ref($_[0]) eq 'HASH' ? $_[0] : { @_ };
  17         bless({ %$proto }, $class)->BUILDALL($proto);
  18       };
  19 }
  20
  21 # Inlined into Method::Generate::Constructor::_generate_args() - keep in sync
  22 sub BUILDARGS {
  23     my $class = shift;
  24     if ( scalar @_ == 1 ) {
  25         unless ( defined $_[0] && ref $_[0] eq 'HASH' ) {
  26             die "Single parameters to new() must be a HASH ref"
  27                 ." data => ". $_[0] ."\n";
  28         }
  29         return { %{ $_[0] } };
  30     }
  31     elsif ( @_ % 2 ) {
  32         die "The new() method for $class expects a hash reference or a key/value list."
  33                 . " You passed an odd number of arguments\n";
  34     }
  35     else {
  36         return {@_};
  37     }
  38 }
  39
  40 sub BUILDALL {
  41   my $self = shift;
  42   $self->${\(($BUILD_MAKER ||= do {
  43     require Method::Generate::BuildAll;
  44     Method::Generate::BuildAll->new
  45   })->generate_method(ref($self)))}(@_);
  46 }
  47
  48 sub DESTROY {
  49     my $self = shift;
  50
  51     return unless $self->can('DEMOLISH'); # short circuit
  52
  53     require Moo::_Utils;
  54
  55     my $e = do {
  56         local $?;
  57         local $@;
  58         eval {
  59             # DEMOLISHALL
  60
  61             # We cannot count on being able to retrieve a previously made
  62             # metaclass, _or_ being able to make a new one during global
  63             # destruction. However, we should still be able to use mro at
  64             # that time (at least tests suggest so ;)
  65
  66             foreach my $class (@{ Moo::_Utils::_get_linear_isa(ref $self) }) {
  67                 my $demolish = $class->can('DEMOLISH') || next;
  68
  69                 $self->$demolish($Moo::_Utils::_in_global_destruction);
  70             }
  71         };
  72         $@;
  73     };
  74
  75     no warnings 'misc';
  76     die $e if $e; # rethrow
  77 }
  78
  79
  80
  81 sub does {
  82   require Role::Tiny;
  83   { no warnings 'redefine'; *does = \&Role::Tiny::does_role }
  84   goto &Role::Tiny::does_role;
  85 }
  86
  87 1;