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->meta->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 = Mouse::Util::get_code_ref($class, 'BUILD')
  55             || 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 = Mouse::Util::get_code_ref($class, 'DEMOLISH')
  75             || 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 VERSION
  91
  92 This document describes Mouse version 0.40_04
  93
  94 =head1 METHODS
  95
  96 =head2 C<< new (Arguments) -> Object >>
  97
  98 Instantiates a new C<Mouse::Object>. This is obviously intended for subclasses.
  99
 100 =head2 C<< BUILDARGS (Arguments) -> HashRef >>
 101
 102 Lets you override the arguments that C<new> takes. Return a hashref of
 103 parameters.
 104
 105 =head2 C<< BUILDALL (\%args) >>
 106
 107 Calls C<BUILD> on each class in the class hierarchy. This is called at the
 108 end of C<new>.
 109
 110 =head2 C<< BUILD (\%args) >>
 111
 112 You may put any business logic initialization in BUILD methods. You don't
 113 need to redispatch or return any specific value.
 114
 115 =head2 C<< DEMOLISHALL >>
 116
 117 Calls C<DEMOLISH> on each class in the class hierarchy. This is called at
 118 C<DESTROY> time.
 119
 120 =head2 C<< DEMOLISH >>
 121
 122 You may put any business logic deinitialization in DEMOLISH methods. You don't
 123 need to redispatch or return any specific value.
 124
 125
 126 =head2 C<< does ($role_name) -> Bool >>
 127
 128 This will check if the invocant's class B<does> a given C<$role_name>.
 129 This is similar to "isa" for object, but it checks the roles instead.
 130
 131 =head2 C<<dump ($maxdepth) -> Str >>
 132
 133 From the Moose POD:
 134
 135     C'mon, how many times have you written the following code while debugging:
 136
 137      use Data::Dumper;
 138      warn Dumper $obj;
 139
 140     It can get seriously annoying, so why not just use this.
 141
 142 The implementation was lifted directly from Moose::Object.
 143
 144 =head1 SEE ALSO
 145
 146 L<Moose::Object>
 147
 148 =cut
 149