in reply to Re^2: Designing an OO program with multiple inherited classes
in thread Designing an OO program with multiple inherited classes

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.

Replies are listed 'Best First'.
Re^4: Designing an OO program with multiple inherited classes
by punkish (Priest) on Dec 10, 2009 at 18:09 UTC
    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;
    --

    when small people start casting long shadows, it is time to go to bed
      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.