lib/Mouse/Object.pm

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