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