Fellow Monks,
I hope somebody can steer me in the correct direction with this. I am trying to write a group of packages that inherit two methods (maybe more) from a base class. I arrived at this idea after noticing myself copying and pasting code into sub packages. These inherited methods are the constructor and an initialization method.
What is tripping me over is that I figured on having a description of what attributes and what type of child=>package relationship each package accepts, as part of the package definition. Sadly , I think it is my poor understanding of scope that is the true problem.
Below is some code that demonstrates how my misunderstanding unravels. Turning off strict refs in order to symboliclly address a $Some::Package::variable seems evil and I don't like it.
UPDATE:I think what I am really asking is, how might a method defined in package Guff , address a variable belonging to the package it's object is blessed into, that inherits Guff. Clear as mud? I think I am confusing myself more.
Test script
#!/usr/bin/perl -w
use strict;
use lib './';
use Guff;
use Data::Dumper;
my $data =
{
type=>'first',
value=>0,
DESKTOP=>
{
type=>'second',
value=>1,
LIBRARY=>
{
value=>2,
type=>'third',
REEL=>{ type=>undef },
}
},
};
my $g = Guff->new( $data );
print Dumper $g ;
The packages
package Guff;
use Carp;
use strict;
use Guff::Child1;
use Data::Dumper;
our $child = 'DESKTOP';
our %dispatch =
(
first=>'Guff::Child1',
);
sub new
{
my $class = shift;
my $in = shift;
#my %opt = %{$_[0]} ;
my %opt = %{$in};
my $kid = $class . "::child";
no strict 'refs';
do {
confess "Missing child attribute $kid ", $$kid
unless exists $opt{$$kid};
} if defined ( $opt{$$kid} );
use strict 'refs';
my $self = bless \%opt, $class;
$self->init;
return $self;
}
sub init
{
my $self = shift;
my $child = $self->childkey;
return unless defined $self->{type};
confess "Invalid child $child -" , Dumper $self
unless exists $self->{ $child };
if ( $self->dispatchto )
{
$self->{ $child }
= $self->dispatchto->new ( $self->{ $child } )
or confess "Failed to dispatch " , Dumper $self;
}
}
sub childkey
{
my $self = shift;
my $kid = ref($self) . "::child";
no strict 'refs';
my $child = $$kid;
use strict 'refs';
return $child;
}
sub dispatchto
{
my $self = shift;
my $key = shift;
my $dsp = ref($self) . "::dispatch";
no strict 'refs';
my $dispatch = $$dsp{$self->{type}};
use strict 'refs';
return $dispatch;
}
1;
package Guff::Child1;
use Guff;
@ISA = qw/Guff/;
our %dispatch =
(
second=>'Guff::Child2',
);
our $child = 'LIBRARY';
1;
package Guff::Child2;
use Guff::Child3;
@ISA = qw/Guff::Child1/;
our %dispatch =
(
third=>'Guff::Child3',
);
our $child = 'REEL';
1;
package Guff::Child3;
use Guff::Child2;
@ISA = qw/Guff::Child2/;
our %dispatch =
(
);
our $child = undef;
1;
I can't believe it's not psellchecked