File | /project/perl/lib/Class/DBI/Plugin.pm |
Statements Executed | 40 |
Statement Execution Time | 1.37ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 260µs | 907µs | import | Class::DBI::Plugin::
1 | 1 | 1 | 23µs | 23µs | MODIFY_CODE_ATTRIBUTES | Class::DBI::Plugin::
1 | 1 | 1 | 20µs | 20µs | FETCH_CODE_ATTRIBUTES | Class::DBI::Plugin::
0 | 0 | 0 | 0s | 0s | BEGIN | Class::DBI::Plugin::
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 | ||
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 | ||
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 | 1 | 6µs | my $class = shift; | ||
17 | 1 | 6µs | my $caller = caller; | ||
18 | 3 | 300µs | 1 | 102µs | no strict 'refs'; # spent 102µs making 1 call to strict::unimport |
19 | 1 | 66µs | for my $symname ( keys %{ "$class\::" } ) { | ||
20 | 8 | 74µs | local *sym = ${ "$class\::" }{ $symname }; | ||
21 | 8 | 39µs | next unless defined &sym; # We're only in it for the subroutines | ||
22 | 2 | 22µs | 1 | 469µs | &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 | 1 | 38µs | 1 | 178µs | 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 |