File Coverage

blib/lib/DBIx/DBO/Table.pm
Criterion Covered Total %
statement 101 107 94.3
branch 24 36 66.6
condition 8 12 66.6
subroutine 26 28 92.8
pod 19 19 100.0
total 178 202 88.1


line stmt bran cond sub pod time code
1             package DBIx::DBO::Table;
2              
3 11     11   61 use strict;
  11         24  
  11         410  
4 11     11   62 use warnings;
  11         63  
  11         330  
5 11     11   60 use Carp 'croak';
  11         18  
  11         844  
6              
7 11     11   35642 use overload '**' => \&column, fallback => 1;
  11         20020  
  11         97  
8              
9 3     3   20 sub _row_class { $_[0]{DBO}->_row_class }
10              
11             *_isa = \&DBIx::DBO::DBD::_isa;
12              
13             =head1 NAME
14              
15             DBIx::DBO::Table - An OO interface to SQL queries and results. Encapsulates a table in an object.
16              
17             =head1 SYNOPSIS
18              
19             # Create a Table object
20             my $table = $dbo->table('my_table');
21            
22             # Get a column reference
23             my $column = $table ** 'employee_id';
24            
25             # Quickly display my employee id
26             print $table->fetch_value('employee_id', name => 'Vernon');
27            
28             # Find the IDs of fired employees
29             my @fired = @{ $table->fetch_column('id', status => 'fired');
30            
31             # Insert a new row into the table
32             $table->insert(employee_id => 007, name => 'James Bond');
33            
34             # Remove rows from the table where the name IS NULL
35             $table->delete(name => undef);
36              
37             =head1 DESCRIPTION
38              
39             C objects are mostly used for column references in a L.
40             They can also be used for INSERTs, DELETEs and simple lookups (fetch_*).
41              
42             =head1 METHODS
43              
44             =head3 C
45              
46             DBIx::DBO::Table->new($dbo, $table);
47             # or
48             $dbo->table($table);
49              
50             Create and return a new C object.
51             The C<$table> argument that specifies the table can be a string containing the table name, C<'customers'> or C<'history.log'>, it can be an arrayref of schema and table name C<['history', 'log']> or as another Table object to clone.
52              
53             =cut
54              
55             sub new {
56 22     22 1 67 my $proto = shift;
57 22 100       33 eval { $_[0]->isa('DBIx::DBO') } or croak 'Invalid DBO Object';
  22         133  
58 21   66     104 my $class = ref($proto) || $proto;
59 21         81 $class->_init(@_);
60             }
61              
62             sub _init {
63 21     21   46 my($class, $dbo, $table) = @_;
64 21         85 (my $schema, $table, my $info) = $dbo->table_info($table);
65 19         232 bless { %$info, Schema => $schema, Name => $table, DBO => $dbo, LastInsertID => undef }, $class;
66             }
67              
68             =head3 C
69              
70             Return a list of C objects, which will always be this C
object.
71              
72             =cut
73              
74             sub tables {
75 1 50   1 1 6 wantarray ? $_[0] : 1;
76             }
77              
78             sub _table_alias {
79 29     29   122 undef;
80             }
81              
82             =head3 C
83              
84             $table_name = $table->name;
85             ($schema_name, $table_name) = $table->name;
86              
87             In scalar context it returns the name of the table in list context the schema and table names are returned.
88              
89             =cut
90              
91             sub name {
92 0 0   0 1 0 wantarray ? @{$_[0]}{qw(Schema Name)} : $_[0]->{Name};
  0         0  
93             }
94              
95             sub _from {
96 62     62   117 my $me = shift;
97 62 100       352 defined $me->{_from} ? $me->{_from} : ($me->{_from} = $me->{DBO}{dbd_class}->_qi($me, @$me{qw(Schema Name)}));
98             }
99              
100             =head3 C
101              
102             Return a list of column names.
103              
104             =cut
105              
106             sub columns {
107 13     13 1 22 @{$_[0]->{Columns}};
  13         70  
108             }
109              
110             =head3 C
111              
112             $table->column($column_name);
113             $table ** $column_name;
114              
115             Returns a reference to a column for use with other methods.
116             The C<**> method is a shortcut for the C method.
117              
118             =cut
119              
120             sub column {
121 117     117 1 1391 my($me, $col) = @_;
122 117 50       266 croak 'Missing argument for column' unless defined $col;
123 117 100       361 croak 'Invalid column '.$me->{DBO}{dbd_class}->_qi($me, $col).' in table '.$me->_from
124             unless exists $me->{Column_Idx}{$col};
125 116   100     968 $me->{Column}{$col} ||= bless [$me, $col], 'DBIx::DBO::Column';
126             }
127             *_inner_col = \&column;
128              
129             =head3 C
130              
131             Returns a new empty L object for this table.
132              
133             =cut
134              
135             sub row {
136 3     3 1 5 my $me = shift;
137 3         16 $me->_row_class->new($me->{DBO}, $me);
138             }
139              
140             =head3 C
141              
142             $table->fetch_row(%where);
143              
144             Fetch the first matching row from the table returning it as a L object.
145              
146             The C<%where> is a hash of field/value pairs.
147             The value can be a simple SCALAR or C for C
148             It can also be a SCALAR reference, which will be used without quoting, or an ARRAY reference for multiple C values.
149              
150             $someone = $table->fetch_row(age => 21, join_date => \'CURDATE()', end_date => undef);
151             $a_child = $table->fetch_row(name => \'NOT NULL', age => [5 .. 15]);
152              
153             =cut
154              
155             sub fetch_row {
156 3     3 1 585 my $me = shift;
157 3         14 $me->row->load(@_);
158             }
159              
160             =head3 C
161              
162             $table->fetch_value($column, %where);
163              
164             Fetch the first matching row from the table returning the value in one column.
165              
166             =cut
167              
168             sub fetch_value {
169 2     2 1 9 my($me, $col) = splice @_, 0, 2;
170 2         4 my @bind;
171 2         21 $col = $me->{DBO}{dbd_class}->_build_val($me, \@bind, $me->{DBO}{dbd_class}->_parse_col_val($me, $col));
172 2         12 my $sql = "SELECT $col FROM ".$me->_from;
173 2         4 my $clause;
174 2 50       18 $sql .= ' WHERE '.$clause if $clause = $me->{DBO}{dbd_class}->_build_quick_where($me, \@bind, @_);
175 2         13 my $ref = $me->{DBO}{dbd_class}->_selectrow_arrayref($me, $sql, undef, @bind);
176 2   33     262 return $ref && $ref->[0];
177             }
178              
179             =head3 C
180              
181             $table->fetch_hash(%where);
182              
183             Fetch the first matching row from the table returning it as a hashref.
184              
185             =cut
186              
187             sub fetch_hash {
188 1     1 1 3 my $me = shift;
189 1         6 my $sql = 'SELECT * FROM '.$me->_from;
190 1         3 my @bind;
191             my $clause;
192 1 50       7 $sql .= ' WHERE '.$clause if $clause = $me->{DBO}{dbd_class}->_build_quick_where($me, \@bind, @_);
193 1         10 $me->{DBO}{dbd_class}->_selectrow_hashref($me, $sql, undef, @bind);
194             }
195              
196             =head3 C
197              
198             $table->fetch_column($column, %where);
199              
200             Fetch all matching rows from the table returning an arrayref of the values in one column.
201              
202             =cut
203              
204             sub fetch_column {
205 1     1 1 4 my($me, $col) = splice @_, 0, 2;
206 1         3 my @bind;
207 1         9 $col = $me->{DBO}{dbd_class}->_build_val($me, \@bind, $me->{DBO}{dbd_class}->_parse_col_val($me, $col));
208 1         8 my $sql = "SELECT $col FROM ".$me->_from;
209 1         2 my $clause;
210 1 50       7 $sql .= ' WHERE '.$clause if $clause = $me->{DBO}{dbd_class}->_build_quick_where($me, \@bind, @_);
211 1         5 $me->{DBO}{dbd_class}->_sql($me, $sql, @bind);
212 1         4 return $me->rdbh->selectcol_arrayref($sql, undef, @bind);
213             }
214              
215             =head3 C
216              
217             $table->insert(name => 'Richard', age => 103);
218              
219             Insert a row into the table. Returns true on success or C on failure.
220              
221             On supporting databases you may also use C<$table-Elast_insert_id> to retreive
222             the autogenerated ID (if there was one) from the last inserted row.
223              
224             =cut
225              
226             sub insert {
227 7     7 1 19 my $me = shift;
228 7 50       30 croak 'Called insert() without args on table '.$me->_from unless @_;
229 7 50       26 croak 'Wrong number of arguments' if @_ & 1;
230 7         12 my @cols;
231             my @vals;
232 0         0 my @bind;
233 0         0 my %remove_duplicates;
234 7         24 while (@_) {
235 14         85 my @val = $me->{DBO}{dbd_class}->_parse_val($me, pop);
236 14         86 my $col = $me->{DBO}{dbd_class}->_build_col($me, $me->{DBO}{dbd_class}->_parse_col($me, pop));
237 14 100       610 next if $remove_duplicates{$col}++;
238 13         28 push @cols, $col;
239 13         90 push @vals, $me->{DBO}{dbd_class}->_build_val($me, \@bind, @val);
240             }
241 7         28 my $sql = 'INSERT INTO '.$me->_from.' ('.join(', ', @cols).') VALUES ('.join(', ', @vals).')';
242 7         66 $me->{DBO}{dbd_class}->_sql($me, $sql, @bind);
243 7 50       24 my $sth = $me->dbh->prepare($sql) or return undef;
244 7 50       1881 my $rv = $sth->execute(@bind) or return undef;
245 7         54 $me->{LastInsertID} = $me->{DBO}{dbd_class}->_save_last_insert_id($me, $sth);
246 7         151 return $rv;
247             }
248              
249             =head3 C
250              
251             $table->insert(name => 'Quentin');
252             my $row_id = $table->last_insert_id;
253              
254             Retreive the autogenerated ID (if there was one) from the last inserted row.
255              
256             Returns the ID or undef if it's unavailable.
257              
258             =cut
259              
260             sub last_insert_id {
261 1     1 1 3 my $me = shift;
262 1         6 $me->{LastInsertID};
263             }
264              
265             =head3 C
266              
267             $table->bulk_insert(
268             columns => [qw(id name age)], # Optional
269             rows => [{name => 'Richard', age => 103}, ...]
270             );
271             $table->bulk_insert(
272             columns => [qw(id name age)], # Optional
273             rows => [[ undef, 'Richard', 103 ], ...]
274             );
275              
276             Insert multiple rows into the table.
277             Returns the number of rows inserted or C on failure.
278              
279             The C need not be passed in, and will default to all the columns in the table.
280              
281             On supporting databases you may also use C<$table-Elast_insert_id> to retreive
282             the autogenerated ID (if there was one) from the last inserted row.
283              
284             =cut
285              
286             sub bulk_insert {
287 4     4 1 18 my($me, %opt) = @_;
288 4 50       19 croak 'The "rows" argument must be an arrayref' if ref $opt{rows} ne 'ARRAY';
289 4         15 my $sql = 'INSERT INTO '.$me->_from;
290              
291 4         7 my @cols;
292 4 100       12 if (defined $opt{columns}) {
293 2         5 @cols = map $me->column($_), @{$opt{columns}};
  2         10  
294 2         15 $sql .= ' ('.join(', ', map $me->{DBO}{dbd_class}->_build_col($me, $_), @cols).')';
295 2         56 @cols = map $_->[1], @cols;
296             } else {
297 2         4 @cols = @{$me->{Columns}};
  2         8  
298             }
299 4         9 $sql .= ' VALUES ';
300              
301 4         35 $me->{DBO}{dbd_class}->_bulk_insert($me, $sql, \@cols, %opt);
302             }
303              
304             =head3 C
305              
306             $table->delete(name => 'Richard', age => 103);
307              
308             Delete all rows from the table matching the criteria. Returns the number of rows deleted or C on failure.
309              
310             =cut
311              
312             sub delete {
313 8     8 1 839 my $me = shift;
314 8         28 my $sql = 'DELETE FROM '.$me->_from;
315 8         18 my @bind;
316             my $clause;
317 8 100       65 $sql .= ' WHERE '.$clause if $clause = $me->{DBO}{dbd_class}->_build_quick_where($me, \@bind, @_);
318 7         50 $me->{DBO}{dbd_class}->_do($me, $sql, undef, @bind);
319             }
320              
321             =head3 C
322              
323             $table->truncate;
324              
325             Truncate the table. Returns true on success or C on failure.
326              
327             =cut
328              
329             sub truncate {
330 0     0 1 0 my $me = shift;
331 0         0 $me->{DBO}{dbd_class}->_do($me, 'TRUNCATE TABLE '.$me->_from);
332             }
333              
334             =head2 Common Methods
335              
336             These methods are accessible from all DBIx::DBO* objects.
337              
338             =head3 C
339              
340             The C object.
341              
342             =head3 C
343              
344             The I C handle.
345              
346             =head3 C
347              
348             The I C handle, or if there is no I connection, the I C handle.
349              
350             =cut
351              
352 2     2 1 19 sub dbo { $_[0]{DBO} }
353 18     18 1 81 sub dbh { $_[0]{DBO}->dbh }
354 51     51 1 206 sub rdbh { $_[0]{DBO}->rdbh }
355              
356             =head3 C
357              
358             $table_setting = $table->config($option);
359             $table->config($option => $table_setting);
360              
361             Get or set the C config settings. When setting an option, the previous value is returned. When getting an option's value, if the value is undefined, the L's value is returned.
362              
363             See L.
364              
365             =cut
366              
367             sub config {
368 149     149 1 225 my $me = shift;
369 149         206 my $opt = shift;
370 149 100 50     553 return $me->{DBO}{dbd_class}->_set_config($me->{Config} ||= {}, $opt, shift) if @_;
371 115   100     788 $me->{DBO}{dbd_class}->_get_config($opt, $me->{Config} ||= {}, $me->{DBO}{Config}, \%DBIx::DBO::Config);
372             }
373              
374             sub DESTROY {
375 7     7   410 undef %{$_[0]};
  7         166  
376             }
377              
378             1;
379              
380             __END__