Re^2: Designing an OO program with multiple inherited classes

[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.

[punkish]

dsheroh,

Many thanks for your hand-holding. I am almost there, but consider the following variation on your suggestion (my relevant edits, the ones that don't work for me, marked with ## desired ##)

#!/usr/local/bin/perl -w

use strict;
use DBI qw(:sql_types);
use Obj;

use constant (
    PI => 3.1425
);

{
    my %CACHE = ();
    
    sub cache {
        my ($self, $cid, $val) = @_;
        
        if (defined $val) {
            %CACHE = ();         # empty the cache
            $CACHE{$cid} = $val; # stuff cache with new val
            return $val;
        }
        else {
            return $CACHE{$cid} if exists $CACHE{$cid};
        }
    }
}

my $dbh = DBI->connect(
    "dbi:SQLite:dbname=db.sqlite","","", 
    {RaiseError => 1, AutoCommit => 0}
);

my $obj = Obj->new(dbh => $dbh, uid => 1, cid => 1);

print "\$obj->foo called Foo::foo\n";

#####################################
package Obj;

use strict;
use Foo;

sub new {
    my ($class, %args) = @_;
    
    my $self = bless(
        {dbh => $args{dbh}, uid => $args{uid}, cid => $args{cid},}, 
        $class
    );
    
    $self->{foo} = Foo->new;
    
    return $self;
}

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

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

1;

#####################################
package Foo;

use strict;

sub new {
    return bless { };
}

sub foo {
    print "In Foo::foo, where the work gets done.\n";
    
    ## desired: be able to call Obj::instance_methods like so ##
    print "Cell id is: " . $self->cid() . "\n";
    ##
    
    ## desired: be able to access Obj::class_methods,
    ## class vars and class constants like so 
    ##
    my $dbh = $self->dbh;
    my $sth = $dbh->prepare("SELECT * FROM cells WHERE cid = ?");
    $sth->execute;
    my @res = $sth->fetchrow_array;
    $self->cache($self->cid, \@res); # class method
    print "Have a pi: " . Obj::PI . "\n"; # class constant
    ##
    
    return 1;
}

1;

[dsheroh]

I haven't taken the time to read and understand your full code, but, with respect to your "## desired:" comments, the way you would make the Obj instance available within Foo::foo would be to change the first line of Obj::foo to:

my $self = $_[0];  # instead of $self = shift

so that the Obj instance passes itself as the first parameter to Foo::foo. Then add

my $self = shift;
my $caller = shift;

to the start of Foo::foo to get the Foo instance in $self and the invoking Obj instance in $caller. You'll then be able to reference the relevant bits of $obj as $caller->cid, $caller->dbh, etc.