Profile of /project/perl/lib/Class/DBI/Plugin.pm

File	/project/perl/lib/Class/DBI/Plugin.pm
Statements Executed	40
Statement Execution Time	1.37ms

Subroutines — ordered by exclusive time
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	260µs	907µs	Class::DBI::Plugin::::importClass::DBI::Plugin::import
1	1	1	23µs	23µs	Class::DBI::Plugin::MODIFY_CODE_ATTRIBUTES
1	1	1	20µs	20µs	Class::DBI::Plugin::FETCH_CODE_ATTRIBUTES
0	0	0	0s	0s	Class::DBI::Plugin::::BEGINClass::DBI::Plugin::BEGIN

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					package Class::DBI::Plugin;
2
3	3	77µs			use 5.006;
4	3	73µs	1	24µs	use strict; # spent 24µs making 1 call to strict::import
5	3	587µs			use attributes ();
6
7	1	5µs			our $VERSION = 0.03;
8
9					# Code stolen from Simon Cozens (Maypole)
10	1	7µs			our %remember;
11	2	32µs			# spent 23µs within Class::DBI::Plugin::MODIFY_CODE_ATTRIBUTES which was called # once (23µs+0s) by attributes::import at line 46 of attributes.pm sub MODIFY_CODE_ATTRIBUTES { $remember{ $_[1] } = $_[2]; () }
12	1	25µs			# spent 20µs within Class::DBI::Plugin::FETCH_CODE_ATTRIBUTES which was called # once (20µs+0s) by attributes::get at line 82 of attributes.pm sub FETCH_CODE_ATTRIBUTES { $remember{ $_[1] } }
13
14					sub import
15					# spent 907µs (260+647) within Class::DBI::Plugin::import which was called # once (260µs+647µs) by base::import at line 9 of K2/DB2.pm {
16	3	47µs			my $class = shift;
17					my $caller = caller;
18	3	300µs	1	102µs	no strict 'refs'; # spent 102µs making 1 call to strict::unimport
19					for my $symname ( keys %{ "$class\::" } ) {
20	19	204µs			local *sym = ${ "$class\::" }{ $symname };
21					next unless defined &sym; # We're only in it for the subroutines
22					&sym( $caller ), next # spent 469µs making 1 call to Class::DBI::Plugin::AbstractCount::init
23					if $symname eq 'init';
24					*{ "$caller\::$symname" } = \&sym
25					if grep { defined( $_ ) and $_ eq 'Plugged' } attributes::get( \&sym ); # spent 178µs making 1 call to attributes::get
26					}
27					}
28
29	1	11µs			1;
30					__END__
31
32					=head1 NAME
33
34					Class::DBI::Plugin - Abstract base class for Class::DBI plugins
35
36					=head1 SYNOPSIS
37
38					use base 'Class::DBI::Plugin';
39
40					sub init {
41					my $class = shift;
42					$class->set_sql( statement_name => ... );
43					$class->add_trigger( ... );
44					$class->columns( TEMP => ... );
45					}
46
47					sub method_name : Plugged {
48					my $class = shift;
49					$class->sql_statement_name( ... );
50					}
51
52					sub this_method_is_not_exported {}
53
54					=head1 DESCRIPTION
55
56					Class::DBI::Plugin is an abstract base class for Class::DBI plugins. Its
57					purpose is to make writing plugins easier. Writers of plugins should be able
58					to concentrate on the functionality their module provides, instead of having
59					to deal with the symbol table hackery involved when writing a plugin
60					module.
61					Only three things must be remembered:
62
63					=over
64
65					=item 1
66
67					All methods which are to exported are given the "Plugged" attribute. All other
68					methods are not exported to the plugged-in class.
69
70					=item 2
71
72					Method calls which are to be sent to the plugged-in class are put in the
73					init() method. Examples of these are set_sql(), add_trigger() and so on.
74
75					=item 3
76
77					The class parameter for the init() method and the "Plugged" methods is the
78					plugged-in class, not the plugin class.
79
80					=back
81
82					=head1 CAVEATS
83
84					So far this module only "sees" methods in the plugin module itself. If there
85					is a class between the base class and the plugin class in the inheritance
86					hierarchy, methods of this class will not be found. In other words, inherited
87					methods will not be found. If requested, I will implement this behaviour.
88
89					=head1 TODO
90
91					It may be useful for plugin users to be able to choose only the plugin methods
92					they are interested in, if there are more than one. This is not implemented yet.
93
94					=head1 SEE ALSO
95
96					=over
97
98					=item *
99
100					Class::DBI
101
102					=back
103
104					=head1 AUTHOR
105
106					Jean-Christophe Zeus, E<lt>mail@jczeus.comE<gt> with some help from Simon
107					Cozens. Many thanks to Mark Addison for the idea with the init() method, and
108					many thanks to Steven Quinney for the idea with the subroutine attributes.
109
110					=head1 COPYRIGHT AND LICENSE
111
112					Copyright (C) 2004 by Jean-Christophe Zeus
113
114					This library is free software; you can redistribute it and/or modify
115					it under the same terms as Perl itself.
116
117					=cut