use 5.005; # SET UP A WINDOW HIERARCHY package Window; my $ids = 1; sub new { bless { id=>$ids++ }, ref($_[0])||$_[0] } use Class::Multimethods; multimethod handle => (Window, Command, OffMode) => sub { print "No window operations available in OffMode\n"; }; multimethod handle => (Window, Command, Mode) => sub { print "Window $_[0]->{id} can't handle a ", ref($_[1]), " command in ", ref($_[2]), " mode\n"; }; package ModalWindow; @ISA = qw( Window ); use Class::Multimethods; multimethod handle => (ModalWindow, ReshapeCommand, Mode) => sub { print "Modal windows can't handle reshape commands\n"; }; multimethod handle => (ModalWindow, Accept, OffMode) => sub { print "Modal window $_[0]->{id} can't accept in OffMode!\n"; }; multimethod handle => (ModalWindow, Accept, Mode) => sub { print "Modal window $_[0]->{id} accepts!\n"; }; package MovableWindow; @ISA = qw( Window ); use Class::Multimethods; multimethod handle => (MovableWindow, Move, OnMode) => sub { print "Moving window $_[0]->{id}!\n"; }; package ResizableWindow; @ISA = qw( MovableWindow ); use Class::Multimethods; multimethod handle => (ResizableWindow, Resize, OnMode) => sub { print "Resizing window $_[0]->{id}!\n"; }; multimethod handle => (ResizableWindow, MoveAndResize, OnMode) => sub { print "Moving and resizing window $_[0]->{id}!\n"; }; # SET UP A COMMAND HIERARCHY package Command; sub new { bless {}, ref($_[0])||$_[0] } package ReshapeCommand; @ISA = qw( Command ); package Accept; @ISA = qw( Command ); package Move; @ISA = qw( ReshapeCommand ); package Resize; @ISA = qw( ReshapeCommand ); package MoveAndResize; @ISA = qw( Move Resize ); # SET UP A MODE HIERARCHY package Mode; sub new { bless {}, ref($_[0])||$_[0] } package OnMode; @ISA = qw( Mode ); package ModalMode; @ISA = qw( Mode ); package OffMode; @ISA = qw( Mode ); # SET UP SOME MULTIMETHODS TO HANDLE THE VARIOUS INTERESTING CASES package main; # CREATE SOME WINDOWS... @window = ( new ModalWindow, new MovableWindow, new ResizableWindow, ); # ...AND SOME COMMANDS... @command = ( new Move, new Resize, new MoveAndResize, new Accept, ); # ...AND SOME MODES... @mode = ( new OffMode, new ModalMode, new OnMode, new OnMode, new OnMode, ); # AND INTERACT THEM ALL... srand(0); for (1..100000) { $w = $window[rand @window]; $c = $command[rand @command]; $m = $mode[rand @mode]; print "handle(",ref($w),",",ref($c),",",ref($m),")...\n\t"; eval { $w->handle($c,$m) } or print $@; }