Commit | Line | Data |
85ccab9a |
1 | { |
2 | package AccessorGroups::BeenThereDoneThat; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | use base 'Class::Accessor::Grouped'; |
7 | |
8 | __PACKAGE__->mk_group_accessors('simple', 'singlefield'); |
9 | __PACKAGE__->mk_group_accessors('multiple', qw/multiple1 multiple2/); |
10 | } |
11 | |
12 | |
e7d391a8 |
13 | package AccessorGroups; |
14 | use strict; |
15 | use warnings; |
16 | use base 'Class::Accessor::Grouped'; |
9540f4e4 |
17 | __PACKAGE__->mk_group_accessors('simple', 'singlefield'); |
28344104 |
18 | __PACKAGE__->mk_group_accessors('multiple', qw/multiple1 multiple2/); |
19 | __PACKAGE__->mk_group_accessors('listref', [qw/lr1name lr1;field/], [qw/lr2name lr2'field/]); |
de167379 |
20 | __PACKAGE__->mk_group_accessors('simple', 'runtime_around'); |
4d70ba11 |
21 | __PACKAGE__->mk_group_accessors('simple', [ fieldname_torture => join ('', map { chr($_) } (0..255) ) ]); |
e7d391a8 |
22 | |
fee7c68b |
23 | sub get_simple { |
24 | my $v = shift->SUPER::get_simple (@_); |
25 | $v =~ s/ Extra tackled on$// if $v; |
26 | $v; |
27 | } |
28 | |
29 | sub set_simple { |
30 | my ($self, $f, $v) = @_; |
31 | $v .= ' Extra tackled on' if $f eq 'singlefield'; |
32 | $self->SUPER::set_simple ($f, $v); |
33 | $_[2]; |
34 | } |
35 | |
de167379 |
36 | # a runtime Class::Method::Modifiers style around |
37 | # the eval/our combo is so that we do not need to rely on Sub::Name being available |
38 | my $orig_ra_cref = __PACKAGE__->can('runtime_around'); |
39 | our $around_cref = sub { |
40 | my $self = shift; |
41 | if (@_) { |
42 | my $val = shift; |
43 | $self->$orig_ra_cref($val . ' Extra tackled on'); |
44 | $val; |
45 | } |
46 | else { |
47 | my $val = $self->$orig_ra_cref; |
48 | $val =~ s/ Extra tackled on$// if defined $val; |
49 | $val; |
50 | } |
51 | }; |
52 | { |
53 | no warnings qw/redefine/; |
54 | eval <<'EOE'; |
55 | sub AccessorGroups::runtime_around { goto $AccessorGroups::around_cref }; |
56 | sub AccessorGroups::_runtime_around_accessor { goto $AccessorGroups::around_cref }; |
57 | EOE |
58 | } |
59 | |
e7d391a8 |
60 | sub new { |
ba8c183b |
61 | return bless {}, shift; |
e7d391a8 |
62 | }; |
63 | |
28344104 |
64 | foreach (qw/multiple listref/) { |
ba8c183b |
65 | no strict 'refs'; |
66 | *{"get_$_"} = __PACKAGE__->can('get_simple'); |
67 | *{"set_$_"} = __PACKAGE__->can('set_simple'); |
28344104 |
68 | }; |
69 | |
e7d391a8 |
70 | 1; |