File Coverage

blib/lib/Class/DBI/Query.pm
Criterion Covered Total %
statement 62 66 93.9
branch 15 22 68.2
condition 7 15 46.7
subroutine 13 14 92.9
pod n/a
total 97 117 82.9


line stmt bran cond sub pod time code
1             package Class::DBI::Query::Base;
2              
3 24     24   363 use strict;
  24         337  
  24         362  
4              
5 24     24   527 use base 'Class::Accessor';
  24         323  
  24         371  
6 24     24   406 use Storable 'dclone';
  24         258  
  24         944  
7              
8             sub new {
9 7     7   65 my ($class, $fields) = @_;
10 7         132 my $self = $class->SUPER::new();
11 7 50       248 foreach my $key (keys %{ $fields || {} }) {
  7         99  
12 30         370 $self->set($key => $fields->{$key});
13             }
14 7         110 $self;
15             }
16              
17             sub get {
18 68     68   1367 my ($self, $key) = @_;
19 68 100       542 my @vals = @{ $self->{$key} || [] };
  68         842  
20 68 100       2643 return wantarray ? @vals : $vals[0];
21             }
22              
23             sub set {
24 46     46   665 my ($self, $key, @args) = @_;
25 46 100       484 @args = map { ref $_ eq "ARRAY" ? @$_ : $_ } @args;
  60         860  
26 46         2390 $self->{$key} = [@args];
27             }
28              
29 0     0   0 sub clone { dclone shift }
30              
31             package Class::DBI::Query;
32              
33 24     24   520 use base 'Class::DBI::Query::Base';
  24         233  
  24         517  
34              
35             __PACKAGE__->mk_accessors(
36             qw/
37             owner essential sqlname where_clause restrictions order_by kings
38             /
39             );
40              
41             =head1 NAME
42            
43             Class::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            
59             This abstracts away many of the details of the Class::DBI underlying SQL
60             mechanism. For the most part you probably don't want to be interfacing
61             directly with this.
62            
63             The underlying mechanisms are not yet stable, and are subject to change
64             at any time.
65            
66             =cut
67              
68             =head1 OPTIONS
69            
70             A Query can have many options set before executing. Most can either be
71             passed as an option to new(), or set later if you are building the query
72             up dynamically:
73            
74             =head2 owner
75            
76             The Class::DBI subclass that 'owns' this query. In the vast majority
77             of cases a query will return objects - the owner is the class of
78             which instances will be returned.
79            
80             =head2 sqlname
81            
82             This should be the name of a query set up using set_sql.
83            
84             =head2 where_clause
85            
86             This is the raw SQL that will substituted into the 'WHERE %s' in your
87             query. If you have multiple %s's in your query then you should supply
88             a listref of where_clauses. This SQL can include placeholders, which will be
89             used when you call run().
90            
91             =head2 essential
92            
93             When retrieving rows from the database that match the WHERE clause of
94             the query, these are the columns that we fetch back and pre-load the
95             resulting objects with. By default this is the Essential column group
96             of the owner class.
97            
98             =head1 METHODS
99            
100             =head2 where()
101            
102             $query->where($match, @columns);
103            
104             This will extend your 'WHERE' clause by adding a 'AND $column = ?' (or
105             whatever $match is, isntead of "=") for each column passed. If you have
106             multiple WHERE clauses this will extend the last one.
107            
108             =cut
109              
110             sub new {
111 7     7   707 my ($class, $self) = @_;
112 7         1834 require Carp;
113 7         129 Carp::carp "Class::DBI::Query deprecated";
114 7   33     235 $self->{owner}     ||= caller;
115 7   33     158 $self->{kings}     ||= $self->{owner};
116 7   50     365 $self->{essential} ||= [ $self->{owner}->_essential ];
117 7   50     115 $self->{sqlname}   ||= 'SearchSQL';
118 7         183 return $class->SUPER::new($self);
119             }
120              
121             sub _essential_string {
122 7     7   198 my $self = shift;
123 7         78 my $table = $self->owner->table_alias;
124 7         176 join ", ", map "$table.$_", $self->essential;
125             }
126              
127             sub where {
128 7     7   2097 my ($self, $type, @cols) = @_;
129 7         910 my @where = $self->where_clause;
130 7   100     87 my $last = pop @where || "";
131 7         78 $last .= join " AND ", $self->restrictions;
132 7 50       78 $last .= " ORDER BY " . $self->order_by if $self->order_by;
133 7         69 push @where, $last;
134 7         122 return @where;
135             }
136              
137             sub add_restriction {
138 12     12   237 my ($self, $sql) = @_;
139 12         183 $self->restrictions($self->restrictions, $sql);
140             }
141              
142             sub tables {
143 7     7   190 my $self = shift;
144 7         80 join ", ", map { join " ", $_->table, $_->table_alias } $self->kings;
  11         231  
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              
156             sub run {
157 7     7   111 my $self = shift;
158 7 50       3888 my $owner = $self->owner or Class::DBI->_croak("Query has no owner");
159 7   33     91 $owner = ref $owner || $owner;
160 7 50       164 $owner->can('db_Main') or $owner->_croak("No database connection defined");
161 7 50       117 my $sql_name = $self->sqlname or $owner->_croak("Query has no SQL");
162              
163 0         0 my @sel_vals = @_
164 7 50       94 ? ref $_[0] eq "ARRAY" ? @{ $_[0] } : (@_)
    100          
165             : ();
166 7         69 my $sql_method = "sql_$sql_name";
167              
168 7         57 my $sth;
169 7         63 eval {
170 7         75 $sth =
171             $owner->$sql_method($self->_essential_string, $self->tables,
172             $self->where);
173 7         155 $sth->execute(@sel_vals);
174             };
175 7 50       78 if ($@) {
176 0         0 $owner->_croak(
177             "Can't select for $owner using '$sth->{Statement}' ($sql_name): $@",
178             err => $@);
179 0         0 return;
180             }
181 7         94 return $sth;
182             }
183              
184             1;
185