lib/Mouse/Object.pm

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