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