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 | _get_mutable_metaclass_name | Class::MOP::Class::Immutable::Trait::
0 | 0 | 0 | 0s | 0s | BEGIN | Class::MOP::Class::Immutable::Trait::
0 | 0 | 0 | 0s | 0s | __ANON__[:37] | Class::MOP::Class::Immutable::Trait::
0 | 0 | 0 | 0s | 0s | _immutable_cannot_call | Class::MOP::Class::Immutable::Trait::
0 | 0 | 0 | 0s | 0s | _immutable_metaclass | Class::MOP::Class::Immutable::Trait::
0 | 0 | 0 | 0s | 0s | _method_map | Class::MOP::Class::Immutable::Trait::
0 | 0 | 0 | 0s | 0s | add_package_symbol | Class::MOP::Class::Immutable::Trait::
0 | 0 | 0 | 0s | 0s | class_precedence_list | Class::MOP::Class::Immutable::Trait::
0 | 0 | 0 | 0s | 0s | get_all_attributes | Class::MOP::Class::Immutable::Trait::
0 | 0 | 0 | 0s | 0s | get_all_method_names | Class::MOP::Class::Immutable::Trait::
0 | 0 | 0 | 0s | 0s | get_all_methods | Class::MOP::Class::Immutable::Trait::
0 | 0 | 0 | 0s | 0s | get_meta_instance | Class::MOP::Class::Immutable::Trait::
0 | 0 | 0 | 0s | 0s | is_immutable | Class::MOP::Class::Immutable::Trait::
0 | 0 | 0 | 0s | 0s | is_mutable | Class::MOP::Class::Immutable::Trait::
0 | 0 | 0 | 0s | 0s | linearized_isa | Class::MOP::Class::Immutable::Trait::
0 | 0 | 0 | 0s | 0s | superclasses | Class::MOP::Class::Immutable::Trait::
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 | 231 | 504µs | 2µs | my $orig = shift; |
49 | my $self = shift; | |||
50 | @{ $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 | 141 | 306µs | 2µs | my $orig = shift; |
67 | my $self = shift; | |||
68 | @{ $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 | 801 | 892µs | 1µs | my $orig = shift; |
73 | my $self = shift; | |||
74 | $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 | 777 | 990µs | 1µs | my $orig = shift; |
79 | my $self = shift; | |||
80 | $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 |