package Hash::Pretender; use overload '%{}' => \&get_hashref; use Class::Std; { my %attr1_of :ATTR( :get :set ); my %attr2_of :ATTR; sub get_hashref { my $self = shift; tie my %h, ref $self, $self; return \%h; } sub get_attr2 { return ++$attr2_of{ ident shift }; } sub TIEHASH { my ( $package, $self ) = @_; return $self; } sub STORE { my ($self, $key, $value) = @_; my $setter = "set_$key"; $self->$setter( $value ); } sub FETCH { my ($self, $key) = @_; my $getter = "get_$key"; return $self->$getter(); } } package main; use Test::More 'tests' => 11; my $o = Hash::Pretender->new(); isa_ok( $o, 'Hash::Pretender' ); $o->set_attr1( 'foo' ); is( $o->get_attr1(), 'foo', 'attr1 is "foo" via get_attr1' ); is( $o->{attr1}, 'foo', 'attr1 is "foo" via hash dereference' ); SKIP: { skip 'Not implemented', 1 unless ( $o->can('FIRSTKEY') && $o->can('NEXTKEY') ); %h = %{$o}; is( $h{attr1}, 'foo', 'attr1 is "foo" via hash copy' ); }; $o->{attr1} = 'bar'; is( $o->get_attr1(), 'bar', 'attr1 is "bar" via get_attr1' ); is( $o->{attr1}, 'bar', 'attr1 is "bar" via hash dereference' ); SKIP: { skip 'Not implemented', 1 unless ( $o->can('FIRSTKEY') && $o->can('NEXTKEY') ); %h = %{$o}; is( $h{attr1}, 'bar', 'attr1 is "bar" via hash copy' ); }; is( $o->get_attr2(), 1, 'attr2 is 1' ); is( $o->{attr2}, 2, 'attr2 is 2' ); ok( ! eval { $o->{attr2} = 3; 1 }, 'Set attr2 fails' ); my $err = $@; my $msg = q{Can't locate object method "set_attr2" via package "Hash::Pretender"}; is( substr( $err, 0, length $msg), $msg, 'Set attr2 fails for the expected reason' );