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

I have a basic question about extending properties of objects. Consider

####### foo.pl ###################### use Foo; my $o = Foo->new( name => 'Tom' ); ####### Foo.pm ################## package Foo; sub new { my ($class, %args) = @_; my $self = { name => $args{name} }; bless $self, $class; return $self; } sub name { return $_[0]->{name}; } 1;

and

####### bar.pl ###################### use Bar; my $o = Bar->new( age => 23 ); ####### Bar.pm ################## package Bar; sub new { my ($class, %args) = @_; my $self = { age => $args{age} }; bless $self, $class; return $self; } sub age { return $_[0]->{age}; } 1;

My file structure on the disk looks like so --

foo.pl Foo.pm bar.pl Bar.pm

By now, things are getting messy, so I really want

####### foobar.pl ###################### use Foobar; my $o = Foobar->new( name => 'Tom' age => 23 );

and the files on my disk to be

foobar.pl Foobar.pm Foobar/Foo.pm Foobar/Bar.pm

How do I proceed? What do I put in Foobar.pm?

####### Foobar.pm ################## package Foobar; use Foobar::Foo; ??? use Foobar::Bar; ??? sub new { ???? } 1;

And, please, I don't want to know how to do it with Moose. Nothing against it; I just want to understand the logic and process behind achieving the above objective.

--

when small people start casting long shadows, it is time to go to bed

Replies are listed 'Best First'.
Re: Extending objects
by JavaFan (Canon) on Jul 07, 2010 at 15:11 UTC
    It's unclear to me what you really want. For now, I'll assume you want multiple inheritance. Here's how I would do it (but there are more ways to do it than there are Perl programmers)
    #### Foobar.pm ##### package Foobar; use Foo; use Bar; our @ISA = qw[Foo Bar]; sub new {bless {}, shift} sub init { my $self = shift; my %args = @_; $self->Foo::init(name => $args{name}) ->Bar::init(age => $args{age}); $self; } 1; #### Foo.pm #### package Foo; sub new {bless {}, shift} sub init { my $self = shift; my %args = @_; $self->{name} = $args{name}; $self; } sub name {$_[0]{name}} 1; #### Bar.pm #### package Bar; sub new {bless {}, shift} sub init { my $self = shift; my %args = @_; $self->{age} = $args{age}; $self; } sub age {$_[0]{age}} 1; #### foobar.pl #### use Foobar; my $o = Foobar->new->init(name => 'Tom', age => 23);
      Yes, multiple inheritance is the correct term, thanks. I don't know why I called id "extending."

      Question: Why are you using a separate init method outside of new? Any advantages to that?

      --

      when small people start casting long shadows, it is time to go to bed
        Question: Why are you using a separate init method outside of new? Any advantages to that?
        Because that makes multiple inheritance much easier. Assume ones Foo and Bar packages are:
        #### Foo.pm #### package Foo; sub new { my $self = bless {}, shift; my %args = @_; $self->{name} = $args{name}; $self; } sub name {$_[0]{name}} 1; #### Bar.pm #### package Bar; sub new { my $self = bless {}, shift; my %args = @_; $self->{age} = $args{age}; $self; } sub age {$_[0]{age}} 1;
        Then you don't have a method that given a reference populates it. Both new methods return their own structure. Which means the bottom class needs to create two objects (by calling new in both parent classes), and then break encapsulation by tearing the two objects apart and constructing a new one.
Re: Extending objects
by chromatic (Archbishop) on Jul 07, 2010 at 16:40 UTC

    Instead of multiple inheritance, consider Perl roles. (Look out, here comes Moose!):

    { package Named; use Moose::Role; has 'name', is => 'ro', isa => 'Str'; } { package Aged; use Moose::Role; has 'age', is => 'ro', isa => 'Int'; } { package FooBar; use Moose; with qw( Named Aged ); }

    The important part of the logic and process behind this is that each role specifies a combination of data and behavior and each class into which you apply a role consumes that combination of data and behavior. You want FooBar to have name and age attributes with read-only accessors, so you name each set of state and behavior and turn them into roles, then apply them to your class.

    Moose performs something similar to the longhand code other people have demonstrated (yet without multiple inheritance and, thanks to roles, compile-time composition checking of the role validity).

Re: Extending objects
by stevieb (Canon) on Jul 07, 2010 at 15:11 UTC

    Instead of a random directory structure, I prefer to create a proper module:

    h2xs -AXc -n FooBar

    ...which will create a FooBar directory that contains the following:

    Changes MANIFEST Makefile.PL README lib- |-- Foobar.pm t/

    Then, create a FooBar directory within the lib dir, and put your Bar.pm and Foo.pm in that. I use the FooBar.pm as a module that contains any methods that will be common to more than a single sub class. So, in Foo.pm and Bar.pm, I'd have:

    use base qw( FooBar );

    In FooBar, some of the common subs I'd have are a generic new(), database setup subs, configuration file setup subs etc. Then, unless Foo or Bar require specific, non-generic versions of these subs, they will automatically be inherited when use()ing FooBar::Bar and FooBar::Foo without having to recreate the subs in each module file.

    All in all, with the directory structure above and with this setup you could have:

    # lib/FooBar.pm package FooBar; sub new { my $class = shift; my $args = shift; my $self = bless { name => $args->{ name }, age => $args->{ age }, }, $class; } return $self; } # lib/FooBar/Foo.pm package FooBar::Foo; use base qw( FooBar ); # no new() sub, it's inhereted sub age { my $self = shift; my $args = shift; $self->{ age } = $args->{ age } if $args->{ age }; return $self->{ age }; } # lib/FooBar/Bar.pm package FooBar::Bar; use base qw( FooBar ); # no new again sub name { my $self = shift; my $args = shift; $self->{ name } = $args->{ name } if $args->{ name }; return $self->{ name }; } # foo.pl use FooBar::Foo; use FooBar::Bar; # don't need to 'use' FooBar here my $foo = FooBar::Foo->new({ name => 'stevieb', age => '35', }; my $current_age = $foo->age(); my $year_older = $foo->age({ age => 36, });

    Because you have a proper module setup, simply:

    perl Makefile.PL sudo make install

    to begin using your modules system-wide

    I hope this helps in some way

    Steve

      That's just plain weird. Now you have a parent class that has knowledge how it's subclasses are implemented (as it's the parent class that is storing the attributes the subclasses use). You're going out of your way to break encapsulation.

      And how it's going to work anyway? Your $foo is of class FooBar::Foo, which has FooBar in its inheritance tree (that is, assuming you would actually have package statements, which you don't). But then you call the method age, which is defined in FooBar::Bar, which is not inherited by FooBar::Foo.

      Thanks! This is brilliant. I didn't know about h2xs -AXc -n, so that itself is a great tip. The only issue I have with your approach is that Foo and Bar are inherited from Foobar, which works against the mental model I had of this. In my mental model, Foobar was inherited from Foo as well as from Bar. As JavaFan termed it, it was multiple inheritance I was after. Your approach requires in foo.pl

      use FooBar::Foo.pm use FooBar::Bar.pm

      I want the user to be shielded from the inner workings of Foobar. So, as far as the user is concerned, only the following should be required in foo.pl

      use Foobar;

      That way I can add more "parents" to Foobar in the future, if required. For example, I could modify Foobar to inherit from Baz.pm as well, but the user would not have to change foo.pl.

      All that said, many thanks for your very clear explanation.

      --

      when small people start casting long shadows, it is time to go to bed

        The example I used wasn't a good one ;) It is upside-down in the traditional sense, and based on a project I have that contains numerous modules that require a centralized configuration mechanism so I can use each module individually, as opposed to having to load them all via the parent each and every time.

        Pointers to a better way for this very welcome.

        Cheers,

        Steve

Re: Extending objects
by youwin (Beadle) on Jul 07, 2010 at 21:36 UTC

    I think you should keep existing definitions of Foo and Bar. There's no reason to change them. I might implement a FooBar class like this though:

    package FooBar; our @ISA = qw/Foo Bar/; sub new { my ($class, %args) = @_; bless { map %$_, $class->Foo::new(%args), $class->Bar::new(%args), }, $class; }
    and use it like this:
    package main; my $a = FooBar->new(name => 'Zoid', age => 55); printf "name: %s, age: %s\n", $a->name, $a->age;

    As long as there are no naming conflicts, this should be good. If there are naming conflicts you might choose to override the access method.

    Also I don't like your directory structure. I usually go down the inheritance hierarchy which only works for single inheritance. Truck/FireTruck.pm. If FireTruck is both a Truck and a Fire, I wouldn't name it FireTruck/Fire.pm and FireTruck/Truck.pm. You may find that you can think of one base class its true base and the other is like a role. But better yet put them all at the same directory level.

Re: Extending objects
by nudge (Acolyte) on Jul 08, 2010 at 00:14 UTC
    > And, please, I don't want to know how to do it with Moose.
    

    Have been using Object::InsideOut recently. I find it can fit inside one's mind all at the same time. Unlike moose, where the bits keep falling out ... :-)

    O::IO supports multiple inheritance, so one could write the following. (If all you required was already implemented in Foo and Bar, this really would be all the code.)

    package MyProject::FooBar; { use Object::InsideOut qw(MyProject::Foo MyProject::Bar); } 1;

    Example of use

    my $foobar = MyProject::FooBar->new( name=>'Bob', age=>32 );

      Replying to my own post to provide a full example.

      ### Name.pm ###

      package Name; { use Object::InsideOut; my @name :Field :All(name); } 1;

      ### Age.pm ###

      package Age; { use Object::InsideOut; my @age :Field :All(age) :Type(numeric); } 1;

      ### Person.pm ###

      use Name; use Age; package Person; { use Object::InsideOut qw(Name Age); } 1;

      ### main ###

      #!/usr/bin/perl use Person; my $person = Person->new( name => 'Bob', age => 32 ); print "Person's name is ", $person->name(); print " and age is ", $person->age(), "\n";