| File | /usr/local/lib/perl5/site_perl/5.10.1/Class/Data/Inheritable.pm |
| Statements Executed | 44 |
| Statement Execution Time | 9.52ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 4 | 4 | 1 | 62µs | 62µs | Class::Data::Inheritable::mk_classdata |
| 1 | 1 | 1 | 22µs | 34µs | Class::Data::Inheritable::BEGIN@3 |
| 3 | 3 | 1 | 11µs | 11µs | Class::Data::Inheritable::__ANON__[:23] |
| 1 | 1 | 1 | 6µs | 24µs | Class::Data::Inheritable::BEGIN@4 |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Class::Data::Inheritable; | ||||
| 2 | |||||
| 3 | 3 | 24µs | 2 | 46µs | # spent 34µs (22+12) within Class::Data::Inheritable::BEGIN@3 which was called
# once (22µs+12µs) by Exception::Class::Base::BEGIN@8 at line 3 # spent 34µs making 1 call to Class::Data::Inheritable::BEGIN@3
# spent 12µs making 1 call to strict::import |
| 4 | 3 | 9.39ms | 2 | 42µs | # spent 24µs (6+18) within Class::Data::Inheritable::BEGIN@4 which was called
# once (6µs+18µs) by Exception::Class::Base::BEGIN@8 at line 4 # spent 24µs making 1 call to Class::Data::Inheritable::BEGIN@4
# spent 18µs making 1 call to vars::import |
| 5 | 1 | 3µs | $VERSION = '0.08'; | ||
| 6 | |||||
| 7 | # spent 62µs within Class::Data::Inheritable::mk_classdata which was called 4 times, avg 15µs/call:
# once (21µs+0s) by Exception::Class::Base::BEGIN@14 at line 16 of Exception/Class/Base.pm
# once (18µs+0s) by Exception::Class::Base::BEGIN@14 at line 15 of Exception/Class/Base.pm
# once (12µs+0s) by Exception::Class::Base::BEGIN@14 at line 19 of Exception/Class/Base.pm
# once (10µs+0s) by Exception::Class::Base::BEGIN@14 at line 22 of Exception/Class/Base.pm | ||||
| 8 | 24 | 73µs | my ($declaredclass, $attribute, $data) = @_; | ||
| 9 | |||||
| 10 | if( ref $declaredclass ) { | ||||
| 11 | require Carp; | ||||
| 12 | Carp::croak("mk_classdata() is a class method, not an object method"); | ||||
| 13 | } | ||||
| 14 | |||||
| 15 | # spent 11µs within Class::Data::Inheritable::__ANON__[/usr/local/lib/perl5/site_perl/5.10.1/Class/Data/Inheritable.pm:23] which was called 3 times, avg 4µs/call:
# once (5µs+0s) by Exception::Class::Base::BEGIN@14 at line 17 of Exception/Class/Base.pm
# once (3µs+0s) by Exception::Class::Base::BEGIN@14 at line 23 of Exception/Class/Base.pm
# once (3µs+0s) by Exception::Class::Base::BEGIN@14 at line 20 of Exception/Class/Base.pm | ||||
| 16 | 12 | 20µs | my $wantclass = ref($_[0]) || $_[0]; | ||
| 17 | |||||
| 18 | return $wantclass->mk_classdata($attribute)->(@_) | ||||
| 19 | if @_>1 && $wantclass ne $declaredclass; | ||||
| 20 | |||||
| 21 | $data = $_[1] if @_>1; | ||||
| 22 | return $data; | ||||
| 23 | }; | ||||
| 24 | |||||
| 25 | my $alias = "_${attribute}_accessor"; | ||||
| 26 | *{$declaredclass.'::'.$attribute} = $accessor; | ||||
| 27 | *{$declaredclass.'::'.$alias} = $accessor; | ||||
| 28 | } | ||||
| 29 | |||||
| 30 | 1 | 10µs | 1; | ||
| 31 | |||||
| 32 | __END__ | ||||
| 33 | |||||
| 34 | =head1 NAME | ||||
| 35 | |||||
| 36 | Class::Data::Inheritable - Inheritable, overridable class data | ||||
| 37 | |||||
| 38 | =head1 SYNOPSIS | ||||
| 39 | |||||
| 40 | package Stuff; | ||||
| 41 | use base qw(Class::Data::Inheritable); | ||||
| 42 | |||||
| 43 | # Set up DataFile as inheritable class data. | ||||
| 44 | Stuff->mk_classdata('DataFile'); | ||||
| 45 | |||||
| 46 | # Declare the location of the data file for this class. | ||||
| 47 | Stuff->DataFile('/etc/stuff/data'); | ||||
| 48 | |||||
| 49 | # Or, all in one shot: | ||||
| 50 | Stuff->mk_classdata(DataFile => '/etc/stuff/data'); | ||||
| 51 | |||||
| 52 | =head1 DESCRIPTION | ||||
| 53 | |||||
| 54 | Class::Data::Inheritable is for creating accessor/mutators to class | ||||
| 55 | data. That is, if you want to store something about your class as a | ||||
| 56 | whole (instead of about a single object). This data is then inherited | ||||
| 57 | by your subclasses and can be overriden. | ||||
| 58 | |||||
| 59 | For example: | ||||
| 60 | |||||
| 61 | Pere::Ubu->mk_classdata('Suitcase'); | ||||
| 62 | |||||
| 63 | will generate the method Suitcase() in the class Pere::Ubu. | ||||
| 64 | |||||
| 65 | This new method can be used to get and set a piece of class data. | ||||
| 66 | |||||
| 67 | Pere::Ubu->Suitcase('Red'); | ||||
| 68 | $suitcase = Pere::Ubu->Suitcase; | ||||
| 69 | |||||
| 70 | The interesting part happens when a class inherits from Pere::Ubu: | ||||
| 71 | |||||
| 72 | package Raygun; | ||||
| 73 | use base qw(Pere::Ubu); | ||||
| 74 | |||||
| 75 | # Raygun's suitcase is Red. | ||||
| 76 | $suitcase = Raygun->Suitcase; | ||||
| 77 | |||||
| 78 | Raygun inherits its Suitcase class data from Pere::Ubu. | ||||
| 79 | |||||
| 80 | Inheritance of class data works analogous to method inheritance. As | ||||
| 81 | long as Raygun does not "override" its inherited class data (by using | ||||
| 82 | Suitcase() to set a new value) it will continue to use whatever is set | ||||
| 83 | in Pere::Ubu and inherit further changes: | ||||
| 84 | |||||
| 85 | # Both Raygun's and Pere::Ubu's suitcases are now Blue | ||||
| 86 | Pere::Ubu->Suitcase('Blue'); | ||||
| 87 | |||||
| 88 | However, should Raygun decide to set its own Suitcase() it has now | ||||
| 89 | "overridden" Pere::Ubu and is on its own, just like if it had | ||||
| 90 | overriden a method: | ||||
| 91 | |||||
| 92 | # Raygun has an orange suitcase, Pere::Ubu's is still Blue. | ||||
| 93 | Raygun->Suitcase('Orange'); | ||||
| 94 | |||||
| 95 | Now that Raygun has overridden Pere::Ubu futher changes by Pere::Ubu | ||||
| 96 | no longer effect Raygun. | ||||
| 97 | |||||
| 98 | # Raygun still has an orange suitcase, but Pere::Ubu is using Samsonite. | ||||
| 99 | Pere::Ubu->Suitcase('Samsonite'); | ||||
| 100 | |||||
| 101 | =head1 Methods | ||||
| 102 | |||||
| 103 | =head2 mk_classdata | ||||
| 104 | |||||
| 105 | Class->mk_classdata($data_accessor_name); | ||||
| 106 | Class->mk_classdata($data_accessor_name => $value); | ||||
| 107 | |||||
| 108 | This is a class method used to declare new class data accessors. | ||||
| 109 | A new accessor will be created in the Class using the name from | ||||
| 110 | $data_accessor_name, and optionally initially setting it to the given | ||||
| 111 | value. | ||||
| 112 | |||||
| 113 | To facilitate overriding, mk_classdata creates an alias to the | ||||
| 114 | accessor, _field_accessor(). So Suitcase() would have an alias | ||||
| 115 | _Suitcase_accessor() that does the exact same thing as Suitcase(). | ||||
| 116 | This is useful if you want to alter the behavior of a single accessor | ||||
| 117 | yet still get the benefits of inheritable class data. For example. | ||||
| 118 | |||||
| 119 | sub Suitcase { | ||||
| 120 | my($self) = shift; | ||||
| 121 | warn "Fashion tragedy" if @_ and $_[0] eq 'Plaid'; | ||||
| 122 | |||||
| 123 | $self->_Suitcase_accessor(@_); | ||||
| 124 | } | ||||
| 125 | |||||
| 126 | =head1 AUTHOR | ||||
| 127 | |||||
| 128 | Original code by Damian Conway. | ||||
| 129 | |||||
| 130 | Maintained by Michael G Schwern until September 2005. | ||||
| 131 | |||||
| 132 | Now maintained by Tony Bowden. | ||||
| 133 | |||||
| 134 | =head1 BUGS and QUERIES | ||||
| 135 | |||||
| 136 | Please direct all correspondence regarding this module to: | ||||
| 137 | bug-Class-Data-Inheritable@rt.cpan.org | ||||
| 138 | |||||
| 139 | =head1 COPYRIGHT and LICENSE | ||||
| 140 | |||||
| 141 | Copyright (c) 2000-2005, Damian Conway and Michael G Schwern. | ||||
| 142 | All Rights Reserved. | ||||
| 143 | |||||
| 144 | This module is free software. It may be used, redistributed and/or | ||||
| 145 | modified under the same terms as Perl itself. | ||||
| 146 | |||||
| 147 | =head1 SEE ALSO | ||||
| 148 | |||||
| 149 | L<perltooc> has a very elaborate discussion of class data in Perl. | ||||
| 150 |