use
warnings
qw(FATAL all NONFATAL misc)
;
our
@EXPORT
=
qw(FindMethods)
;
sub
FindMethods {
my
(
$obj
,
$pattern
,
$visited
,
$found
) =
@_
;
$visited
||= {};
$found
||= {};
my
$class
=
ref
(
$obj
) ?
ref
(
$obj
) :
$obj
;
$visited
->{
$class
} = 1;
my
$symtab
= symtab(
$class
);
local
$_
;
foreach
my
$orig
(
keys
%$symtab
) {
$_
=
$orig
;
if
(
$pattern
) {
if
(
ref
$pattern
eq
'CODE'
) {
$pattern
->(
$_
) or
next
;
}
else
{
$_
=~
$pattern
or
next
;
}
}
my
$glob
=
$symtab
->{
$orig
};
next
unless
*{
$glob
}{CODE};
$found
->{
$_
} //=
$class
;
}
my
$isa
=
$symtab
->{ISA};
if
(
defined
$isa
and *{
$isa
}{ARRAY}) {
foreach
my
$super
(@{*{
$isa
}{ARRAY}}) {
FindMethods(
$super
,
$pattern
,
$visited
,
$found
)
unless
$visited
->{
$super
};
}
}
if
(
wantarray
) {
sort
keys
%$found
}
else
{
$found
;
}
}
1;