| File | /usr/local/lib/perl/5.10.0/Moose/Object.pm |
| Statements Executed | 40 |
| Total Time | 0.0014742 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 0 | 0 | 0 | 0s | 0s | Moose::Object::BEGIN |
| 0 | 0 | 0 | 0s | 0s | Moose::Object::BUILDALL |
| 0 | 0 | 0 | 0s | 0s | Moose::Object::BUILDARGS |
| 0 | 0 | 0 | 0s | 0s | Moose::Object::DEMOLISHALL |
| 0 | 0 | 0 | 0s | 0s | Moose::Object::DESTROY |
| 0 | 0 | 0 | 0s | 0s | Moose::Object::__ANON__[:101] |
| 0 | 0 | 0 | 0s | 0s | Moose::Object::__ANON__[:95] |
| 0 | 0 | 0 | 0s | 0s | Moose::Object::does |
| 0 | 0 | 0 | 0s | 0s | Moose::Object::dump |
| 0 | 0 | 0 | 0s | 0s | Moose::Object::new |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | ||||
| 2 | package Moose::Object; | |||
| 3 | ||||
| 4 | 3 | 25µs | 8µs | use strict; # spent 8µs making 1 call to strict::import |
| 5 | 3 | 27µs | 9µs | use warnings; # spent 27µs making 1 call to warnings::import |
| 6 | ||||
| 7 | 3 | 20µs | 6µs | use Devel::GlobalDestruction (); |
| 8 | 3 | 14µs | 5µs | use MRO::Compat (); |
| 9 | 3 | 19µs | 6µs | use Scalar::Util (); |
| 10 | 3 | 47µs | 16µs | use Try::Tiny (); |
| 11 | ||||
| 12 | 3 | 361µs | 120µs | use if ( not our $__mx_is_compiled ), 'Moose::Meta::Class'; # spent 14µs making 1 call to if::import |
| 13 | 3 | 224µs | 75µs | use if ( not our $__mx_is_compiled ), metaclass => 'Moose::Meta::Class'; # spent 9µs making 1 call to if::import |
| 14 | ||||
| 15 | 1 | 900ns | 900ns | our $VERSION = '1.15'; |
| 16 | 1 | 22µs | 22µs | $VERSION = eval $VERSION; |
| 17 | 1 | 600ns | 600ns | our $AUTHORITY = 'cpan:STEVAN'; |
| 18 | ||||
| 19 | sub new { | |||
| 20 | my $class = shift; | |||
| 21 | my $real_class = Scalar::Util::blessed($class) || $class; | |||
| 22 | ||||
| 23 | my $params = $real_class->BUILDARGS(@_); | |||
| 24 | ||||
| 25 | return Class::MOP::Class->initialize($real_class)->new_object($params); | |||
| 26 | } | |||
| 27 | ||||
| 28 | sub BUILDARGS { | |||
| 29 | my $class = shift; | |||
| 30 | if ( scalar @_ == 1 ) { | |||
| 31 | unless ( defined $_[0] && ref $_[0] eq 'HASH' ) { | |||
| 32 | Class::MOP::class_of($class)->throw_error( | |||
| 33 | "Single parameters to new() must be a HASH ref", | |||
| 34 | data => $_[0] ); | |||
| 35 | } | |||
| 36 | return { %{ $_[0] } }; | |||
| 37 | } | |||
| 38 | else { | |||
| 39 | if ( @_ % 2 ) { | |||
| 40 | 3 | 241µs | 80µs | use YAML; # spent 63µs making 1 call to Exporter::import |
| 41 | print "NON !!!", Dump(\@_); | |||
| 42 | exit; | |||
| 43 | } | |||
| 44 | return {@_}; | |||
| 45 | } | |||
| 46 | } | |||
| 47 | ||||
| 48 | sub BUILDALL { | |||
| 49 | # NOTE: we ask Perl if we even | |||
| 50 | # need to do this first, to avoid | |||
| 51 | # extra meta level calls | |||
| 52 | return unless $_[0]->can('BUILD'); | |||
| 53 | my ($self, $params) = @_; | |||
| 54 | foreach my $method (reverse Class::MOP::class_of($self)->find_all_methods_by_name('BUILD')) { | |||
| 55 | $method->{code}->execute($self, $params); | |||
| 56 | } | |||
| 57 | } | |||
| 58 | ||||
| 59 | sub DEMOLISHALL { | |||
| 60 | my $self = shift; | |||
| 61 | my ($in_global_destruction) = @_; | |||
| 62 | ||||
| 63 | # NOTE: we ask Perl if we even | |||
| 64 | # need to do this first, to avoid | |||
| 65 | # extra meta level calls | |||
| 66 | return unless $self->can('DEMOLISH'); | |||
| 67 | ||||
| 68 | my @isa; | |||
| 69 | if ( my $meta = Class::MOP::class_of($self ) ) { | |||
| 70 | @isa = $meta->linearized_isa; | |||
| 71 | } else { | |||
| 72 | # We cannot count on being able to retrieve a previously made | |||
| 73 | # metaclass, _or_ being able to make a new one during global | |||
| 74 | # destruction. However, we should still be able to use mro at | |||
| 75 | # that time (at least tests suggest so ;) | |||
| 76 | my $class_name = ref $self; | |||
| 77 | @isa = @{ mro::get_linear_isa($class_name) } | |||
| 78 | } | |||
| 79 | ||||
| 80 | foreach my $class (@isa) { | |||
| 81 | 3 | 164µs | 55µs | no strict 'refs'; # spent 28µs making 1 call to strict::unimport |
| 82 | my $demolish = *{"${class}::DEMOLISH"}{CODE}; | |||
| 83 | $self->$demolish($in_global_destruction) | |||
| 84 | if defined $demolish; | |||
| 85 | } | |||
| 86 | } | |||
| 87 | ||||
| 88 | sub DESTROY { | |||
| 89 | my $self = shift; | |||
| 90 | ||||
| 91 | local $?; | |||
| 92 | ||||
| 93 | Try::Tiny::try { | |||
| 94 | $self->DEMOLISHALL(Devel::GlobalDestruction::in_global_destruction); | |||
| 95 | } | |||
| 96 | Try::Tiny::catch { | |||
| 97 | # Without this, Perl will warn "\t(in cleanup)$@" because of some | |||
| 98 | # bizarre fucked-up logic deep in the internals. | |||
| 99 | 3 | 87µs | 29µs | no warnings 'misc'; # spent 26µs making 1 call to warnings::unimport |
| 100 | die $_; | |||
| 101 | }; | |||
| 102 | ||||
| 103 | return; | |||
| 104 | } | |||
| 105 | ||||
| 106 | # support for UNIVERSAL::DOES ... | |||
| 107 | BEGIN { | |||
| 108 | 2 | 73µs | 36µs | my $does = UNIVERSAL->can("DOES") ? "SUPER::DOES" : "isa"; # spent 7µs making 1 call to UNIVERSAL::can |
| 109 | eval 'sub DOES { | |||
| 110 | my ( $self, $class_or_role_name ) = @_; | |||
| 111 | return $self->'.$does.'($class_or_role_name) | |||
| 112 | || $self->does($class_or_role_name); | |||
| 113 | }'; | |||
| 114 | 1 | 144µs | 144µs | } |
| 115 | ||||
| 116 | # new does() methods will be created | |||
| 117 | # as appropiate see Moose::Meta::Role | |||
| 118 | sub does { | |||
| 119 | my ($self, $role_name) = @_; | |||
| 120 | my $meta = Class::MOP::class_of($self); | |||
| 121 | (defined $role_name) | |||
| 122 | || $meta->throw_error("You must supply a role name to does()"); | |||
| 123 | return 1 if $meta->can('does_role') && $meta->does_role($role_name); | |||
| 124 | return 0; | |||
| 125 | } | |||
| 126 | ||||
| 127 | sub dump { | |||
| 128 | my $self = shift; | |||
| 129 | require Data::Dumper; | |||
| 130 | local $Data::Dumper::Maxdepth = shift if @_; | |||
| 131 | Data::Dumper::Dumper $self; | |||
| 132 | } | |||
| 133 | ||||
| 134 | 1 | 6µs | 6µs | 1; |
| 135 | ||||
| 136 | __END__ | |||
| 137 | ||||
| 138 | =pod | |||
| 139 | ||||
| 140 | =head1 NAME | |||
| 141 | ||||
| 142 | Moose::Object - The base object for Moose | |||
| 143 | ||||
| 144 | =head1 DESCRIPTION | |||
| 145 | ||||
| 146 | This class is the default base class for all Moose-using classes. When | |||
| 147 | you C<use Moose> in this class, your class will inherit from this | |||
| 148 | class. | |||
| 149 | ||||
| 150 | It provides a default constructor and destructor, which run the | |||
| 151 | C<BUILDALL> and C<DEMOLISHALL> methods respectively. | |||
| 152 | ||||
| 153 | You don't actually I<need> to inherit from this in order to use Moose, | |||
| 154 | but it makes it easier to take advantage of all of Moose's features. | |||
| 155 | ||||
| 156 | =head1 METHODS | |||
| 157 | ||||
| 158 | =over 4 | |||
| 159 | ||||
| 160 | =item B<< Moose::Object->new(%params) >> | |||
| 161 | ||||
| 162 | This method calls C<< $class->BUILDARGS(@_) >>, and then creates a new | |||
| 163 | instance of the appropriate class. Once the instance is created, it | |||
| 164 | calls C<< $instance->BUILDALL($params) >>. | |||
| 165 | ||||
| 166 | =item B<< Moose::Object->BUILDARGS(%params) >> | |||
| 167 | ||||
| 168 | The default implementation of this method accepts a hash or hash | |||
| 169 | reference of named parameters. If it receives a single argument that | |||
| 170 | I<isn't> a hash reference it throws an error. | |||
| 171 | ||||
| 172 | You can override this method in your class to handle other types of | |||
| 173 | options passed to the constructor. | |||
| 174 | ||||
| 175 | This method should always return a hash reference of named options. | |||
| 176 | ||||
| 177 | =item B<< $object->BUILDALL($params) >> | |||
| 178 | ||||
| 179 | This method will call every C<BUILD> method in the inheritance | |||
| 180 | hierarchy, starting with the most distant parent class and ending with | |||
| 181 | the object's class. | |||
| 182 | ||||
| 183 | The C<BUILD> method will be passed the hash reference returned by | |||
| 184 | C<BUILDARGS>. | |||
| 185 | ||||
| 186 | =item B<< $object->DEMOLISHALL >> | |||
| 187 | ||||
| 188 | This will call every C<DEMOLISH> method in the inheritance hierarchy, | |||
| 189 | starting with the object's class and ending with the most distant | |||
| 190 | parent. C<DEMOLISHALL> and C<DEMOLISH> will receive a boolean | |||
| 191 | indicating whether or not we are currently in global destruction. | |||
| 192 | ||||
| 193 | =item B<< $object->does($role_name) >> | |||
| 194 | ||||
| 195 | This returns true if the object does the given role. | |||
| 196 | ||||
| 197 | =item B<DOES ($class_or_role_name)> | |||
| 198 | ||||
| 199 | This is a a Moose role-aware implementation of L<UNIVERSAL/DOES>. | |||
| 200 | ||||
| 201 | This is effectively the same as writing: | |||
| 202 | ||||
| 203 | $object->does($name) || $object->isa($name) | |||
| 204 | ||||
| 205 | This method will work with Perl 5.8, which did not implement | |||
| 206 | C<UNIVERSAL::DOES>. | |||
| 207 | ||||
| 208 | =item B<< $object->dump($maxdepth) >> | |||
| 209 | ||||
| 210 | This is a handy utility for C<Data::Dumper>ing an object. By default, | |||
| 211 | the maximum depth is 1, to avoid making a mess. | |||
| 212 | ||||
| 213 | =back | |||
| 214 | ||||
| 215 | =head1 BUGS | |||
| 216 | ||||
| 217 | See L<Moose/BUGS> for details on reporting bugs. | |||
| 218 | ||||
| 219 | =head1 AUTHOR | |||
| 220 | ||||
| 221 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | |||
| 222 | ||||
| 223 | =head1 COPYRIGHT AND LICENSE | |||
| 224 | ||||
| 225 | Copyright 2006-2010 by Infinity Interactive, Inc. | |||
| 226 | ||||
| 227 | L<http://www.iinteractive.com> | |||
| 228 | ||||
| 229 | This library is free software; you can redistribute it and/or modify | |||
| 230 | it under the same terms as Perl itself. | |||
| 231 | ||||
| 232 | =cut |