← Index
NYTProf Performance Profile   « block view • line view • sub view »
For ddd2.pl
  Run on Tue May 25 16:52:24 2010
Reported on Tue May 25 16:56:47 2010

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
111260µs907µsClass::DBI::Plugin::::importClass::DBI::Plugin::import
11123µs23µsClass::DBI::Plugin::::MODIFY_CODE_ATTRIBUTESClass::DBI::Plugin::MODIFY_CODE_ATTRIBUTES
11120µs20µsClass::DBI::Plugin::::FETCH_CODE_ATTRIBUTESClass::DBI::Plugin::FETCH_CODE_ATTRIBUTES
0000s0sClass::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
1package Class::DBI::Plugin;
2
3377µsuse 5.006;
4373µs124µsuse strict;
# spent 24µs making 1 call to strict::import
53587µsuse attributes ();
6
715µsour $VERSION = 0.03;
8
9# Code stolen from Simon Cozens (Maypole)
1017µsour %remember;
11232µ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]; () }
12125µ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
14sub 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
{
1622251µs my $class = shift;
17 my $caller = caller;
183300µs1102µs no strict 'refs';
# spent 102µs making 1 call to strict::unimport
19 for my $symname ( keys %{ "$class\::" } ) {
20 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
29111µs1;
30__END__
31
32=head1 NAME
33
34Class::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
56Class::DBI::Plugin is an abstract base class for Class::DBI plugins. Its
57purpose is to make writing plugins easier. Writers of plugins should be able
58to concentrate on the functionality their module provides, instead of having
59to deal with the symbol table hackery involved when writing a plugin
60module.
61Only three things must be remembered:
62
63=over
64
65=item 1
66
67All methods which are to exported are given the "Plugged" attribute. All other
68methods are not exported to the plugged-in class.
69
70=item 2
71
72Method calls which are to be sent to the plugged-in class are put in the
73init() method. Examples of these are set_sql(), add_trigger() and so on.
74
75=item 3
76
77The class parameter for the init() method and the "Plugged" methods is the
78plugged-in class, not the plugin class.
79
80=back
81
82=head1 CAVEATS
83
84So far this module only "sees" methods in the plugin module itself. If there
85is a class between the base class and the plugin class in the inheritance
86hierarchy, methods of this class will not be found. In other words, inherited
87methods will not be found. If requested, I will implement this behaviour.
88
89=head1 TODO
90
91It may be useful for plugin users to be able to choose only the plugin methods
92they 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
100Class::DBI
101
102=back
103
104=head1 AUTHOR
105
106Jean-Christophe Zeus, E<lt>mail@jczeus.comE<gt> with some help from Simon
107Cozens. Many thanks to Mark Addison for the idea with the init() method, and
108many thanks to Steven Quinney for the idea with the subroutine attributes.
109
110=head1 COPYRIGHT AND LICENSE
111
112Copyright (C) 2004 by Jean-Christophe Zeus
113
114This library is free software; you can redistribute it and/or modify
115it under the same terms as Perl itself.
116
117=cut