lib/Mouse/Object.pm

   1 package Mouse::Object;
   2 use strict;
   3 use warnings;
   4
   5 use Mouse::Util qw(does dump);
   6
   7 sub new {
   8     my $class = shift;
   9
  10     $class->throw_error('Cannot call new() on an instance') if ref $class;
  11
  12     my $args = $class->BUILDARGS(@_);
  13
  14     my $instance = Mouse::Meta::Class->initialize($class)->new_object($args);
  15     $instance->BUILDALL($args);
  16     return $instance;
  17 }
  18
  19 sub BUILDARGS {
  20     my $class = shift;
  21
  22     if (scalar @_ == 1) {
  23         (ref($_[0]) eq 'HASH')
  24             || $class->meta->throw_error("Single parameters to new() must be a HASH ref");
  25         return {%{$_[0]}};
  26     }
  27     else {
  28         return {@_};
  29     }
  30 }
  31
  32 sub DESTROY { shift->DEMOLISHALL }
  33
  34 sub BUILDALL {
  35     my $self = shift;
  36
  37     # short circuit
  38     return unless $self->can('BUILD');
  39
  40     for my $class (reverse $self->meta->linearized_isa) {
  41         no strict 'refs';
  42         no warnings 'once';
  43         my $code = *{ $class . '::BUILD' }{CODE}
  44             or next;
  45         $code->($self, @_);
  46     }
  47     return;
  48 }
  49
  50 sub DEMOLISHALL {
  51     my $self = shift;
  52
  53     # short circuit
  54     return unless $self->can('DEMOLISH');
  55
  56     # We cannot count on being able to retrieve a previously made
  57     # metaclass, _or_ being able to make a new one during global
  58     # destruction. However, we should still be able to use mro at
  59     # that time (at least tests suggest so ;)
  60
  61     foreach my $class (@{ Mouse::Util::get_linear_isa(ref $self) }) {
  62         my $demolish = do{ no strict 'refs'; *{"${class}::DEMOLISH"}{CODE} };
  63         $self->$demolish()
  64             if defined $demolish;
  65     }
  66     return;
  67 }
  68
  69 1;
  70
  71 __END__
  72
  73 =head1 NAME
  74
  75 Mouse::Object - we don't need to steenkin' constructor
  76
  77 =head1 METHODS
  78
  79 =head2 new arguments -> object
  80
  81 Instantiates a new Mouse::Object. This is obviously intended for subclasses.
  82
  83 =head2 BUILDALL \%args
  84
  85 Calls L</BUILD> on each class in the class hierarchy. This is called at the
  86 end of L</new>.
  87
  88 =head2 BUILD \%args
  89
  90 You may put any business logic initialization in BUILD methods. You don't
  91 need to redispatch or return any specific value.
  92
  93 =head2 BUILDARGS
  94
  95 Lets you override the arguments that C<new> takes. Return a hashref of
  96 parameters.
  97
  98 =head2 DEMOLISHALL
  99
 100 Calls L</DEMOLISH> on each class in the class hierarchy. This is called at
 101 L</DESTROY> time.
 102
 103 =head2 DEMOLISH
 104
 105 You may put any business logic deinitialization in DEMOLISH methods. You don't
 106 need to redispatch or return any specific value.
 107
 108
 109 =head2 does $role_name
 110
 111 This will check if the invocant's class "does" a given C<$role_name>.
 112 This is similar to "isa" for object, but it checks the roles instead.
 113
 114
 115 =head2 B<dump ($maxdepth)>
 116
 117 From the Moose POD:
 118
 119     C'mon, how many times have you written the following code while debugging:
 120
 121      use Data::Dumper;
 122      warn Dumper $obj;
 123
 124     It can get seriously annoying, so why not just use this.
 125
 126 The implementation was lifted directly from Moose::Object.
 127
 128 =cut
 129
 130