Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

OO - problem with inheritance

by uwevoelker (Pilgrim)
on Jan 14, 2002 at 19:38 UTC ( #138586=perlquestion: print w/replies, xml ) Need Help??

uwevoelker has asked for the wisdom of the Perl Monks concerning the following question:

I'm having a great problem with inheritance. I would like to build a generic datatype class and inherit other classes from this base class.
Here is a shortened version of the base class:
package base_class; my $parameter_config = { mandatory => {type => 'boolean', default => 0, valid => 0}, }; sub valid_parameter { my @param = @_; foreach (@param) { if (defined $parameter_config->{$_}) { $parameter_config->{$_}->{valid} = 1; } else { die "Parameter $_ not known"; } } return 1; } sub new { # and so on }; 1;
In the Integer class I use
&CCS::Data::Datatype::base_class::valid_parameter( qw(mandatory));
to enable the parameter 'mandatory'. I have written a test suite and it works. But when I use another datatype (String) and do the same with other parameters, they both use the same variables from the base class.

I would like to give every datatype his own $parameter_config, but they only write at startup time in this hashref, the constructor new() deals with this hashref. And this new() is inherited from base_class.pm.

They should not use all the same variable $parameter_config, every class (Integer/String and so on) should have their own, but the access is only in the subroutine &base_class::new(). No inherited datatype has its own constructor.

I hope you have understood me, if not I would like to clarify. Feel free to ask. Hopefully you can help me. Thanks a lot.

Good bye, uwe

Replies are listed 'Best First'.
Re: OO - problem with inheritance
by IlyaM (Parson) on Jan 14, 2002 at 20:07 UTC
    You could use a method instead of variable to store information about parameters. This way this information could be overridden easily in subclasses:
    my $parameter_config = { mandatory => {type => 'boolean', default => 0, valid => 0}, }; sub parameter_config { $parameter_config }; sub valid_parameter { my $class = shift; my @param = @_; foreach (@param) { my $param_config = $class->parameter_config->{$_}; if ($param_config) { $param_config->{valid} = 1; } else { die "Parameter $_ not known"; } } return 1; }
    And in your classes you should call valid_parameter as method:
    Integer->valid_parameter(qw(mandatory));
    Subclasses which need other configuration of parameters just override method parameter_config.

    --
    Ilya Martynov (http://martynov.org/)

      Hello Ilya,
      thank you for your fast answer. Did I got you right, that when I want to change other configuration parameters like this
      &CCS::Data::Datatype::base_class::config_parameter( max_length => {max => 255, default => 255}, min_length => {max => 255});
      which is taken from my String class, I need to override your sub parameter_config in this way?
      sub parameter_config { return {max_length => {max => 255, default =>255)); }
      But I also need the other parameters from base class (like min => 0 and valid => 0 in this case).

      Or could I do something like this:
      my $parameter_config = SUPER->parameter_config; $parameter_config->{max_length}{max} = 255; $parameter_config->{max_length}{default} = 255; sub parameter_config { $parameter_config }
      My classes not only inherit from base_class.pm. There are also datatypes that inherit from other datatypes. Such as Text inherits from String (but no direct base_class) and PrimaryKey inherits from Integer. Is such inheritance with one of this configuration methods combineable?

      My goal is, that I can add new parameters only in base_class (let's say has_double_letters or max_number / min_number) and all the datatypes need only to "activate" this new parameters via the ->valid_parameter(qw(mandatory max_number)) call.

      Thanks, Uwe
        my $parameter_config = __PACKAGE__->SUPER::parameter_config; $parameter_config->{max_length}{max} = 255; $parameter_config->{max_length}{default} = 255; sub parameter_config { $parameter_config }
        This should work if you want to register your parameters in base_class. BTW you don't need to override parameter_config at all in this case because SUPER->parameter_config returns hash reference stored in $parameter_config variable in base class. So next two lines do affect hash used by base_class. If it is not desired effect you should clone that hash:
        use Storable qw(dclone); my $parameter_config = dclone(__PACKAGE__->SUPER::parameter_config); $parameter_config->{max_length}{max} = 255; $parameter_config->{max_length}{default} = 255; sub parameter_config { $parameter_config }
        Update: Fixed usage of wrong syntax (SUPER->method instead of __PACKAGE__->SUPER::method)

        --
        Ilya Martynov (http://martynov.org/)

Re: OO - problem with inheritance
by frag (Hermit) on Jan 14, 2002 at 20:27 UTC
    It sounds like you're wrestling with the question of how to create class data so that the accessors are inherited but not the data itself.

    I think you'll find perltootc - Tom's OO Tutorial for Class Data in Perl very useful, in particular the section Inheritance Concerns. Borrowing code from that, you can use something like this:

    package base_class; my %parameter_config = {# the same as before...}; # accessor for class-specific hash named %parameter_config: sub parameter_config { my $obclass = shift; my $class = ref($obclass) || $obclass; my $varname = $class . "::parameter_config"; no strict "refs"; # to access package data symbolically %$varname = {foo=>'bar'}; # this is the package-local hash %parameter_config. # Just refering to '%parameter_config' should refer to # %base_class::parameter_config. }

    To initialize the package-specific %parameter_config, throw in similar magic into &base_class::new.

    -- Frag.
    --
    "It's beat time, it's hop time, it's monk time!"

      > It sounds like you're wrestling with the question of how to create class data so that the accessors are inherited but not the data itself.
      I would like the accessors _and_ data inherit.

      In base_class is the big $parameter_config hashref. And there is a constructor new() which execlusively deals with this hashref. He gets his values by $parameter_config->{..}{..} and so on. But the other modules, which inherit from base_class only submit their changes to that huge config-hashref. Because this can't be done directly, I wrote two subroutines in base_class: valid_parameter and config_parameter. I want them to store the additional information in this hashref. But - and here is my problem - this hashref should be unique for each datatype/class. So I would like to access the hashref in base_class but the contents should be specific to the calling class.

      I agree, that this is very naive. Now I'm searching for an other approach. Have you written my reply to Ilya's answer? I would like to use the last method: copy the hash and change it a little bit. But because it's an hashref, I think this won't work...

      To your suggestion:
      I need the %parameter_config hash before new() is called, because new() needs this information to figure out, if the parameters given to new() are correct. So I need code I can run when the class is loaded.

      Thank you, good bye, Uwe
        So I would like to access the hashref in base_class but the contents should be specific to the calling class.

        I'm a little confused about what you're doing. You want each change submitted to the base_class's %parameter_config for confirmation; after that, the actual values get stored in each subclass's own %parameter_config, right? If so, just change your accessors so that before fiddling with %sub_class::parameter_config it first messes with %base_class::parameter_config, to do whatever checking/storing you want done there, and then store the data in each individual subclass's hash. (Or, if you follow your new approach, replace "fiddling with %base_class::parameter_config" with "call validation methods from ValidateNewParameter". Same principle.)

        I need the %parameter_config hash before new() is called, because new() needs this information to figure out, if the parameters given to new() are correct. So I need code I can run when the class is loaded.

        OK, so put something like this at the start of each subclass:

        use vars qw(%parameter_config); # or 'our' but NOT 'my', not if you # use the approach I gave before %parameter_config = &base_class::parameter_config;
        And now each subclass has its own copy of %parameter_config. Just make sure that &base_class::parameter_config returns a copy of the hash.

        -- Frag.
        --
        "It's beat time, it's hop time, it's monk time!"

new idea - please comment on this
by uwevoelker (Pilgrim) on Jan 14, 2002 at 21:14 UTC
    I have a new idea:
    Because the only goal for this $parameter_config hashref is to validate the parameters given to the constructor new() I could write a class ValidateNewParameter.pm. The base_class creates a new ValidateNewParameter object and stores lots of parameters in it. And all the derived datatypes clone this object and add only there changes. I think this could work!

    And I can even reuse this behaviour in other modules. Also, base_class gets cleaner.

    What do you think about this idea? Have I overseen something important?

    Thank you very much
      It is similar to your original idea to store parameters data in a hash (instead of hashes you have objects which stores same information). So it is not really new idea :) Anyway it could be more cleaner approach if you move all your validation code into that class and replace hash manupulations with cleaner interface provided by that class. IMHO it is good approach.

      --
      Ilya Martynov (http://martynov.org/)

        You are right. I thought cloning of objects is much easier (because I have heard of the common clone-method in new/copy constructors), but actually it isn't very different from copying an hash. But I also like the idea of moving all my validation code into that class.

        Thank you for your comment.
super(params)
by djantzen (Priest) on Jan 15, 2002 at 07:52 UTC

    This is definitely a hangover from Java, but whenever I do inheritance in Perl, I write the code so that the parent constructor is called from the child class' constructor. In Java, every time you extend a class, whether you say so explicitly or not, you instantiate everything all the way up the hierarchy up to java.lang.Object.

    In Perl I often see people use inheritance with methods only; that is, they inherit the behavior but not the data. To me, both are necessary for object oriented inheritance.

    My suggestion is to write the general constructor in the base class with a default value for the parameter checking. If a subclass needs something different, it calls the base class constructor with the proper parameters. In Java, this is super(params), in Perl the child constructor would say:

      my ($class, $whatever) = @_;
      my %params = (); # new params to use instead of parent's params
      my $this = new base_class(%params); # create a new parent
      bless($this, $class); # rebless into the current package
    

      It is better to rewrite your code as:
      my ($class, $whatever) = @_; my %params = (); # new params to use instead of parent's params my $self = $class->SUPER::new(%params); # create a new parent bless($self, $class); # rebless into the current package
      Note that this variant doesn't hardcode baseclass name.

      BTW I strongly advice against using $this in Perl code. Most Perl programmers are too get used to $self. I recall than in the company where I worked until recenly we have one programmer (who was Java fan but liked Perl too) who used $this in his code. It was big PITA for everybody who had to edit that code. Fingers just type $self and only later you release (when you see Global symbol "$self" requires explicit package name) that it should be $this. After several such accidents we just told him that $this is forbidden :)

      Anyway there is nothing wrong in using same constructor in all classes as long as it deffers object initialization to some methods which are overriden in subclasses. Actually it is very common practice and not only in Perl.

      --
      Ilya Martynov (http://martynov.org/)

        And, if you need to call multiple parental classes, there's NEXT, e.g.: $class->NEXT::new(%params).

        As for $this vs. $self -- it seems that should be a local style standard, and not a global Perl-wide proscription. So long as it's consistent inside a given project, and easily s///able, use $dohickey, $The_Monster, or $Frank. TMTOWTNI.

        -- Frag.
        --
        "It's beat time, it's hop time, it's monk time!"

        $class->SUPER::new(%params);
        Okay point taken. However this business with '$self' is truly not something that ought to be mandated across all projects, because while it may be a common idiom in the Perl community (most likely due to the nice phrase 'my $self'), for those of us that work in multiple OO languages it is not the norm. I routinely have to switch between the two, and from experience I declare: it's no big whoop.

      There's at least a potential hazard in this approach: what if your parent constructor does parameter checking, and is more restrictive than your subclass? Then the above would be dangerous -- you'd lose the values in %params -- and you'd want to do something like:
      my ($class, $whatever) = @_; my %params = (); # new params to use instead of parent's params my $this = new base_class; # create a new parent, and # let it set its own defaults # clobber the base_class' defaults: while (my ($k,$v) = each %params) { $this->{$k} = $v; } bless($this, $class); # re-bless into the current package
      Ugly and hypothetical, but something to be aware of.

      On second thought, better still: always make any parameter checking in the constructors throw a fatal error. Note such errors in development and change the parent's constructor to play nice.

      -- Frag.
      --
      "It's beat time, it's hop time, it's monk time!"

Re: OO - problem with inheritance
by dmmiller2k (Chaplain) on Jan 15, 2002 at 21:14 UTC

    After reading all of the posts herein, it struck me that you want a separate instance of %parameter_config per derived class, yet shared among all objects of the derived class type.

    For clarification, assuming you had three classes derived from the base, e.g., Int, String and Float. There would be exactly three instances of %parameter_config (kept somewhere -- read on), regardless of how many Int, String or Float objects you create.

    Each of the %parameter_config things has in common some basic info, plus some class-specific extra stuff added by each subclass.

    If this describes your problem, then perhaps I have a solution.

    Create a class, say, ParamConfig.pm, which consists basically of a blessed hash (%parameter_config ) containing the basic info required by all types. Add one more hash element: parent_type.

    In the constructor (new method) of this class, accept a parameter, parent_type, which is used to initialize the parent_type hash element.

    Now, in your base class (from which you will derive Int, String, Float, etc.), you would have code like this:

    package BaseType; ... BEGIN { my $parameter_config = undef; # accessor - turns the ParamConfig object into a closure sub parameter_config { $parameter_config = $_[0] if @_; return $parameter_config; } } sub new { my $class = shift; # the usual prolog my $type = ref $class || $class; my $self = bless {}, $type; return $self; } ...
    In your derived class (say, Int), you would have something like the following code:
    package Int; use base qw( BaseType ); use ParamConfig; BEGIN { # create only one of these, at compile time my $pkg_name = __PACKAGE__; my $parameter_config = parameter_config( new ParamConfig( $pkg_name +) ); @{$parameter_config}{ 'int_specific', 'params' } = ( 'vale', 'val2' +); } sub new { my $class = shift; # the usual prolog my $type = ref $class || $class; my $self = bless SUPER->new(), $type; @{$self}{ 'Int', 'Specific', 'Variables' } = (); return $self; } ... # Thereafter, access the class-specific ParamConfig using the accessor +, parameter_config().

    This scheme turns instances of ParamConfig into class-level closures (i.e., singletons), share among all members of the derived classes.

    Update: the use ParamConfig; belongs in the subclass, not the base class.

    dmm

    If you GIVE a man a fish you feed him for a day
    But,
    TEACH him to fish and you feed him for a lifetime
      Hello dmmiller2k,
      you are absolutely right! This is what I wanted. And with the help of IlyaM and frag I started coding my own ParamConfig class yesterday. I have called it Parameter::Validate. If you are interested, I will publish the source code and test script here. I know, the test script is a bit small, but I have only written one or two before. So I'm not familiar with the style of test scripts.
      package Parameter::Validate; $VERSION = 0.01; # 15.01.2002 - 0.01 # taken from CCS::Data::Datatype::base_class, see also # ( http://www.perlmonks.org/index.pl?node_id=138586&lastnode_id=131 +) # 16.01.2002 - 0.01 # translated some comments use strict; use Data::Dumper; # used in debug method use base 'Clone'; # inherit clone method # predefined parameter configurations my $names = { datatype => { mandatory => {type => 'boolean', default => 0, valid => 0, }, min_length => {type => 'integer', min => 0, max => undef, default => 0, valid => 0, }, max_length => {type => 'integer', min => 0, max => undef, default => undef, valid => 0, }, min_number => {type => 'integer', min => undef, max => undef, default => undef, valid => 0, }, max_number => {type => 'integer', min => undef, max => undef, default => undef, valid => 0, }, }, }; # constructor sub new { my ($class, @param) = @_; my $self = {}; $class = ref($class) || $class; # examine given parameters # only 1 parameter? if (scalar @param == 1) { # yes; scalar or hashref? my $ref = ref($param[0]); if (not $ref) { # scalar; lookup in %$names and clone this configuration die "no such configuration: $ref" unless (exists $names->{$param[0]}); # clone configuration $self = Clone::clone($names->{$param[0]}); } elsif ($ref eq 'HASH') { # hashref; clone it $self = Clone::clone($param[0]); } else { # no valid reference die "expected scalar or hashref, got $ref"; } } else { # no; more than 1 parameter $self = {@param}; } bless($self, $class); return $self; } # set valid to 1 sub enable { my ($self, @param) = @_; foreach (@param) { if (exists $self->{$_}) { # set valid to 1 $self->{$_}->{valid} = 1; } else { # unknown parameter die "parameter $_ is not known"; } } return 1; } # set valid to 0 sub disable { my ($self, @param) = @_; foreach (@param) { if (exists $self->{$_}) { # set valid to 0 $self->{$_}->{valid} = 0; } else { # unknown parameter die "parameter $_ is not known"; } } return 1; } # change parameter configuration sub change { my ($self, @param) = @_; # 1 parameter form? if (scalar @param == 1) { # check, if it's an hashref die "wrong argument: $param[0]" if (not ref($param[0]) or ref($param[0]) ne 'HASH'); @param = %{$param[0]}; # 3 parameter form? } elsif (scalar @param == 3) { # check, if the first 2 are scalars die "wrong arguments: $param[0] : $param[1] -> $param[2]" if (ref($param[0]) or ref($param[1])); $self->_change($param[0], {$param[1], $param[2]}); return 1; } # now we accept $key1, $hashref1, $key2, $hashref2 ... # even number of parameters? die "wrong number of arguments: ".scalar @param if ((scalar @param) & 1); # are there parameters left? while (scalar @param > 0) { # is $param[0] a scalar and $param[1] an hashref? die "wrong arguments: $param[0] -> $param[1]" if (ref($param[0]) or not ref($param[1]) or (ref($param[1]) ne 'HASH')); $self->_change(shift @param, shift @param); } return 1; } sub _change { my ($self, $param, $config) = @_; # is $param a known parameter name? die "parameter $param is not known" unless (exists $self->{$param}); # is $param a valid parameter die "parameter $param is not valid" unless ($self->{$param}->{valid}); # change configuration foreach my $key (keys %$config) { die "$param : $key does not exist" unless (exists $self->{$param}->{$key}); $self->{$param}->{$key} = $config->{$key}; } return 1; } # return object structure sub debug { return Dumper(shift); } # process given parameter sub process { my ($self, @param) = @_; my %param = (); # create new hashref and fill it with defaults my $config = $self->defaults; # only 1 parameter? if (scalar @param == 1) { # is it an hashref? die "wrong argument: $param[0]" if (not ref($param[0]) or ref($param[0]) ne 'HASH'); %param = %{$param[0]}; } else { # copy array to hash %param = @param; } # examine each given parameter foreach my $key (keys %param) { my $val = $param{$key}; # is parameter valid? my $error = $self->validate($key, $val); die "Key: $key - Value: $val - Error: $error" if ($error); $config->{$key} = $val; } return $config; } # return default values sub defaults { my $self = shift; my $default = {}; foreach my $key (keys %$self) { $default->{$key} = $self->{$key}->{default} if (exists $self->{$key}->{default}); } return $default; } # validate parameter and value sub validate { my ($self, $param, $value) = @_; # does $param exist? return "parameter unknown" unless (exists $self->{$param}); # is $param valid? return "parameter invalid" unless ($self->{$param}->{valid}); # check type my $type = $self->{$param}->{type}; # boolean if ($type eq 'boolean') { # nothing to check } # integer elsif ($type eq 'integer') { # check for integer (numbers and minus allowed) return "value is no integer" unless ($value =~ /^-?\d+$/); # check minimum if (defined $self->{$param}->{min}) { my $min = $self->{$param}->{min}; return "value is less than $min" if ($value < $min); } # check maximum if (defined $self->{$param}->{max}) { my $max = $self->{$param}->{max}; return "value is greater than $max" if ($value > $max); } } # string elsif ($type eq 'string') { # check minimum length if (defined $self->{$param}->{min}) { my $min = $self->{$param}->{min}; return "value is shorter than $min chars" if (length($value) < $min); } # check maximum length if (defined $self->{$param}->{max}) { my $max = $self->{$param}->{max}; return "value is longer than $max chars" if (length($value) > $max); } } # unknown type else { die "unknown type $type"; } # alles okay return undef; } 1;
      And this is the test script:
      #!/usr/bin/perl -w use strict; use Test::More 'no_plan'; use Data::Dumper; use lib '/home/uwe/cvs/perl'; use lib '/home/uwe/cvs/perl/module'; use_ok 'Parameter::Validate'; my $debug = 1; # generate new object my $pv = Parameter::Validate->new('datatype'); isa_ok($pv, 'Parameter::Validate'); can_ok($pv, qw(new clone enable disable change debug process)); # clone object my $copy = $pv->clone; isa_ok($copy, 'Parameter::Validate'); can_ok($pv, qw(new clone enable disable change debug process)); if ($debug) { # print Dumper($copy); # print "\n$pv\n$copy\n"; } # enable parameter $pv->enable(qw(mandatory min_length max_length min_number max_number)) +; #print Dumper($pv) if $debug; # disable parameter $pv->disable(qw(mandatory min_length max_length min_number max_number) +); #print Dumper($pv) if $debug; # change parameter $pv->enable(qw(min_length max_length)); # 3 parameter form $pv->change('min_length', 'default', 123); # 2 parameter form $pv->change('max_length', {default => 25, max => 50}); #print Dumper($pv) if $debug; $copy->enable(qw(min_length max_length max_number min_number)); # 2 parameter form extended $copy->change('min_length', {default => 25, max => 50}, 'max_length', {default => 23, max => 99}); # 1 parameter form $copy->change({min_number => {default => 222}, max_number => {default => 999}}); #print Dumper($copy) if $debug; # process parameter $pv->enable('mandatory'); print Dumper($pv->process(mandatory => 1, min_length => 67));
      I would like to hear comments to my code. Feedback is very important for me. Please feel free to criticize me!

      Thank you, Uwe

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://138586]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (4)
As of 2022-05-28 20:05 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you prefer to work remotely?



    Results (101 votes). Check out past polls.

    Notices?