Moose is an excellent suggestion.

#!/usr/bin/perl

use strict;
use warnings;

my $red = Apple->new( color => 'green'  );
my $yel = Apple->new( color => 'yellow' );

$red->color( 'red' ); # It got ripe.

my $foo = Orange->new();
my $baz = Orange->new( apple => $red ); 

for my $obj ( $red, $yel, $foo, $baz ) {
    print 'served: ', $obj->serve, "\n";
}

print "\n fruit stand: \n",
    map $_->dump, $red, $yel, $foo, $baz;


BEGIN {
    package Apple;

    use Moose;
    use namespace::autoclean;

    has 'color' => (
        is => 'rw',
        isa => 'Str',
    );

    sub serve {
        return 'sliced';
    }

    __PACKAGE__->meta->make_immutable;
    1;
}

BEGIN {
    package Orange;

    use Moose;
    use namespace::autoclean;

    has 'apple' => (
        is => 'ro',
        isa => 'Apple',
        predicate => 'has_apple',
    );

    has 'shape' => (
        is => 'ro',
        isa => 'Str',
    );

    sub serve {
        my $self = shift;
        return $self->has_apple 
             ? $self->apple->serve() 
             : 'squeezed';
    }

    __PACKAGE__->meta->make_immutable;
    1;
}
[download]

I like to put all my extra packages in BEGIN blocks since it makes them as much work as much like they were used as possible. I also put the trailing true value in, so that I can grab them and dump them straight into a separate file if it should become desirable to break them out. This simple step has prevented me from having to rerun zillions of tests via make test and prove

Thanks chromatic and repellent! You both hit upon the same concern: violating encapsulation.

I was most concerned about the odd syntax in the Orange::serve() method:

 31 sub serve {
 32     my $self = shift;
 33     return ( $self->{apple} ) ? $self->{apple}->serve() : 'squeeze
+d';
 34 }
 35
[download]

At first read, $self->{apple} looks like a hash ref, but then we are calling a method from it with the ->serve(). I have not come across that syntax, but it works.

Your suggestions will help as I clean up this code.
Thanks!
sjs

• $self->{apple} is not a hashref. It returns the first object shifted in at: $self{apple} = shift;  ## other objects (hopefully)
• $self is a blessed hashref.
• $self->{apple}->serve() calls ->serve on the object returned by $self->{apple}