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