File Coverage

blib/lib/Subs/Trace.pm
Criterion Covered Total %
statement 23 23 100.0
branch 2 2 100.0
condition n/a
subroutine 7 7 100.0
pod n/a
total 32 32 100.0


line stmt bran cond sub pod time code
1             package Subs::Trace;
2              
3 2     2   129710 use 5.006;
  2         14  
4 2     2   9 use strict;
  2         4  
  2         33  
5 2     2   7 use warnings;
  2         3  
  2         120  
6              
7             =head1 NAME
8              
9             Subs::Trace - Trace all calls in a package.
10              
11             =head1 VERSION
12              
13             Version 0.06
14              
15             =cut
16              
17             our $VERSION = '0.06';
18              
19             =head1 SYNOPSIS
20              
21             Similar to
22              
23             around 'my_function' => sub {
24             my $original = shift;
25             print "--> my_function\n";
26             $original->(@_);
27             };
28              
29             But for ALL functions in a class.
30              
31             package MyClass;
32              
33             sub Func1 { ... }
34             sub Func2 { ... }
35             sub Func3 { ... }
36              
37             use Subs::Trace;
38              
39             Func1();
40             # Prints:
41             # --> MyClass::Func1
42              
43             =head1 DESCRIPTION
44              
45             This module updates all methods/functions in a class to
46             also print a message when invoked.
47              
48             =head1 SUBROUTINES/METHODS
49              
50             =head2 import
51              
52             NOTE: This must be put at the very bottom of a class.
53              
54             Also, some reason C is not being called with Moose.
55              
56             Will attach hooks to all functions defined BEFORE this import call.
57              
58             =cut
59              
60             sub import {
61 2     2   13 my $pkg = caller();
62              
63             # print "pkg=$pkg\n";
64              
65 2     2   12 no strict 'refs';
  2         4  
  2         66  
66 2     2   9 no warnings 'redefine';
  2         3  
  2         296  
67              
68 2         2 for my $func ( sort keys %{"${pkg}::"} ) {
  2         12  
69              
70             # print "func=$func\n";
71              
72 8         13 my $stash = "$pkg\::$func";
73 8         14 my $code = *$stash{CODE};
74 8 100       12 next if not $code;
75              
76             # print " Updated $stash\n";
77              
78             *$stash = sub {
79 5     5   1933 print "--> $pkg\::$func\n";
80 5         12 &$code;
81             }
82 6         1377 }
83             }
84              
85             =head1 AUTHOR
86              
87             Tim Potapov, C<< >>
88              
89             =head1 BUGS
90              
91             Please report any bugs or feature requests to L.
92              
93             =head1 SUPPORT
94              
95             You can find documentation for this module with the perldoc command.
96              
97             perldoc Subs::Trace
98              
99             =head1 ACKNOWLEDGEMENTS
100              
101             TBD
102              
103             =head1 LICENSE AND COPYRIGHT
104              
105             This software is Copyright (c) 2022 by Tim Potapov.
106              
107             This is free software, licensed under:
108              
109             The Artistic License 2.0 (GPL Compatible)
110              
111              
112             =cut
113              
114             1; # End of Subs::Trace