root/Attribute-Profiled/trunk/lib/Attribute/Profiled.pm

Revision 255 (checked in by miyagawa, 19 years ago)

add Hook::LexWrap?

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1 package Attribute::Profiled;
2
3 use 5.006;
4 use strict;
5 use warnings;
6
7 our $VERSION = '0.03';
8
9 use Attribute::Handlers;
10 use Hook::LexWrap;
11
12 our $_Profiler;
13
14 sub UNIVERSAL::Profiled : ATTR(CODE) {
15     my($package, $symbol, $referent, $attr, $data, $phase) = @_;
16     my $meth = *{$symbol}{NAME};
17     no warnings 'redefine';
18
19     wrap $symbol,
20         pre  => sub {
21             unless ($_Profiler) {
22                 $_Profiler = Benchmark::Timer::ReportOnDestroy->new;
23             }
24             $_Profiler->start("$package\::$meth");
25         },
26         post => sub {
27             $_Profiler->stop("$package\::$meth");
28         };
29 }
30
31 package Benchmark::Timer::ReportOnDestroy;
32 use base qw(Benchmark::Timer);
33
34 sub DESTROY {
35     my $self = shift;
36     $self->report;
37 }
38
39
40 1;
41 __END__
42
43 =head1 NAME
44
45 Attribute::Profiled - Profiles specific methods in class
46
47 =head1 SYNOPSIS
48
49   package SomeClass;
50   use Attribute::Profiled;
51
52   sub long_running_method : Profiled { }
53
54 =head1 DESCRIPTION
55
56 Attribute::Profiled provides a way to profile specific methods with
57 attributes. This module uses Benchmark::Timer to profile elapsed times
58 for your calls to the methods with Profiled attribute on.
59
60 Profiling report will be printed to STDERR at the end of program
61 execution.
62
63 =head1 TODO
64
65 =over 4
66
67 =item *
68
69 Options where to print profiling report.
70
71 =item *
72
73 Allows public way to get reports in any timing other than the end of
74 execution. Currently you can do it by explicitly calling report() on
75 C<$Attribute::Profiled::_Profiler>.
76
77 =back
78
79 =head1 AUTHOR
80
81 Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
82
83 This library is free software; you can redistribute it and/or
84 modify it under the same terms as Perl itself.
85
86 =head1 SEE ALSO
87
88 L<Attribute::Handlers>, L<Benchmark::Timer>
89
90 =cut
Note: See TracBrowser for help on using the browser.