| Subject: | cannot access parent RESTRICTED methods from child BUILD |
In this example, TestApp::DB is a child of Object::POOF::DB. TestApp::DB::BUILD() wants to set default values for dbname, dbhost etc. which are attribute properties of Object::POOF::DB, if they are not already set. That way, I can override the default values with TestApp::DB->new({ dbhost => 'devdb' }) if I am on the development server, for instance, but if I don't specify them they will use the defaults. But Object::POOF::DB won't know any defaults. I tried putting an AUTOMETHOD : RESTRICTED in Object::POOF::DB for getting/setting the values - because only the child TestApp::DB should be able to get or set them. But the child BUILD is apparently called from class Class::Std through some kind of wrapping...
markle@tomato:~/src/cvs/Object-POOF/t$ prove 10.modules/10.db.t
10.modules/10.db....ok 1/0# Testing Object::POOF::DB 0.0.1
Can't call restricted method Object::POOF::DB::AUTOMETHOD() from class Class::Std at testlib/TestApp/DB.pm line 19
# Looks like your test died just after 3.
10.modules/10.db....dubious
The die line in 10.db.t is "my $db = TestApp::DB->new();".
package TestApp::DB;
use strict;
use warnings;
use Carp qw(cluck);
use Object::POOF::Constants;
use Class::Std;
use base qw( Object::POOF::DB );
{
sub BUILD {
my ($self, $ident, $arg_ref) = @_;
# set defaults if not set in constructor
$self->get_dbname or $self->set_dbname('test');
$self->get_dbhost or $self->set_dbhost('localhost');
$self->get_dbuname or $self->set_dbuname($EMPTY_STR);
$self->get_dbpass or $self->set_dbpass($EMPTY_STR);
}
}
1;
##########
package Object::POOF::DB;
use version; $VERSION = qv('0.0.1');
use warnings;
use strict;
use Carp qw(cluck);
use DBI;
use Class::Std;
use Switch 'Perl6';
# Module implementation here
{
my (
%dbname_of, %dbhost_of, %dbuname_of, %dbpass_of,
) :ATTRS;
sub BUILD {
my ($self, $ident, $arg_ref) = @_;
# set optional constructor values:
if ($arg_ref->{dbname}) {
$self->set_dbname( $arg_ref->{dbname} );
}
if ($arg_ref->{dbhost}) {
$self->set_dbhost( $arg_ref->{dbhost} );
}
if ($arg_ref->{dbuname}) {
$self->set_dbuname( $arg_ref->{dbuname} );
}
if ($arg_ref->{dbpass}) {
$self->set_dbpass( $arg_ref->{dbpass} );
}
}
sub AUTOMETHOD : RESTRICTED {
my ($self, $ident, $value) = @_;
my $subname = $_; # subname passed via $_
# return failure if not get_something or set_something
my ($mode, $name) = $subname =~ m/\A ([gs]et)_(.*) \z/xms
or return;
# if get, return a sub that gives the value
if ($mode eq 'get') {
given ($name) {
when 'dbname' { return sub { return $dbname_of{$ident}; }; }
when 'dbhost' { return sub { return $dbhost_of{$ident}; }; }
when 'dbuname' { return sub { return $dbuname_of{$ident}; }; }
when 'dbpass' { return sub { return $dbpass_of{$ident}; }; }
default { return; }
}
}
# if set, return a sub that sets the value
elsif ($mode eq 'set') {
given ($name) {
when 'dbname' { return sub { $dbname_of{$ident} = $value; }; }
when 'dbhost' { return sub { $dbhost_of{$ident} = $value; }; }
when 'dbuname' { return sub { $dbuname_of{$ident} = $value; }; }
when 'dbpass' { return sub { $dbpass_of{$ident} = $value; }; }
default { return; }
}
}
return; # for posterity
}
}
1;