| File | /usr/local/lib/perl/5.10.0/Class/MOP/Class/Immutable/Trait.pm |
| Statements Executed | 2035 |
| Total Time | 0.0037684 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 28 | 1 | 1 | 176µs | 176µs | Class::MOP::Class::Immutable::Trait::_get_mutable_metaclass_name |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Class::Immutable::Trait::BEGIN |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Class::Immutable::Trait::__ANON__[:37] |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Class::Immutable::Trait::_immutable_cannot_call |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Class::Immutable::Trait::_immutable_metaclass |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Class::Immutable::Trait::_method_map |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Class::Immutable::Trait::add_package_symbol |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Class::Immutable::Trait::class_precedence_list |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Class::Immutable::Trait::get_all_attributes |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Class::Immutable::Trait::get_all_method_names |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Class::Immutable::Trait::get_all_methods |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Class::Immutable::Trait::get_meta_instance |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Class::Immutable::Trait::is_immutable |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Class::Immutable::Trait::is_mutable |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Class::Immutable::Trait::linearized_isa |
| 0 | 0 | 0 | 0s | 0s | Class::MOP::Class::Immutable::Trait::superclasses |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | package Class::MOP::Class::Immutable::Trait; | |||
| 2 | ||||
| 3 | 3 | 29µs | 10µs | use strict; # spent 8µs making 1 call to strict::import |
| 4 | 3 | 34µs | 11µs | use warnings; # spent 24µs making 1 call to warnings::import |
| 5 | ||||
| 6 | 3 | 26µs | 9µs | use MRO::Compat; # spent 4µs making 1 call to import |
| 7 | ||||
| 8 | 3 | 27µs | 9µs | use Carp 'confess'; # spent 47µs making 1 call to Exporter::import |
| 9 | 3 | 262µs | 87µs | use Scalar::Util 'blessed', 'weaken'; # spent 46µs making 1 call to Exporter::import |
| 10 | ||||
| 11 | 1 | 900ns | 900ns | our $VERSION = '1.09'; |
| 12 | 1 | 25µs | 25µs | $VERSION = eval $VERSION; |
| 13 | 1 | 600ns | 600ns | our $AUTHORITY = 'cpan:STEVAN'; |
| 14 | ||||
| 15 | # the original class of the metaclass instance | |||
| 16 | 28 | 95µs | 3µs | # spent 176µs within Class::MOP::Class::Immutable::Trait::_get_mutable_metaclass_name which was called 28 times, avg 6µs/call:
# 28 times (176µs+0s) by Class::MOP::Class::_real_ref_name at line 122 of /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm, avg 6µs/call |
| 17 | ||||
| 18 | sub is_mutable { 0 } | |||
| 19 | 28 | 35µs | 1µs | sub is_immutable { 1 } |
| 20 | ||||
| 21 | sub _immutable_metaclass { ref $_[1] } | |||
| 22 | ||||
| 23 | sub superclasses { | |||
| 24 | my $orig = shift; | |||
| 25 | my $self = shift; | |||
| 26 | confess "This method is read-only" if @_; | |||
| 27 | $self->$orig; | |||
| 28 | } | |||
| 29 | ||||
| 30 | sub _immutable_cannot_call { | |||
| 31 | my $name = shift; | |||
| 32 | Carp::confess "The '$name' method cannot be called on an immutable instance"; | |||
| 33 | } | |||
| 34 | ||||
| 35 | 1 | 1µs | 1µs | for my $name (qw/add_method alias_method remove_method add_attribute remove_attribute remove_package_symbol/) { |
| 36 | 3 | 488µs | 163µs | no strict 'refs'; # spent 23µs making 1 call to strict::unimport |
| 37 | 6 | 46µs | 8µs | *{__PACKAGE__."::$name"} = sub { _immutable_cannot_call($name) }; |
| 38 | } | |||
| 39 | ||||
| 40 | sub class_precedence_list { | |||
| 41 | my $orig = shift; | |||
| 42 | my $self = shift; | |||
| 43 | @{ $self->{__immutable}{class_precedence_list} | |||
| 44 | ||= [ $self->$orig ] }; | |||
| 45 | } | |||
| 46 | ||||
| 47 | sub linearized_isa { | |||
| 48 | 77 | 40µs | 513ns | my $orig = shift; |
| 49 | 77 | 28µs | 368ns | my $self = shift; |
| 50 | 77 | 436µs | 6µs | @{ $self->{__immutable}{linearized_isa} ||= [ $self->$orig ] }; # spent 235µs making 17 calls to Class::MOP::Class::linearized_isa, avg 14µs/call |
| 51 | } | |||
| 52 | ||||
| 53 | sub get_all_methods { | |||
| 54 | my $orig = shift; | |||
| 55 | my $self = shift; | |||
| 56 | @{ $self->{__immutable}{get_all_methods} ||= [ $self->$orig ] }; | |||
| 57 | } | |||
| 58 | ||||
| 59 | sub get_all_method_names { | |||
| 60 | my $orig = shift; | |||
| 61 | my $self = shift; | |||
| 62 | @{ $self->{__immutable}{get_all_method_names} ||= [ $self->$orig ] }; | |||
| 63 | } | |||
| 64 | ||||
| 65 | sub get_all_attributes { | |||
| 66 | 47 | 28µs | 596ns | my $orig = shift; |
| 67 | 47 | 22µs | 460ns | my $self = shift; |
| 68 | 47 | 256µs | 5µs | @{ $self->{__immutable}{get_all_attributes} ||= [ $self->$orig ] }; # spent 1.81ms making 15 calls to Class::MOP::Class::get_all_attributes, avg 120µs/call |
| 69 | } | |||
| 70 | ||||
| 71 | sub get_meta_instance { | |||
| 72 | 267 | 115µs | 432ns | my $orig = shift; |
| 73 | 267 | 82µs | 308ns | my $self = shift; |
| 74 | 267 | 694µs | 3µs | $self->{__immutable}{get_meta_instance} ||= $self->$orig; # spent 3.21ms making 22 calls to Class::MOP::Class::get_meta_instance, avg 146µs/call |
| 75 | } | |||
| 76 | ||||
| 77 | sub _method_map { | |||
| 78 | 259 | 118µs | 454ns | my $orig = shift; |
| 79 | 259 | 129µs | 497ns | my $self = shift; |
| 80 | 259 | 744µs | 3µs | $self->{__immutable}{_method_map} ||= $self->$orig; # spent 83µs making 20 calls to Class::MOP::Mixin::HasMethods::_method_map, avg 4µs/call |
| 81 | } | |||
| 82 | ||||
| 83 | sub add_package_symbol { | |||
| 84 | my $orig = shift; | |||
| 85 | my $self = shift; | |||
| 86 | confess "Cannot add package symbols to an immutable metaclass" | |||
| 87 | unless ( caller(3) )[3] eq 'Class::MOP::Package::get_package_symbol'; | |||
| 88 | ||||
| 89 | $self->$orig(@_); | |||
| 90 | } | |||
| 91 | ||||
| 92 | 1 | 7µs | 7µs | 1; |
| 93 | ||||
| 94 | __END__ | |||
| 95 | ||||
| 96 | =pod | |||
| 97 | ||||
| 98 | =head1 NAME | |||
| 99 | ||||
| 100 | Class::MOP::Class::Immutable::Trait - Implements immutability for metaclass objects | |||
| 101 | ||||
| 102 | =head1 DESCRIPTION | |||
| 103 | ||||
| 104 | This class provides a pseudo-trait that is applied to immutable metaclass | |||
| 105 | objects. In reality, it is simply a parent class. | |||
| 106 | ||||
| 107 | It implements caching and read-only-ness for various metaclass methods. | |||
| 108 | ||||
| 109 | =head1 AUTHOR | |||
| 110 | ||||
| 111 | Yuval Kogman E<lt>nothingmuch@cpan.orgE<gt> | |||
| 112 | ||||
| 113 | =head1 COPYRIGHT AND LICENSE | |||
| 114 | ||||
| 115 | Copyright 2009 by Infinity Interactive, Inc. | |||
| 116 | ||||
| 117 | L<http://www.iinteractive.com> | |||
| 118 | ||||
| 119 | This library is free software; you can redistribute it and/or modify | |||
| 120 | it under the same terms as Perl itself. | |||
| 121 | ||||
| 122 | =cut | |||
| 123 |