← 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:46 2010

File /project/perl/lib/Class/DBI/Search/Basic.pm
Statements Executed 11
Statement Execution Time 1.48ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
0000s0sClass::DBI::Search::Basic::::BEGINClass::DBI::Search::Basic::BEGIN
0000s0sClass::DBI::Search::Basic::::__ANON__[:115]Class::DBI::Search::Basic::__ANON__[:115]
0000s0sClass::DBI::Search::Basic::::_qualClass::DBI::Search::Basic::_qual
0000s0sClass::DBI::Search::Basic::::_qual_bindClass::DBI::Search::Basic::_qual_bind
0000s0sClass::DBI::Search::Basic::::_search_forClass::DBI::Search::Basic::_search_for
0000s0sClass::DBI::Search::Basic::::_unpack_argsClass::DBI::Search::Basic::_unpack_args
0000s0sClass::DBI::Search::Basic::::bindClass::DBI::Search::Basic::bind
0000s0sClass::DBI::Search::Basic::::fragmentClass::DBI::Search::Basic::fragment
0000s0sClass::DBI::Search::Basic::::newClass::DBI::Search::Basic::new
0000s0sClass::DBI::Search::Basic::::optClass::DBI::Search::Basic::opt
0000s0sClass::DBI::Search::Basic::::run_searchClass::DBI::Search::Basic::run_search
0000s0sClass::DBI::Search::Basic::::sqlClass::DBI::Search::Basic::sql
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::Search::Basic;
2
3=head1 NAME
4
5Class::DBI::Search::Basic - Simple Class::DBI search
6
7=head1 SYNOPSIS
8
9 my $searcher = Class::DBI::Search::Basic->new(
10 $cdbi_class, @search_args
11 );
12
13 my @results = $searcher->run_search;
14
15 # Over in your Class::DBI subclass:
16
17 __PACKAGE__->add_searcher(
18 search => "Class::DBI::Search::Basic",
19 isearch => "Class::DBI::Search::Plugin::CaseInsensitive",
20 );
21
22=head1 DESCRIPTION
23
24This is the start of a pluggable Search infrastructure for Class::DBI.
25
26At the minute Class::DBI::Search::Basic doubles up as both the default
27search within Class::DBI as well as the search base class. We will
28probably need to tease this apart more later and create an abstract base
29class for search plugins.
30
31=head1 METHODS
32
33=head2 new
34
35 my $searcher = Class::DBI::Search::Basic->new(
36 $cdbi_class, @search_args
37 );
38
39A Searcher is created with the class to which the results will belong,
40and the arguments passed to the search call by the user.
41
42=head2 opt
43
44 if (my $order = $self->opt('order_by')) { ... }
45
46The arguments passed to search may contain an options hash. This will
47return the value of a given option.
48
49=head2 run_search
50
51 my @results = $searcher->run_search;
52 my $iterator = $searcher->run_search;
53
54Actually run the search.
55
56=head1 SUBCLASSING
57
58=head2 sql / bind / fragment
59
60The actual mechanics of generating the SQL and executing it split up
61into a variety of methods for you to override.
62
63run_search() is implemented as:
64
65 return $cdbi->sth_to_objects($self->sql, $self->bind);
66
67Where sql() is
68
69 $cdbi->sql_Retrieve($self->fragment);
70
71
72There are also a variety of private methods underneath this that could
73be overriden in a pinch, but if you need to do this I'd rather you let
74me know so that I can make them public, or at least so that I don't
75remove them from under your feet.
76
77=cut
78
79387µs125µsuse strict;
# spent 25µs making 1 call to strict::import
80392µs1138µsuse warnings;
# spent 138µs making 1 call to warnings::import
81
8231.25ms10suse base 'Class::Accessor::Fast';
# spent 263µs making 1 call to base::import, recursion: max depth 3, time 263µs
83138µs1905µs__PACKAGE__->mk_accessors(qw/class args opts type/);
# spent 905µs making 1 call to Class::Accessor::mk_accessors
84
85sub new {
86 my ($me, $proto, @args) = @_;
87 my ($args, $opts) = $me->_unpack_args(@args);
88 bless {
89 class => ref $proto || $proto,
90 args => $args,
91 opts => $opts,
92 type => "=",
93 } => $me;
94}
95
96sub opt {
97 my ($self, $option) = @_;
98 $self->{opts}->{$option};
99}
100
101sub _unpack_args {
102 my ($self, @args) = @_;
103 @args = %{ $args[0] } if ref $args[0] eq "HASH";
104 my $opts = @args % 2 ? pop @args : {};
105 return (\@args, $opts);
106}
107
108sub _search_for {
109 my $self = shift;
110 my @args = @{ $self->{args} };
111 my $class = $self->{class};
112 my %search_for;
113 while (my ($col, $val) = splice @args, 0, 2) {
114 my $column = $class->find_column($col)
115 || (List::Util::first { $_->accessor eq $col } $class->columns)
116 || $class->_croak("$col is not a column of $class");
117 $search_for{$column} = $class->_deflated_column($column, $val);
118 }
119 return \%search_for;
120}
121
122sub _qual_bind {
123 my $self = shift;
124 $self->{_qual_bind} ||= do {
125 my $search_for = $self->_search_for;
126 my $type = $self->type;
127 my (@qual, @bind);
128 for my $column (sort keys %$search_for) { # sort for prepare_cached
129 if (defined(my $value = $search_for->{$column})) {
130 push @qual, "$column $type ?";
131 push @bind, $value;
132 } else {
133
134 # perhaps _carp if $type ne "="
135 push @qual, "$column IS NULL";
136 }
137 }
138 [ \@qual, \@bind ];
139 };
140}
141
142sub _qual {
143 my $self = shift;
144 $self->{_qual} ||= $self->_qual_bind->[0];
145}
146
147sub bind {
148 my $self = shift;
149 $self->{_bind} ||= $self->_qual_bind->[1];
150}
151
152sub fragment {
153 my $self = shift;
154 my $frag = join " AND ", @{ $self->_qual };
155 if (my $order = $self->opt('order_by')) {
156 $frag .= " ORDER BY $order";
157 }
158 return $frag;
159}
160
161sub sql {
162 my $self = shift;
163 return $self->class->sql_Retrieve($self->fragment);
164}
165
166sub run_search {
167 my $self = shift;
168 my $cdbi = $self->class;
169 return $cdbi->sth_to_objects($self->sql, $self->bind);
170}
171
172116µs1;
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.