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