File Coverage

blib/lib/DBIx/DBO/Table.pm
Criterion Covered Total %
statement 79 83 95.1
branch 19 28 67.8
condition 9 12 75.0
subroutine 21 23 91.3
pod 14 14 100.0
total 142 160 88.7


line stmt bran cond sub pod time code
1             package DBIx::DBO::Table;
2              
3 14     14   413 use 5.014;
  14         53  
4 14     14   84 use warnings;
  14         23  
  14         823  
5 14     14   84 use DBIx::DBO;
  14         28  
  14         534  
6              
7 14     14   74 use Carp 'croak';
  14         26  
  14         1415  
8              
9 14     14   10934 use overload '**' => \&column, fallback => 1;
  14         25894  
  14         156  
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             # Insert a new row into the table
26             $table->insert(employee_id => 007, name => 'James Bond');
27            
28             # Remove rows from the table where the name IS NULL
29             $table->delete(name => undef);
30              
31             =head1 DESCRIPTION
32              
33             C objects are mostly used for column references in a L.
34             They can also be used for INSERTs and DELETEs.
35              
36             =head1 METHODS
37              
38             =head3 C
39              
40             DBIx::DBO::Table->new($dbo, $table);
41             # or
42             $dbo->table($table);
43              
44             Create and return a new C object.
45             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.
46              
47             =cut
48              
49             sub new {
50 31     31 1 92 my $proto = shift;
51 31 100       73 eval { $_[0]->isa('DBIx::DBO') } or croak 'Invalid DBO Object';
  31         188  
52 30   66     139 my $class = ref($proto) || $proto;
53 30         94 $class->_init(@_);
54             }
55              
56             sub _init {
57 30     30   95 my($class, $dbo, $table) = @_;
58 30         213 (my $schema, $table, my $info) = $dbo->table_info($table);
59 25         311 bless { %$info, Schema => $schema, Name => $table, DBO => $dbo, LastInsertID => undef }, $class;
60             }
61              
62             =head3 C
63              
64             Return a list of C objects, which will always be this C
object.
65              
66             =cut
67              
68             sub tables {
69 1 50   1 1 7 wantarray ? $_[0] : 1;
70             }
71              
72             sub _table_alias {
73 22     22   75 undef;
74             }
75              
76             =head3 C
77              
78             $table_name = $table->name;
79             ($schema_name, $table_name) = $table->name;
80              
81             In scalar context it returns the name of the table in list context the schema and table names are returned.
82              
83             =cut
84              
85             sub name {
86 0 0   0 1 0 wantarray ? @{$_[0]}{qw(Schema Name)} : $_[0]->{Name};
  0         0  
87             }
88              
89             sub _as_table {
90 192     192   388 my $me = shift;
91 192   66     718 $me->{_as_table} //= $me->{DBO}{dbd_class}->_qi($me, @$me{qw(Schema Name)});
92             }
93              
94             =head3 C
95              
96             Return a list of column names.
97              
98             =cut
99              
100             sub columns {
101 15     15 1 29 @{$_[0]->{Columns}};
  15         76  
102             }
103              
104             =head3 C
105              
106             $table->column($column_name);
107             $table ** $column_name;
108              
109             Returns a reference to a column for use with other methods.
110             The C<**> method is a shortcut for the C method.
111              
112             =cut
113              
114             sub column {
115 109     109 1 1386 my($me, $col) = @_;
116 109 50       282 croak 'Missing argument for column' unless defined $col;
117             croak 'Invalid column '.$me->{DBO}{dbd_class}->_qi($me, $col).' in table '.$me->_as_table
118 109 100       376 unless exists $me->{Column_Idx}{$col};
119 108   100     867 $me->{Column}{$col} //= bless [$me, $col], 'DBIx::DBO::Column';
120             }
121             *_inner_col = \&column;
122              
123             =head3 C
124              
125             $table->insert(name => 'Richard', age => 103);
126              
127             Insert a row into the table. Returns true on success or C on failure.
128              
129             On supporting databases you may also use C<$table-Elast_insert_id> to retreive
130             the autogenerated ID (if there was one) from the last inserted row.
131              
132             =cut
133              
134             sub insert {
135 7     7 1 21 my $me = shift;
136 7 50       25 croak 'Called insert() without args on table '.$me->_as_table unless @_;
137 7 50       26 croak 'Wrong number of arguments' if @_ & 1;
138 7         29 my @cols;
139             my @vals;
140 7         0 my @bind;
141 7         0 my %remove_duplicates;
142 7         22 while (@_) {
143 14         128 my @val = $me->{DBO}{dbd_class}->_parse_val($me, pop);
144 14         75 my $col = $me->{DBO}{dbd_class}->_build_col($me, $me->{DBO}{dbd_class}->_parse_col($me, pop));
145 14 100       578 next if $remove_duplicates{$col}++;
146 13         34 push @cols, $col;
147 13         69 push @vals, $me->{DBO}{dbd_class}->_build_val($me, \@bind, @val);
148             }
149 7         27 my $sql = 'INSERT INTO '.$me->_as_table.' ('.join(', ', @cols).') VALUES ('.join(', ', @vals).')';
150 7         84 $me->{DBO}{dbd_class}->_sql($me, $sql, @bind);
151 7 50       23 my $sth = $me->dbh->prepare($sql) or return undef;
152 7 50       1005 my $rv = $sth->execute(@bind) or return undef;
153 7         115 $me->{LastInsertID} = $me->{DBO}{dbd_class}->_save_last_insert_id($me, $sth);
154 7         148 return $rv;
155             }
156              
157             =head3 C
158              
159             $table->insert(name => 'Quentin');
160             my $row_id = $table->last_insert_id;
161              
162             Retreive the autogenerated ID (if there was one) from the last inserted row.
163              
164             Returns the ID or undef if it's unavailable.
165              
166             =cut
167              
168             sub last_insert_id {
169 1     1 1 3 my $me = shift;
170 1         7 $me->{LastInsertID};
171             }
172              
173             =head3 C
174              
175             $table->bulk_insert(
176             columns => [qw(id name age)], # Optional
177             rows => [{name => 'Richard', age => 103}, ...]
178             );
179             $table->bulk_insert(
180             columns => [qw(id name age)], # Optional
181             rows => [[ undef, 'Richard', 103 ], ...]
182             );
183              
184             Insert multiple rows into the table.
185             Returns the number of rows inserted or C on failure.
186              
187             The C need not be passed in, and will default to all the columns in the table.
188              
189             On supporting databases you may also use C<$table-Elast_insert_id> to retreive
190             the autogenerated ID (if there was one) from the last inserted row.
191              
192             =cut
193              
194             sub bulk_insert {
195 4     4 1 20 my($me, %opt) = @_;
196 4 50       22 croak 'The "rows" argument must be an arrayref' if ref $opt{rows} ne 'ARRAY';
197 4         12 my $sql = 'INSERT INTO '.$me->_as_table;
198              
199 4         10 my @cols;
200 4 100       14 if (defined $opt{columns}) {
201 2         5 @cols = map $me->column($_), @{$opt{columns}};
  2         12  
202 2         15 $sql .= ' ('.join(', ', map $me->{DBO}{dbd_class}->_build_col($me, $_), @cols).')';
203 2         77 @cols = map $_->[1], @cols;
204             } else {
205 2         4 @cols = @{$me->{Columns}};
  2         8  
206             }
207 4         9 $sql .= ' VALUES ';
208              
209 4         33 $me->{DBO}{dbd_class}->_bulk_insert($me, $sql, \@cols, %opt);
210             }
211              
212             =head3 C
213              
214             $table->delete(name => 'Richard', age => 103);
215              
216             Delete all rows from the table matching the criteria. Returns the number of rows deleted or C on failure.
217              
218             =cut
219              
220             sub delete {
221 8     8 1 701 my $me = shift;
222 8         30 my $sql = 'DELETE FROM '.$me->_as_table;
223 8         18 my @bind;
224             my $clause;
225 8 100       86 $sql .= ' WHERE '.$clause if $clause = $me->{DBO}{dbd_class}->_build_quick_where($me, \@bind, @_);
226 7         48 $me->{DBO}{dbd_class}->_do($me, $sql, undef, @bind);
227             }
228              
229             =head3 C
230              
231             $table->truncate;
232              
233             Truncate the table. Returns true on success or C on failure.
234              
235             =cut
236              
237             sub truncate {
238 0     0 1 0 my $me = shift;
239 0         0 $me->{DBO}{dbd_class}->_do($me, 'TRUNCATE TABLE '.$me->_as_table);
240             }
241              
242             =head2 Common Methods
243              
244             These methods are accessible from all DBIx::DBO* objects.
245              
246             =head3 C
247              
248             The C object.
249              
250             =head3 C
251              
252             The I C handle.
253              
254             =head3 C
255              
256             The I C handle, or if there is no I connection, the I C handle.
257              
258             =cut
259              
260 2     2 1 27 sub dbo { $_[0]{DBO} }
261 18     18 1 75 sub dbh { $_[0]{DBO}->dbh }
262 40     40 1 157 sub rdbh { $_[0]{DBO}->rdbh }
263              
264             =head3 C
265              
266             $table_setting = $table->config($option);
267             $table->config($option => $table_setting);
268              
269             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.
270              
271             See L.
272              
273             =cut
274              
275             sub config {
276 136     136 1 242 my $me = shift;
277 136         218 my $opt = shift;
278 136 100 50     524 return $me->{DBO}{dbd_class}->_set_config($me->{Config} //= {}, $opt, shift) if @_;
279 106   100     659 $me->{DBO}{dbd_class}->_get_config($opt, $me->{Config} //= {}, $me->{DBO}{Config}, \%DBIx::DBO::Config);
280             }
281              
282             sub DESTROY {
283 7     7   22 undef %{$_[0]};
  7         232  
284             }
285              
286             1;
287              
288             __END__