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