Profile of Contextual/Return/Failure.pm

Filename	/home/hejohns/perl5/lib/perl5/Contextual/Return/Failure.pm
Statements	Executed 10 statements in 396µs

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	10µs	53µs	Contextual::Return::Failure::::BEGIN@4Contextual::Return::Failure::BEGIN@4
1	1	1	4µs	6µs	Contextual::Return::Failure::::BEGIN@8Contextual::Return::Failure::BEGIN@8
1	1	1	4µs	20µs	Contextual::Return::Failure::::BEGIN@7Contextual::Return::Failure::BEGIN@7
1	1	1	2µs	2µs	Contextual::Return::Failure::::BEGIN@5Contextual::Return::Failure::BEGIN@5
0	0	0	0s	0s	Contextual::Return::Failure::::_FAILContextual::Return::Failure::_FAIL
0	0	0	0s	0s	Contextual::Return::Failure::_FAIL_WITH
0	0	0	0s	0s	Contextual::Return::Failure::__ANON__[:102]
0	0	0	0s	0s	Contextual::Return::Failure::__ANON__[:112]
0	0	0	0s	0s	Contextual::Return::Failure::__ANON__[:114]
0	0	0	0s	0s	Contextual::Return::Failure::__ANON__[:115]

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package Contextual::Return::Failure;
2	1	300ns			our $VERSION = 0.000_003;
3
4	2	21µs	2	53µs	# spent 53µs (10+44) within Contextual::Return::Failure::BEGIN@4 which was called: # once (10µs+44µs) by Contextual::Return::import at line 4 use Contextual::Return; # spent 53µs making 1 call to Contextual::Return::Failure::BEGIN@4 # spent 44µs making 1 call to Contextual::Return::import, recursion: max depth 1, sum of overlapping time 44µs
5	1	14µs	1	2µs	# spent 2µs within Contextual::Return::Failure::BEGIN@5 which was called: # once (2µs+0s) by Contextual::Return::import at line 5 BEGIN { _in_context = Contextual::Return::_in_context } # spent 2µs making 1 call to Contextual::Return::Failure::BEGIN@5
6
7	2	14µs	2	37µs	# spent 20µs (4+17) within Contextual::Return::Failure::BEGIN@7 which was called: # once (4µs+17µs) by Contextual::Return::import at line 7 use warnings; # spent 20µs making 1 call to Contextual::Return::Failure::BEGIN@7 # spent 17µs making 1 call to warnings::import
8	2	345µs	2	8µs	# spent 6µs (4+2) within Contextual::Return::Failure::BEGIN@8 which was called: # once (4µs+2µs) by Contextual::Return::import at line 8 use strict; # spent 6µs making 1 call to Contextual::Return::Failure::BEGIN@8 # spent 2µs making 1 call to strict::import
9
10	1	200ns			my %handler_for;
11
12					sub _FAIL_WITH {
13					# Unpack and vet args...
14					my $flag = shift;
15					my $selector_ref;
16					if (ref $flag eq 'HASH') {
17					$selector_ref = $flag;
18					$flag = undef;
19					}
20					else {
21					$selector_ref = shift;
22					die _in_context 'Usage: FAIL_WITH $flag_opt, \%selector, @args'
23					if ref $selector_ref ne 'HASH';
24					}
25					die _in_context "Selector values must be sub refs"
26					if grep {ref ne 'CODE'} values %{$selector_ref};
27
28					# Search for handler sub;
29					my $handler;
30					if (defined $flag) {
31					ARG:
32					while (@_) {
33					last ARG if shift(@_) eq $flag;
34					}
35					my $selector = shift @_;
36					if (ref $selector eq 'CODE') {
37					$handler = $selector;
38					@_ = ();
39					}
40					else {
41					@_ = $selector;
42					}
43					}
44
45					SELECTION:
46					for my $selection (reverse @_) {
47					if (exists $selector_ref->{$selection}) {
48					$handler = $selector_ref->{$selection};
49					last SELECTION;
50					}
51					elsif ($flag) {
52					die _in_context "Invalid option: $flag => $selection";
53					}
54					}
55
56					# (Re)set handler...
57					if ($handler) {
58					my $caller_loc = join '\|', (CORE::caller 1)[0,1];
59					if (exists $handler_for{$caller_loc}) {
60					warn _in_context "FAIL handler for package ", scalar CORE::caller, " redefined";
61					}
62					$handler_for{$caller_loc} = $handler;
63					}
64					};
65
66					sub _FAIL (;&) {
67					# Generate args...
68					my $arg_generator_ref = shift;
69					my @args;
70					if ($arg_generator_ref) {
71					package DB;
72
- -
76					# Handle user-defined failure semantics...
77					my $caller_loc = join '\|', (CORE::caller 1)[0,1];
78					if (exists $handler_for{$caller_loc} ) {
79					# Fake out caller() and Carp...
80					local $Contextual::Return::uplevel = 1;
81
82					return $handler_for{$caller_loc}->(@args);
83					}
84
85					my $exception = @args == 1 ? $args[0]
86					: @args > 0 ? join(q{}, @args)
87					: "Call to " . (CORE::caller 1)[3] . "() failed"
88					;
89
90					# Join message with croak() semantics, if string...
91					if (!ref $exception) {
92					$exception .= _in_context @_;
93					}
94
95					# # Check for immediate failure...
96					# use Want qw( want );
97					# return 0 if want 'BOOL';
98					# die $exception if !want 'SCALAR';
99
100					# Return a delayed failure object...
101					return
102					BOOL { 0 }
103					DEFAULT {
104					if (ref $exception) {
105					my $message = "$exception";
106					$message =~ s/$/\n/;
107					die _in_context $message, "Attempted to use failure value";
108					}
109					else {
110					die _in_context $exception, "Attempted to use failure value";
111					}
112					}
113					METHOD {
114					error => sub { _in_context $exception }
115					}
116					}
117
118	1	2µs			1;
119
120					__END__