/usr/share/doc/libclass-multimethods-perl/examples/demo.newmulti.pl is in libclass-multimethods-perl 1.701-1.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 | #!/usr/bin/env perl -w
use 5.005;
use NewMultimethods;
# SET UP A WINDOW HIERARCHY
package Window;
my $ids = 1;
sub new { bless { id=>$ids++ }, ref($_[0])||$_[0] }
multi handle (Window, Command, OffMode)
{
print "No window operations available in OffMode\n";
};
multi handle (Window, Command, Mode)
{
print "Window $_[0]->{id} can't handle a ",
ref($_[1]), " command in ",
ref($_[2]), " mode\n";
};
package ModalWindow; @ISA = qw( Window );
multi handle (ModalWindow, ReshapeCommand, Mode)
{
print "Modal windows can't handle reshape commands\n";
}
multi handle (ModalWindow, Accept, OffMode)
{
print "Modal window $_[0]->{id} can't accept in OffMode!\n";
}
multi handle (ModalWindow, Accept, Mode)
{
print "Modal window $_[0]->{id} accepts!\n";
}
package MovableWindow; @ISA = qw( Window );
multi handle (MovableWindow, Move, OnMode)
{
print "Moving window $_[0]->{id}!\n";
};
package ResizableWindow; @ISA = qw( MovableWindow );
multi handle (ResizableWindow, Resize, OnMode)
{
print "Resizing window $_[0]->{id}!\n";
};
multi handle (ResizableWindow, MoveAndResize, OnMode)
{
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 $@;
}
|