My goal in attempting to use objects with perl may be unreachable.
What I wanted to do is re-write some code that contains numerous hashes of hashes to use an object structure that encompesses the whole data structure and allows the user to populate and read the values as slices. I also would include a few methods that allowed me to loop through items based on a few rules
In other languages I would be able to represent a complex object such as:
obj.fig(x).method1
obj.fig(x).item(y).r02.someScalar
obj.fig(x).item(y).r02.methodx
obj.fig(y).item(z).r05(a).someOtherScaler
Having looked through a large number of tutorials and other documents. I keep seeing objects that inherit by adding more methods and scalars at the first level. They are populated at creation by anonymous hashes or arrays.
I don't see examples of objects that allow implement depth AND show a clear example how to populate and read the data using a "slice" type method.
In my first post I was really asking someone to point me to such an example. I wasn't asking anyone to write my code for me.
I have successfully used single level objects as shown below in X1 and X2 creating hashes containing multiple objects. What I don't see how to do is create a Y1 object. that contains a X1 and an Array of X2 objects.
Thanks for your patience,
Pat
package X1;
use vars qw($AUTOLOAD);
my %fields = (
TYPE => undef,
CUST => undef,
SEQ => undef,
);
sub new {
my $that = shift;
my $class = ref($that) || $that;
my $self = {
_permitted => \%fields,
%fields,
};
bless $self, $class;
return $self;
}
sub AUTOLOAD {
my $self = shift;
my $type = ref($self)
or warn "$self is not an object";
my $name = $AUTOLOAD;
$name =~ s/.*://; # strip fully-qualified portion
unless (exists $self->{_permitted}->{$name} ) {
warn "Can't access `$name' field in class $type";
}
if (@_) {
return $self->{$name} = shift;
} else {
return $self->{$name};
}
}
package X2;
use vars qw($AUTOLOAD);
my %fields = (
DEF => undef,
TEXT => undef,
QTY => undef,
);
sub new {
my $that = shift;
my $class = ref($that) || $that;
my $self = {
_permitted => \%fields,
%fields,
};
bless $self, $class;
return $self;
}
sub AUTOLOAD {
my $self = shift;
my $type = ref($self)
or warn "$self is not an object";
my $name = $AUTOLOAD;
$name =~ s/.*://; # strip fully-qualified portion
unless (exists $self->{_permitted}->{$name} ) {
warn "Can't access `$name' field in class $type";
}
if (@_) {
return $self->{$name} = shift;
} else {
return $self->{$name};
}
}
package Y1;
use X1;
use Y1;
my %fields = (
x1 => new X1,
x2 => new X2, # This needs to be an array of X2's
dt => undef;
};
sub new {
my $that = shift;
my $class = ref($that) || $that;
my $self = {
_permitted => \%fields,
%fields,
};
bless $self, $class;
return $self;
}
sub AUTOLOAD {
my $self = shift;
my $type = ref($self)
or warn "$self is not an object";
my $name = $AUTOLOAD;
$name =~ s/.*://; # strip fully-qualified portion
unless (exists $self->{_permitted}->{$name} ) {
warn "Can't access `$name' field in class $type";
}
if (@_) {
return $self->{$name} = shift;
} else {
return $self->{$name};
}
}
1;
|