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