sub UNIVERSAL::new
{ bless {}, $_[0] }

package Peg;
package RoundPeg; @ISA = qw( Peg );

package Hole;
package SquareHole; @ISA = qw( Hole );

package main;

use Class::Multimethods;

multimethod put_peg => (RoundPeg,Hole)
	=> sub { print "a round peg in any old hole\n"; };

multimethod put_peg => (Peg,SquareHole)
	=> sub { print "any old peg in a square hole\n"; };

multimethod put_peg => (Peg,Hole)
	=> sub { print "any old peg in any old hole\n"; };

eval { put_peg( RoundPeg->new(), SquareHole->new() ) } or print $@;

resolve_ambiguous put_peg => (Peg,Hole);

eval { put_peg( RoundPeg->new(), SquareHole->new() ) } or print $@;

sub disambiguator { print "Sa-rah Con-nor?\n" }

resolve_ambiguous put_peg => \&disambiguator;
eval { put_peg( RoundPeg->new(), SquareHole->new() ) } or print $@;

resolve_ambiguous put_peg
	=> sub { print "can't put a ", ref($_[0]), " into a ", ref($_[1]), "\n"
};
eval { put_peg( RoundPeg->new(), SquareHole->new() ) } or print $@;

eval { put_peg( JPEG->new(), Loophole->new() ); } or print $@;

resolve_no_match put_peg => sub
{
	my ($p_type, $h_type) = @_;

	$_[0]->display($_[1])	if $p_type =~ /[JM]PEG/;
	call_plumber()	if $p_type eq 'ClothesPeg' && $h_type eq 'DrainHole';
	$_[1]->crush($_[0])	if $h_type eq 'BlackHole';

	# etc.
};

eval { put_peg( JPEG->new(), Loophole->new() ); } or print $@;

#########################################################################
#                                                                       #
#  Copyright (C) 1999 by Manning Publications Co. All Rights Reserved.  #
#                                                                       #
#  This code is free software. It may be used, redistributed            #
#  and/or modified under the terms of the Perl Artistic License         #
#  (see http://www.perl.com/perl/misc/Artistic.html).                   #
#                                                                       #
#########################################################################

