Designing an OO program with multiple inherited classes

[punkish]

I am not sure if the title is appropriate, but here is my problem -- given the following code

# In my script
my $dbh = DBI->connect();
my $id  = 1;
my $obj = Obj->new($dbh, $id);
my $foo = $obj->foo;
my $bar = $obj->bar;

# In a nearby package
package Obj;

use constant PI => 3.14;
use constant  G => 9.81;

my %foo_cache;
my %bar_cache;

sub new {
  my ($class, $dbh, $id) = @_;

  my $self = bless {}, $class;
  $self->{dbh} = $dbh;
  $self->{id} = $id;
  
  return $self;
}

sub dbh {
  my $self = shift;
  return $self->{dbh};
}

sub id {
  my $self = shift;
  return $self->{id};
}

sub foo {
  my $self = shift;
  my $id   = $self->id;
  my $dbh  = $self->dbh;

  unless ($self->{foo}) {
  
    # check if foo is in cache
    if (exists $foo_cache{$id}) {
      # return from cache
      $self->{foo} = $foo_cache{$id};
    }
    else {
      $foo_cache{$id} = PI * query_foo_from_db_using($dbh, $id);
      $self->{foo} = $foo_cache{$id};
    }
  }
  
  return $self->{foo};
}

sub bar {
  my $self = shift;
  my $id   = $self->id;
  my $dbh  = $self->dbh;

  unless ($self->{bar}) {
    # check if bar is in cache
    if (exists $bar_cache{$id}) {
      # return from cache
      $self->{bar} = $bar_cache{$id};
    }
    else {
      $bar_cache{$id} = G * query_bar_from_db_using($dbh, $id);
      $self->{bar} = $bar_cache{$id};
    }
  }
  
  return $self->{bar};
}

1;

I want to convert the package code above to something like

package Obj;

use constant PI => 3.14;
use constant  G => 9.81;

my %foo_cache;
my %bar_cache;

use parent ('Obj::Foo', 'Obj::Bar');

sub new {
  my ($class, $dbh, $id) = @_;

  my $self = bless {}, $class;
  $self->{dbh} = $dbh;
  $self->{id} = $id;
  
  return $self;
}

sub dbh {
  my $self = shift;
  return $self->{dbh};
}

sub id {
  my $self = shift;
  return $self->{id};
}

1;

###############
package Obj::Foo;

sub foo {
  my $self = shift;
  my $id   = $self->id;
  my $dbh  = $self->dbh;

  unless ($self->{foo}) {
  
    # check if foo is in cache
    if (exists $Obj::foo_cache{$id}) {
      # return from cache
      $self->{foo} = $Obj::foo_cache{$id};
    }
    else {
      $Obj::foo_cache{$id} = Obj::PI * query_foo_from_db_using($dbh, $
+id);
      $self->{foo} = $Obj::foo_cache{$id};
    }
  }
  
  return $self->{foo};
}

1;

Update: The following line $self->{foo} = $Obj::foo_cache{$id}; above doesn't seem to work. How do I access a class variable from Obj.pm from within Obj::Foo.pm? Or, what is a better way to accomplish what I am trying to do?

###############
package Obj::Bar;

sub bar {
  my $self = shift;
  my $id   = $self->id;
  my $dbh  = $self->dbh;

  unless ($self->{bar}) {
    # check if bar is in cache
    if (exists $Obj::bar_cache{$id}) {
      # return from cache
      $self->{bar} = $Obj::bar_cache{$id};
    }
    else {
      $Obj::bar_cache{$id} = Obj::G * query_bar_from_db_using($dbh, $i
+d);
      $self->{bar} = $Obj::bar_cache{$id};
    }
  }
  
  return $self->{bar};
}

1;

Besides the fact that making Obj inherit from Foo and Bar doesn't seem right (after all, Obj is not a type of Foo or Bar; instead, Foo and Bar are parts of Obj) it does work. My question to you before I embark on the above design -- anything wrong with this? Do I have to be aware of any gotchas?

[dsheroh]

You've already hit on my major objection to it: You shouldn't be saying that an Obj isa Foo and an Obj isa Bar if an Obj is neither a Foo nor a Bar.

The traditional way of resolving this would be with aggregation, in which Obj has a Foo and a Bar which it delegates calls to:

package Obj;

sub new {
  ...
  $self->{_foo} = Foo->new;
  ...
}

sub foo {
  my $self = shift;
  return $self->{_foo}->foo(@_);
}

If you want to dip your toes into the Moose water (eeeeew...), this may be a good place to use roles, depending on what you actually want to accomplish in the real world. If you want to just pull behaviour from Foo/Bar, but still have it operate on the Obj's data, then roles are likely a good match. If you need to have independent Foo/Bar data as well as their behaviour, then it's likely that aggregation would be a more appropriate model.

An object is the class it inherits from, has objects it aggregates, and does roles it consumes.

[punkish]

package Obj;

sub new {
  ...
  $self->{_foo} = Foo->new;
  ...
}

sub foo {
  my $self = shift;
  return $self->{_foo}->foo(@_);
}

Thanks for the guidance above, but I am still not clear about the implementation. Is sub foo {} in a different package or in Obj.pm? I hope not the latter, because the whole point of the exercise is to separate Foo code into a separate package that still gets initialized via Obj.pm. In other words, in my script I want to call only Obj->new(), and as Obj->new() goes about initializing, parts of it are done elsewhere, in Foo, Bar, etc.

The source of this problem is that I am trying to translate a rather large C program, and in doing so, I am trying to follow some of the original design choices. Since C has all the bits and pieces in separate .h and .c files, I am trying to respect that as much as possible. Of course, if they completely don't make any sense, or are not needed because of the magic of Perl, then I won't, but for the most part, I want to keep the code in small files, rather than all of it in one file.

Also, while Moose may well solve my problem, and may well be the greatest thing since sliced hashes, I don't want to use Moose. Basically, I don't want to use external and complicated stuff, specially stuff I have to install and learn. Right now the only non-core Perl module I am using is DBI. I want it to remain that way.

So, how can I implement hasa instead of isa with vanilla Perl?

Thanks.

[dsheroh]

I am still not clear about the implementation. Is sub foo {} in a different package or in Obj.pm?

Both. The actual foo functionality is contained within Foo::foo, while Obj::foo is the exact code from my example - it just references its internal Foo instance and passes calls off to its foo method.

Here's a complete runnable demonstration:

#!/usr/bin/perl

use strict;
use warnings;

my $obj = Obj->new;
if ($obj->foo) {
  print "\$obj->foo called Foo::foo\n";
} else {
  die "Foo class was not touched!\n";
}

package Foo;

sub new { return bless { }; }

sub foo {
  print "In Foo::foo, where the work gets done.\n";
  return 1;
}

package Obj;

sub new {
  return bless { _foo => Foo->new };
}

sub foo {
  my $self = shift;
  print "In Obj::foo and about to pass the buck.\n";
  return $self->{_foo}->foo(@_);
}

The print in Obj::foo isn't necessary, of course, and you normally wouldn't do anything there other than delegating the call to the aggregated object. I just threw it in to demonstrate the control flow more clearly.

It may also be worth noting that, if Obj and Foo were in their own separate modules (instead of everything being in one file as in my example), applications would only need to use Obj to gain access to the functionality of $obj->foo. The implementation of Obj::foo and the existence of an internal Foo instance are completely opaque to them, so they would not need to use Foo unless they want to create their own independent Foo instances outside of their Objs.

[FalseVinylShrub]

Hi

Regarding your update about  $self->{foo} = $Obj::foo_cache{$id}; not working: that's because you've declared your 'cache' variables as 'my' variables, but refered to them as package variables. If you change the declaration to 'our' instead of my, it should work, I think...

About your design question, I'm no OO guru but using inheritance where it doesn't make sense I'm pretty sure is one the the things OO gurus go on about a lot. For reasons including:

• Makes the design harder to understand
• Possible conflicts between method that aren't really the same, but have the same name - particularly as you're using multiple inheritance here.
• Defeats some kind of principle that says you should be able to use a 'Foo' whereever you would use an 'Obj'...

For better explanations, consult an OO guru ;-)

For a more convenient way to dispatch methods off to a 'delegate' class, I suggest looking at a framework on top of Perl's bare object system. The most popular at the moment seems to be Moose, but I've not got round to using it so can't say for sure if it's best...

FalseVinylShrub

[Bloodnok]

How do I access a class variable from Obj.pm from within Obj::Foo.pm?

The simple answer is (or should be), you don't - you should use an accessor method on the class instead.

...Obj is not a type of Foo or Bar; instead, Foo and Bar are parts of Obj...

With that one observation, you have both hit the nail squarely on the head and also gone some way to answering your own question viz: these days the preference is for composition/aggregation (see here for a discussion of the terms aggregation and composition) over inheritance.

[punkish]

these days the preference is for composition/aggregation

Right then. But, how do I implement the above? Your link to the wikipedia article explained some, but what next? I am a relative OO-n00b, so you will have to guide me a bit more.

Many thanks, and please, no Moose suggestions. :-)

[doug]

You cannot get to those  my variables. Class variables are usually handled with some sort of package variable, like  %Obj::foo_cache, by creating accessor methods that are in the same scope (think closure) that the kiddie subclasses can call, or by squirreling away references to the data inside each and every instance. Perl only objectifies methods, nothing else, so games have to be played to get class data visible to subclasses.

The way you're asking this question, I think you need to brush up on how Perl handles packages, name spaces, closures, and the like. The techniques are the same for OO and standard procedural.

Also, this isn't "has-a", this is pure "is-a". At no point do I see you trying to allocate an intermediate object, and redirecting request to it. I don't know if that matters or not. For "has-a", Foo would not have Obj as a base, but would have a reference to a Obj object and would pass foo_cache requests to it.

All that said, the easiest way is an accessor method in the Obj package, like this snippet

 sub foo_cache() { \%foo_cache; }

and your Obj::Foo subclass would use stuff like

if ( exists $self->foo_cache()->{$key} ) { # cache hit
    $value = $self->foo_cache()->{$key};
} else { # this means a cache miss
    $value = calculate_something_worth_caching();
    $self->foo_cache()->{$key} = $value; # store in cache
}

If you think you've just broken encapsulation, and you've now tightly bound the Obj::Foo subclass to the implementation details of its parent Obj class, then you understand why I wouldn't do it it this way. But if you're just learning, this should get you going. Once you've gotten a bit more experience, convert that to having a get_foo() and set_foo() in Obj foo can call and be unaware of the details of %foo_cache. I mean, caches are supposed to be transparent, right?

In a lot of cases, caching can be implemented with the Memoize module, so you might want to look at it too.

- doug

PS: Love the moose. Touch the moose. Grok the moose.