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{
  55             no strict 'refs';
  56             no warnings 'once';
  57             *{ $class . '::BUILD' }{CODE};
  58         } or next;
  59
  60         $self->$build(@_);
  61     }
  62     return;
  63 }
  64
  65 sub DEMOLISHALL {
  66     my $self = shift;
  67
  68     # short circuit
  69     return unless $self->can('DEMOLISH');
  70
  71     # We cannot count on being able to retrieve a previously made
  72     # metaclass, _or_ being able to make a new one during global
  73     # destruction. However, we should still be able to use mro at
  74     # that time (at least tests suggest so ;)
  75
  76     foreach my $class (@{ Mouse::Util::get_linear_isa(ref $self) }) {
  77         my $demolish = do{
  78             no strict 'refs';
  79             no warnings 'once';
  80             *{ $class . '::DEMOLISH'}{CODE};
  81         } or next;
  82
  83         $self->$demolish();
  84     }
  85     return;
  86 }
  87
  88 1;
  89
  90 __END__
  91
  92 =head1 NAME
  93
  94 Mouse::Object - The base object for Mouse classes
  95
  96 =head1 VERSION
  97
  98 This document describes Mouse version 0.40
  99
 100 =head1 METHODS
 101
 102 =head2 C<< new (Arguments) -> Object >>
 103
 104 Instantiates a new C<Mouse::Object>. This is obviously intended for subclasses.
 105
 106 =head2 C<< BUILDARGS (Arguments) -> HashRef >>
 107
 108 Lets you override the arguments that C<new> takes. Return a hashref of
 109 parameters.
 110
 111 =head2 C<< BUILDALL (\%args) >>
 112
 113 Calls C<BUILD> on each class in the class hierarchy. This is called at the
 114 end of C<new>.
 115
 116 =head2 C<< BUILD (\%args) >>
 117
 118 You may put any business logic initialization in BUILD methods. You don't
 119 need to redispatch or return any specific value.
 120
 121 =head2 C<< DEMOLISHALL >>
 122
 123 Calls C<DEMOLISH> on each class in the class hierarchy. This is called at
 124 C<DESTROY> time.
 125
 126 =head2 C<< DEMOLISH >>
 127
 128 You may put any business logic deinitialization in DEMOLISH methods. You don't
 129 need to redispatch or return any specific value.
 130
 131
 132 =head2 C<< does ($role_name) -> Bool >>
 133
 134 This will check if the invocant's class B<does> a given C<$role_name>.
 135 This is similar to "isa" for object, but it checks the roles instead.
 136
 137 =head2 C<<dump ($maxdepth) -> Str >>
 138
 139 From the Moose POD:
 140
 141     C'mon, how many times have you written the following code while debugging:
 142
 143      use Data::Dumper;
 144      warn Dumper $obj;
 145
 146     It can get seriously annoying, so why not just use this.
 147
 148 The implementation was lifted directly from Moose::Object.
 149
 150 =head1 SEE ALSO
 151
 152 L<Moose::Object>
 153
 154 =cut
 155