File Coverage

blib/lib/Caller/Reverse.pm
Criterion Covered Total %
statement 18 18 100.0
branch 4 4 100.0
condition 6 6 100.0
subroutine 6 6 100.0
pod 2 2 100.0
total 36 36 100.0


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