File Coverage

blib/lib/Devel/Sub/Which.pm

Criterion	Covered	Total	%
statement	34	35	97.1
branch	7	8	87.5
condition	5	9	55.5
subroutine	9	9	100.0
pod	2	2	100.0
total	57	63	90.4

#!/usr/bin/perl

use 5.006;

package Devel::Sub::Which;

use strict;
use warnings;

our $VERSION = "0.05";

use Sub::Identify qw(sub_fullname);
use Scalar::Util qw/reftype/;
use Carp qw/croak/;

use Sub::Exporter -setup => {
	exports => [qw(which ref_to_name)],
	collectors => {
		':universal' => sub { *UNIVERSAL::which = \&which; return 1 },
	}
};

sub which ($;$) {
	my $obj = shift;
	my $sub = shift;

	return sub_fullname($obj) if not defined $sub; # just a sub, no object

	if (ref($sub) and reftype($sub) eq 'CODE'){
		return sub_fullname($sub);
	} else {
		my $ref = $obj->can($sub);
		croak("$obj\->can($sub) did not return a code reference")
			unless ref($ref) and reftype($ref) eq 'CODE';
		return sub_fullname($ref);
	}
}

sub ref_to_name ($) {
	my $sub = shift;

	unless (ref($sub) and reftype($sub) eq 'CODE'){
		croak "$sub is not a code reference";
	}

	sub_fullname($sub);
}

__PACKAGE__

__END__