in reply to Re: Stumped on an OO Problem
in thread Stumped on an OO Problem

ZZamboni wrote:
> But now you have also the @permitted > array, which would allow you to write pack as follows, > giving you control over the order in > which the elements are packed: > > > sub pack { > my $self=shift; > my $record=join(':', @{$self}{@permitted}); > return $record; > }
No... this breaks inheritance, because you're trying to use @permitted in a different scope than where it was defined. @permitted is scoped lexically to the file in which it was defined, so you can't try to use it in your generic parent class, which is, presumably, where pack would be defined.

A solution would be to take a reference to the array and store it in your object, as we're already doing with %fields.

Replies are listed 'Best First'.
RE: RE: Re: Stumped on an OO Problem
by ZZamboni (Curate) on Jun 27, 2000 at 23:11 UTC
    Good point, since skazat's intent was to build a general container class, where subclasses would only define the desired fields. So how about this (which should also satisfy chromatic :-). No file or global variables. Only define the "fields" subroutine which returns the permitted fields in the desired order. The constructor uses that to build the _permitted element, and the rest of the code is pretty much the same. Defining a new subclass only needs the definition of fields, as shown by SUBPRODUCT below. The fields are not inherited, although that could probably be fixed by traversing the hierarchy calling fields() at each level.
    package PRODUCT; use Carp; use strict; use vars qw($AUTOLOAD); sub fields { return qw(data); } sub new { my $product = shift; my $class = ref($product) || $product; my $self={}; bless $self, $class; my %fields; @fields{$self->fields}=undef; $self->{_permitted} = \%fields; $self->{$_}=$fields{$_} for (keys %fields); return $self; } sub AUTOLOAD { my $self = shift; my $type = ref($self) or croak "$self is not an object"; my $name = $AUTOLOAD; $name =~ s/.*://; #strip fully-qualified portions unless (exists $self ->{_permitted} ->{$name} ) { croak "Can't access `$name' field in class $type"; } if (@_) { return $self -> {$name} = shift; }else{ return $self-> {$name}; } } sub DESTROY {} sub pack { my $self=shift; my $record=join(':', @{$self}{$self->fields}); return $record; } package SUBPRODUCT; use vars qw(@ISA); @ISA=qw(PRODUCT); sub fields { return qw(name price description); } 1;

    --ZZamboni