← 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:57:06 2010

File /project/perl/lib/Class/DBI/Query.pm
Statements Executed 14
Statement Execution Time 1.78ms
Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
0000s0sClass::DBI::Query::::BEGIN Class::DBI::Query::BEGIN
0000s0sClass::DBI::Query::Base::::BEGINClass::DBI::Query::Base::BEGIN
0000s0sClass::DBI::Query::Base::::cloneClass::DBI::Query::Base::clone
0000s0sClass::DBI::Query::Base::::getClass::DBI::Query::Base::get
0000s0sClass::DBI::Query::Base::::newClass::DBI::Query::Base::new
0000s0sClass::DBI::Query::Base::::setClass::DBI::Query::Base::set
0000s0sClass::DBI::Query::::_essential_string Class::DBI::Query::_essential_string
0000s0sClass::DBI::Query::::add_restriction Class::DBI::Query::add_restriction
0000s0sClass::DBI::Query::::new Class::DBI::Query::new
0000s0sClass::DBI::Query::::run Class::DBI::Query::run
0000s0sClass::DBI::Query::::tables Class::DBI::Query::tables
0000s0sClass::DBI::Query::::where Class::DBI::Query::where
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::Query::Base;
2
33108µs125µsuse strict;
# spent 25µs making 1 call to strict::import
4
5387µs10suse base 'Class::Accessor';
# spent 252µs making 1 call to base::import, recursion: max depth 3, time 252µs
63473µs1181µsuse Storable 'dclone';
# spent 181µs making 1 call to Exporter::import
7
8sub new {
9 my ($class, $fields) = @_;
10 my $self = $class->SUPER::new();
11 foreach my $key (keys %{ $fields || {} }) {
12 $self->set($key => $fields->{$key});
13 }
14 $self;
15}
16
17sub get {
18 my ($self, $key) = @_;
19 my @vals = @{ $self->{$key} || [] };
20 return wantarray ? @vals : $vals[0];
21}
22
23sub set {
24 my ($self, $key, @args) = @_;
25 @args = map { ref $_ eq "ARRAY" ? @$_ : $_ } @args;
26 $self->{$key} = [@args];
27}
28
29sub clone { dclone shift }
30
31package Class::DBI::Query;
32
3331.05ms10suse base 'Class::DBI::Query::Base';
# spent 594µs making 1 call to base::import, recursion: max depth 3, time 594µs
34
35138µs11.48ms__PACKAGE__->mk_accessors(
# spent 1.48ms making 1 call to Class::Accessor::mk_accessors
36 qw/
37 owner essential sqlname where_clause restrictions order_by kings
38 /
39);
40
41=head1 NAME
42
43Class::DBI::Query - Deprecated SQL manager for Class::DBI
44
45=head1 SYNOPSIS
46
47 my $sth = Class::DBI::Query
48 ->new({
49 owner => $class,
50 sqlname => $type,
51 essential => \@columns,
52 where_columns => \@where_cols,
53 })
54 ->run($val);
55
56
57=head1 DESCRIPTION
58
59This abstracts away many of the details of the Class::DBI underlying SQL
60mechanism. For the most part you probably don't want to be interfacing
61directly with this.
62
63The underlying mechanisms are not yet stable, and are subject to change
64at any time.
65
66=cut
67
68=head1 OPTIONS
69
70A Query can have many options set before executing. Most can either be
71passed as an option to new(), or set later if you are building the query
72up dynamically:
73
74=head2 owner
75
76The Class::DBI subclass that 'owns' this query. In the vast majority
77of cases a query will return objects - the owner is the class of
78which instances will be returned.
79
80=head2 sqlname
81
82This should be the name of a query set up using set_sql.
83
84=head2 where_clause
85
86This is the raw SQL that will substituted into the 'WHERE %s' in your
87query. If you have multiple %s's in your query then you should supply
88a listref of where_clauses. This SQL can include placeholders, which will be
89used when you call run().
90
91=head2 essential
92
93When retrieving rows from the database that match the WHERE clause of
94the query, these are the columns that we fetch back and pre-load the
95resulting objects with. By default this is the Essential column group
96of the owner class.
97
98=head1 METHODS
99
100=head2 where()
101
102 $query->where($match, @columns);
103
104This will extend your 'WHERE' clause by adding a 'AND $column = ?' (or
105whatever $match is, isntead of "=") for each column passed. If you have
106multiple WHERE clauses this will extend the last one.
107
108=cut
109
110sub new {
111 my ($class, $self) = @_;
112 require Carp;
113 Carp::carp "Class::DBI::Query deprecated";
114 $self->{owner} ||= caller;
115 $self->{kings} ||= $self->{owner};
116 $self->{essential} ||= [ $self->{owner}->_essential ];
117 $self->{sqlname} ||= 'SearchSQL';
118 return $class->SUPER::new($self);
119}
120
121sub _essential_string {
122 my $self = shift;
123 my $table = $self->owner->table_alias;
124 join ", ", map "$table.$_", $self->essential;
125}
126
127sub where {
128 my ($self, $type, @cols) = @_;
129 my @where = $self->where_clause;
130 my $last = pop @where || "";
131 $last .= join " AND ", $self->restrictions;
132 $last .= " ORDER BY " . $self->order_by if $self->order_by;
133 push @where, $last;
134 return @where;
135}
136
137sub add_restriction {
138 my ($self, $sql) = @_;
139 $self->restrictions($self->restrictions, $sql);
140}
141
142sub tables {
143 my $self = shift;
144 join ", ", map { join " ", $_->table, $_->table_alias } $self->kings;
145}
146
147# my $sth = $query->run(@vals);
148# Runs the SQL set up in $sqlname, e.g.
149#
150# SELECT %s (Essential)
151# FROM %s (Table)
152# WHERE %s = ? (SelectCol = @vals)
153#
154# substituting the relevant values via sprintf, and then executing with $select_val.
155
156sub run {
157 my $self = shift;
158 my $owner = $self->owner or Class::DBI->_croak("Query has no owner");
159 $owner = ref $owner || $owner;
160 $owner->can('db_Main') or $owner->_croak("No database connection defined");
161 my $sql_name = $self->sqlname or $owner->_croak("Query has no SQL");
162
163 my @sel_vals = @_
164 ? ref $_[0] eq "ARRAY" ? @{ $_[0] } : (@_)
165 : ();
166 my $sql_method = "sql_$sql_name";
167
168 my $sth;
169 eval {
170 $sth =
171 $owner->$sql_method($self->_essential_string, $self->tables,
172 $self->where);
173 $sth->execute(@sel_vals);
174 };
175 if ($@) {
176 $owner->_croak(
177 "Can't select for $owner using '$sth->{Statement}' ($sql_name): $@",
178 err => $@);
179 return;
180 }
181 return $sth;
182}
183
184117µs1;
Report produced by the NYTProf 3.11 Perl profiler, developed by Tim Bunce and Adam Kaplan.