| File: | local/lib/perl5/Class/Data/Inheritable.pm |
| Coverage: | 75.0% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package Class::Data::Inheritable; | |||||
| 2 | ||||||
| 3 | 6 6 6 | 13 3 96 | use strict qw(vars subs); | |||
| 4 | 6 6 6 | 10 6 708 | use vars qw($VERSION); | |||
| 5 | $VERSION = '0.08'; | |||||
| 6 | ||||||
| 7 | sub mk_classdata { | |||||
| 8 | 30 | 21 | my ($declaredclass, $attribute, $data) = @_; | |||
| 9 | ||||||
| 10 | 30 | 39 | if( ref $declaredclass ) { | |||
| 11 | 0 | 0 | require Carp; | |||
| 12 | 0 | 0 | Carp::croak("mk_classdata() is a class method, not an object method"); | |||
| 13 | } | |||||
| 14 | ||||||
| 15 | my $accessor = sub { | |||||
| 16 | 24 | 43 | my $wantclass = ref($_[0]) || $_[0]; | |||
| 17 | ||||||
| 18 | 24 | 62 | return $wantclass->mk_classdata($attribute)->(@_) | |||
| 19 | if @_>1 && $wantclass ne $declaredclass; | |||||
| 20 | ||||||
| 21 | 24 | 23 | $data = $_[1] if @_>1; | |||
| 22 | 24 | 191 | return $data; | |||
| 23 | 30 | 50 | }; | |||
| 24 | ||||||
| 25 | 30 | 30 | my $alias = "_${attribute}_accessor"; | |||
| 26 | 30 30 | 13 60 | *{$declaredclass.'::'.$attribute} = $accessor; | |||
| 27 | 30 30 | 18 66 | *{$declaredclass.'::'.$alias} = $accessor; | |||
| 28 | } | |||||
| 29 | ||||||
| 30 | 1; | |||||
| 31 | ||||||