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