#!/usr/bin/perl -w
use strict;

package BaseClass;
use strict;

sub new {
   my $class = shift;
   my $self  = {}; 
   bless $self, $class;
   $self;
}

sub bar {
   return Foo->new;
}

package Foo;
use strict;
use Carp;
use base qw(BaseClass);

sub baz {"Some data"}

sub bar {
    my $self = shift;

    warn "bar";

    croak "don't chain method calls"
        if $self->{chained};

    my $ret = $self->SUPER::bar(@_);

    $ret->{chained} = 1;
    return $ret;
}

package main;
use strict;

my $o = Foo->new;

print $o->bar->bar->bar->bar->bar->bar->bar->bar->bar->bar->bar->bar->bar->bar->baz;

__END__
bar at -e line 1.
bar at -e line 1.
don't chain method calls to bar at -e line 0