t/lib/AccessorGroups.pm

   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
  13 package AccessorGroups;
  14 use strict;
  15 use warnings;
  16 use base 'Class::Accessor::Grouped';
  17 __PACKAGE__->mk_group_accessors('simple', 'singlefield');
  18 __PACKAGE__->mk_group_accessors('multiple', qw/multiple1 multiple2/);
  19 __PACKAGE__->mk_group_accessors('listref', [qw/lr1name lr1;field/], [qw/lr2name lr2'field/]);
  20 __PACKAGE__->mk_group_accessors('simple', 'runtime_around');
  21 __PACKAGE__->mk_group_accessors('simple', [ fieldname_torture => join ('', map { chr($_) } (0..255) ) ]);
  22
  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
  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
  60 sub new {
  61   return bless {}, shift;
  62 };
  63
  64 foreach (qw/multiple listref/) {
  65   no strict 'refs';
  66   *{"get_$_"} = __PACKAGE__->can('get_simple');
  67   *{"set_$_"} = __PACKAGE__->can('set_simple');
  68 };
  69
  70 1;