File Coverage

blib/lib/Caller/First.pm
Criterion Covered Total %
statement 17 17 100.0
branch 4 4 100.0
condition 3 3 100.0
subroutine 5 5 100.0
pod 1 1 100.0
total 30 30 100.0


line stmt bran cond sub pod time code
1             package Caller::First;
2              
3 2     2   124248 use 5.006;
  2         14  
4 2     2   9 use strict;
  2         4  
  2         35  
5 2     2   20 use warnings;
  2         4  
  2         102  
6             our $VERSION = '0.01';
7              
8 2     2   13 use base 'Import::Export';
  2         4  
  2         974  
9              
10             our %EX = (
11             caller_first => [qw/all/]
12             );
13              
14             sub caller_first {
15 5     5 1 313 my ($n, @last) = (0);
16 5         33 while (my @l = (caller($n))) {
17 7 100 100     29 !$_[0] && $l[0] eq 'main' ? last : do {
18 4         9 @last = @l;
19 4         15 $n++;
20             };
21             }
22 5 100       24 return wantarray ? @last : shift @last;
23             }
24              
25             # If you know how to do this beter then please raise a ticket
26             # I was hoping for something like caller(-1).
27              
28             =head1 NAME
29              
30             Caller::First - first|last caller from the stack.
31              
32             =head1 VERSION
33              
34             Version 0.01
35              
36             =cut
37              
38             =head1 SYNOPSIS
39              
40             use Caller::First qw/caller_first/;
41              
42             my @caller = caller_first();
43              
44             =head1 DESCRIPTION
45              
46             This is a quick module to return the first caller from the stack.
47              
48             =cut
49              
50             =head1 EXPORT
51              
52             A list of functions that can be exported.
53              
54             =head2 caller_first
55              
56             Returns the first caller from the stack. In scalar context this will return the package name and in list context you will get the full caller response. See L for more information.
57              
58             my $package = caller_first();
59             my @caller = caller_first();
60              
61             =cut
62              
63             =head1 AUTHOR
64              
65             LNATION, C<< >>
66              
67             =head1 BUGS
68              
69             Please report any bugs or feature requests to C, or through
70             the web interface at L. I will be notified, and then you'll
71             automatically be notified of progress on your bug as I make changes.
72              
73             =head1 SUPPORT
74              
75             You can find documentation for this module with the perldoc command.
76              
77             perldoc Caller::First
78              
79              
80             You can also look for information at:
81              
82             =over 4
83              
84             =item * RT: CPAN's request tracker (report bugs here)
85              
86             L
87              
88             =item * AnnoCPAN: Annotated CPAN documentation
89              
90             L
91              
92             =item * CPAN Ratings
93              
94             L
95              
96             =item * Search CPAN
97              
98             L
99              
100             =back
101              
102              
103             =head1 ACKNOWLEDGEMENTS
104              
105              
106             =head1 LICENSE AND COPYRIGHT
107              
108             This software is Copyright (c) 2020 by LNATION.
109              
110             This is free software, licensed under:
111              
112             The Artistic License 2.0 (GPL Compatible)
113              
114              
115             =cut
116              
117             1; # End of Caller::First