lib/Mouse/Object.pm

   1 package Mouse::Object;
   2 use strict;
   3 use warnings;
   4
   5 use Mouse::Util;
   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 sub dump {
  70     my($self, $maxdepth) = @_;
  71
  72     require 'Data/Dumper.pm'; # we don't want to create its namespace
  73     my $dd = Data::Dumper->new([$self]);
  74     $dd->Maxdepth(defined($maxdepth) ? $maxdepth : 2);
  75     $dd->Indent(1);
  76     return $dd->Dump();
  77 }
  78
  79
  80 sub does {
  81     my ($self, $role_name) = @_;
  82     (defined $role_name)
  83         || $self->meta->throw_error("You must supply a role name to does()");
  84
  85     return $self->meta->does_role($role_name);
  86 };
  87
  88 1;
  89
  90 __END__
  91
  92 =head1 NAME
  93
  94 Mouse::Object - we don't need to steenkin' constructor
  95
  96 =head1 METHODS
  97
  98 =head2 new arguments -> object
  99
 100 Instantiates a new Mouse::Object. This is obviously intended for subclasses.
 101
 102 =head2 BUILDALL \%args
 103
 104 Calls L</BUILD> on each class in the class hierarchy. This is called at the
 105 end of L</new>.
 106
 107 =head2 BUILD \%args
 108
 109 You may put any business logic initialization in BUILD methods. You don't
 110 need to redispatch or return any specific value.
 111
 112 =head2 BUILDARGS
 113
 114 Lets you override the arguments that C<new> takes. Return a hashref of
 115 parameters.
 116
 117 =head2 DEMOLISHALL
 118
 119 Calls L</DEMOLISH> on each class in the class hierarchy. This is called at
 120 L</DESTROY> time.
 121
 122 =head2 DEMOLISH
 123
 124 You may put any business logic deinitialization in DEMOLISH methods. You don't
 125 need to redispatch or return any specific value.
 126
 127
 128 =head2 does $role_name
 129
 130 This will check if the invocant's class "does" a given C<$role_name>.
 131 This is similar to "isa" for object, but it checks the roles instead.
 132
 133
 134 =head2 B<dump ($maxdepth)>
 135
 136 From the Moose POD:
 137
 138     C'mon, how many times have you written the following code while debugging:
 139
 140      use Data::Dumper;
 141      warn Dumper $obj;
 142
 143     It can get seriously annoying, so why not just use this.
 144
 145 The implementation was lifted directly from Moose::Object.
 146
 147 =cut
 148
 149