| 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 | Class::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::BEGIN |
| 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 |