use warnings;
use strict;

package Foo::Bar;

our $crHandler = sub {
  print "$_[0]: default handler called.\n";
};

sub doA1 { print "Doing A1 for $_[1]\n"; &$crHandler('A1'); }
sub doB1 { print "Doing B1 for $_[1]\n"; &$crHandler('B1'); }
sub doA2 { print "Doing A2 for $_[1]\n"; &$crHandler('A2'); }
sub doB2 { print "Doing B2 for $_[1]\n"; &$crHandler('B2'); }


##</code><code>##

use warnings;
use strict;
package Foo::Baz;

#-----------------------------------------------
# import specially wrapped methods from Foo::Bar
# that call custom handler and default to user
# define global handler
#-----------------------------------------------

BEGIN {
  my $CLASS = __PACKAGE__;

  require Foo::Bar;

  # generates wrapper sub
  sub wrapAndCall {
    my $crCall = shift;
    my $crCustom = shift;
    my $crOriginal = $Foo::Bar::crHandler;
    local $Foo::Bar::crHandler = sub {
        return if (&$crCustom(@_));
        if (defined($crOriginal)) {
          &$crOriginal(@_);
        } else {
          print "Original global handler undefined.\n";
        }
      };
    return &$crCall(@_);
  }

  # some custom handlers
  # return 1 if completely handled
  # return 0 if pass through to original global handler
  #   for further processing
  my $crCustomHandler1 = sub {
    print "$_[0]: custom handler 1 called.\n";
    return 0;
  };

  my $crCustomHandler2 = sub {
    print "$_[0]: custom handler 2 called.\n";
    return 0;
  };

  # manufacture and assign the wrappers
  {
    no strict 'refs';

    #import all of the subs using custom handler 1
    foreach my $sMethod (qw(doA1 doB1)) {
      *{"${CLASS}::$sMethod"} = sub {
        return wrapAndCall(*{"Foo::Bar::$sMethod"}
                           , $crCustomHandler1, @_);
      };
    }

    #import all of the subs using custom handler 2
    foreach my $sMethod (qw(doA2 doB2)) {
      *{"${CLASS}::$sMethod"} = sub {
        return wrapAndCall(*{"Foo::Bar::$sMethod"}
                         , $crCustomHandler2, @_);
      };
    }
  }
}

#-----------------------------------------------
# define the rest of the methods
#-----------------------------------------------

sub new {  return bless([], shift); }


#-----------------------------------------------
# module return
#-----------------------------------------------
return 1;

##</code><code>##

use warnings;
use strict;
use Foo::Baz;


my $oFoo = Foo::Baz->new();
print "created \$oFoo=<$oFoo>\n";

print "\n**demoing default global handler**\n";
$oFoo->doA1('Ayelet (deer)');

print "\n**undefining global handler**\n";
$Foo::Bar::crHandler = undef;
$oFoo->doA2('Mayan (spring)');

print "\n**reassigning global handler to non-default sub**\n";
$Foo::Bar::crHandler = sub {
  print "$_[0]: replacement handler called\n";
};
$oFoo->doB2('Dov (bear)');