1use Test::More 'no_plan'; 2 3package Object::POOF::DB; 4 5use warnings; 6use strict; 7use Carp qw(cluck); 8use Class::Std; 9 10# Module implementation here 11{ 12 my %dbname_of :ATTR; 13 14 sub BUILD { 15 my ($self, $ident, $arg_ref) = @_; 16 17 # set optional constructor values: 18 if ($arg_ref->{dbname}) { 19 $self->set_dbname( $arg_ref->{dbname} ); 20 } 21 } 22 23 sub AUTOMETHOD : RESTRICTED { 24 my ($self, $ident, $value) = @_; 25 26 my $subname = $_; # subname passed via $_ 27 28 # return failure if not get_something or set_something 29 my ($mode, $name) = $subname =~ m/\A ([gs]et)_(.*) \z/xms 30 or return; 31 32 # if get, return a sub that gives the value 33 if ($mode eq 'get') { 34 if ($name eq 'dbname') { return sub { return $dbname_of{$ident} } } 35 } 36 # if set, return a sub that sets the value 37 elsif ($mode eq 'set') { 38 if ($name eq 'dbname') { return sub { $dbname_of{$ident} = $value }} 39 } 40 return; # for posterity 41 } 42} 43 44 45package TestApp::DB; 46use Class::Std; 47use base qw( Object::POOF::DB ); 48{ 49 sub BUILD { 50 my ($self, $ident, $arg_ref) = @_; 51 52 # set defaults if not set in constructor 53 $self->get_dbname or $self->set_dbname('test'); 54 } 55 56 sub verify { 57 my ($self) = @_; 58 ::is $self->get_dbname(), 'test' => 'Restricted AUTOMETHOD ok'; 59 } 60} 61 62package main; 63 64my $obj = TestApp::DB->new(); 65 66$obj->verify(); 67 68ok !eval { $obj->get_dbname() } => 'Restricted AUTOMETHOD inaccessible'; 69like $@, qr/Can't call restricted/ => 'Restricted AUTOMETHOD error msg'; 70 71 72 73