| File | /usr/local/lib/perl/5.10.0/metaclass.pm |
| Statements Executed | 243 |
| Total Time | 0.0011395 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 19 | 19 | 19 | 544µs | 16.2ms | metaclass::import |
| 0 | 0 | 0 | 0s | 0s | metaclass::BEGIN |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | ||||
| 2 | package metaclass; | |||
| 3 | ||||
| 4 | 3 | 23µs | 8µs | use strict; # spent 7µs making 1 call to strict::import |
| 5 | 3 | 34µs | 11µs | use warnings; # spent 21µs making 1 call to warnings::import |
| 6 | ||||
| 7 | 3 | 33µs | 11µs | use Carp 'confess'; # spent 51µs making 1 call to Exporter::import |
| 8 | 3 | 30µs | 10µs | use Scalar::Util 'blessed'; # spent 35µs making 1 call to Exporter::import |
| 9 | 3 | 59µs | 20µs | use Try::Tiny; # spent 48µs making 1 call to Exporter::import |
| 10 | ||||
| 11 | 1 | 800ns | 800ns | our $VERSION = '1.09'; |
| 12 | 1 | 22µs | 22µs | $VERSION = eval $VERSION; |
| 13 | 1 | 600ns | 600ns | our $AUTHORITY = 'cpan:STEVAN'; |
| 14 | ||||
| 15 | 3 | 242µs | 81µs | use Class::MOP; # spent 3µs making 1 call to import |
| 16 | ||||
| 17 | # spent 16.2ms (544µs+15.7) within metaclass::import which was called 19 times, avg 855µs/call:
# once (23µs+989µs) at line 6 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint.pm
# once (29µs+967µs) at line 5 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Composite.pm
# once (29µs+917µs) at line 6 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeCoercion.pm
# once (26µs+833µs) at line 5 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Parameterized.pm
# once (30µs+826µs) at line 5 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/DuckType.pm
# once (29µs+823µs) at line 6 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeCoercion/Union.pm
# once (24µs+826µs) by Moose::Meta::Role::Application::BEGIN at line 5 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Application.pm
# once (39µs+804µs) at line 5 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Application/ToInstance.pm
# once (31µs+812µs) at line 6 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role.pm
# once (32µs+803µs) at line 5 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Enum.pm
# once (31µs+799µs) at line 5 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Application/RoleSummation.pm
# once (32µs+795µs) at line 5 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Application/ToClass.pm
# once (30µs+795µs) at line 5 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Role.pm
# once (31µs+788µs) at line 6 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Registry.pm
# once (25µs+791µs) at line 5 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Class.pm
# once (23µs+790µs) at line 6 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Method/Required.pm
# once (25µs+787µs) at line 5 of /usr/local/lib/perl/5.10.0/Moose/Meta/Role/Application/ToRole.pm
# once (29µs+783µs) at line 5 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Parameterizable.pm
# once (27µs+763µs) at line 6 of /usr/local/lib/perl/5.10.0/Moose/Meta/TypeConstraint/Union.pm | |||
| 18 | 221 | 691µs | 3µs | my ( $class, @args ) = @_; |
| 19 | ||||
| 20 | unshift @args, "metaclass" if @args % 2 == 1; | |||
| 21 | my %options = @args; | |||
| 22 | ||||
| 23 | my $meta_name = exists $options{meta_name} ? $options{meta_name} : 'meta'; | |||
| 24 | my $metaclass = delete $options{metaclass}; | |||
| 25 | ||||
| 26 | unless ( defined $metaclass ) { | |||
| 27 | $metaclass = "Class::MOP::Class"; | |||
| 28 | } else { | |||
| 29 | Class::MOP::load_class($metaclass); # spent 72µs making 1 call to Class::MOP::load_class | |||
| 30 | } | |||
| 31 | ||||
| 32 | ($metaclass->isa('Class::MOP::Class')) # spent 95µs making 20 calls to UNIVERSAL::isa, avg 5µs/call | |||
| 33 | || confess "The metaclass ($metaclass) must be derived from Class::MOP::Class"; | |||
| 34 | ||||
| 35 | # make sure the custom metaclasses get loaded | |||
| 36 | foreach my $key (grep { /_(?:meta)?class$/ } keys %options) { | |||
| 37 | unless ( ref( my $class = $options{$key} ) ) { | |||
| 38 | Class::MOP::load_class($class) | |||
| 39 | } | |||
| 40 | } | |||
| 41 | ||||
| 42 | my $package = caller(); | |||
| 43 | ||||
| 44 | # create a meta object so we can install &meta | |||
| 45 | my $meta = $metaclass->initialize($package => %options); # spent 3.48ms making 19 calls to Class::MOP::Class::initialize, avg 183µs/call
# spent 1.85ms making 1 call to Moose::Meta::Class::initialize | |||
| 46 | $meta->_add_meta_method($meta_name) # spent 14.3ms making 20 calls to Class::MOP::Mixin::HasMethods::_add_meta_method, avg 715µs/call | |||
| 47 | if defined $meta_name; | |||
| 48 | } | |||
| 49 | ||||
| 50 | 1 | 4µs | 4µs | 1; |
| 51 | ||||
| 52 | __END__ | |||
| 53 | ||||
| 54 | =pod | |||
| 55 | ||||
| 56 | =head1 NAME | |||
| 57 | ||||
| 58 | metaclass - a pragma for installing and using Class::MOP metaclasses | |||
| 59 | ||||
| 60 | =head1 SYNOPSIS | |||
| 61 | ||||
| 62 | package MyClass; | |||
| 63 | ||||
| 64 | # use Class::MOP::Class | |||
| 65 | use metaclass; | |||
| 66 | ||||
| 67 | # ... or use a custom metaclass | |||
| 68 | use metaclass 'MyMetaClass'; | |||
| 69 | ||||
| 70 | # ... or use a custom metaclass | |||
| 71 | # and custom attribute and method | |||
| 72 | # metaclasses | |||
| 73 | use metaclass 'MyMetaClass' => ( | |||
| 74 | 'attribute_metaclass' => 'MyAttributeMetaClass', | |||
| 75 | 'method_metaclass' => 'MyMethodMetaClass', | |||
| 76 | ); | |||
| 77 | ||||
| 78 | # ... or just specify custom attribute | |||
| 79 | # and method classes, and Class::MOP::Class | |||
| 80 | # is the assumed metaclass | |||
| 81 | use metaclass ( | |||
| 82 | 'attribute_metaclass' => 'MyAttributeMetaClass', | |||
| 83 | 'method_metaclass' => 'MyMethodMetaClass', | |||
| 84 | ); | |||
| 85 | ||||
| 86 | # if we'd rather not install a 'meta' method, we can do this | |||
| 87 | use metaclass meta_name => undef; | |||
| 88 | # or if we'd like it to have a different name, | |||
| 89 | use metaclass meta_name => 'my_meta'; | |||
| 90 | ||||
| 91 | =head1 DESCRIPTION | |||
| 92 | ||||
| 93 | This is a pragma to make it easier to use a specific metaclass | |||
| 94 | and a set of custom attribute and method metaclasses. It also | |||
| 95 | installs a C<meta> method to your class as well, unless C<undef> | |||
| 96 | is passed to the C<meta_name> option. | |||
| 97 | ||||
| 98 | =head1 AUTHORS | |||
| 99 | ||||
| 100 | Stevan Little E<lt>stevan@iinteractive.comE<gt> | |||
| 101 | ||||
| 102 | =head1 COPYRIGHT AND LICENSE | |||
| 103 | ||||
| 104 | Copyright 2006-2010 by Infinity Interactive, Inc. | |||
| 105 | ||||
| 106 | L<http://www.iinteractive.com> | |||
| 107 | ||||
| 108 | This library is free software; you can redistribute it and/or modify | |||
| 109 | it under the same terms as Perl itself. | |||
| 110 | ||||
| 111 | =cut |