File Coverage

blib/lib/SQL/Entity/Table.pm
Criterion Covered Total %
statement 79 83 95.1
branch 23 34 67.6
condition 10 16 62.5
subroutine 21 22 95.4
pod 16 16 100.0
total 149 171 87.1


line stmt bran cond sub pod time code
1             package SQL::Entity::Table;
2              
3 7     7   40495 use warnings;
  7         16  
  7         321  
4 7     7   41 use strict;
  7         16  
  7         295  
5 7     7   53 use vars qw($VERSION);
  7         13  
  7         448  
6              
7             $VERSION = 0.02;
8              
9 7     7   1033 use Abstract::Meta::Class ':all';
  7         17643  
  7         1200  
10 7     7   49 use Carp 'confess';
  7         14  
  7         450  
11 7     7   703 use SQL::Entity::Column;
  7         23  
  7         9174  
12              
13             =head1 NAME
14              
15             SQL::Entity::Table - Database table abstraction
16              
17             =head1 SYNOPSIS
18              
19             use SQL::Entity::Table;
20             use'SQL::Entity::Column ':all';
21              
22             my $table = SQL::Entity::Table->new(
23             name => 'emp'
24             columns => [sql_column(name => 'empno')]
25             );
26              
27             my ($sql) = $table->query;
28              
29             my $dept = SQL::Entity->new(
30             name => 'dept',
31             alias => 'd',
32             columns => [
33             sql_column(name => 'deptno'),
34             sql_column(name => 'dname')
35             ],
36             );
37              
38             my $emp = SQL::Entity->new(
39             name => 'emp',
40             primary_key => ['empno'],
41             columns => [
42             sql_column(name => 'ename'),
43             sql_column(name => 'empno'),
44             sql_column(name => 'deptno')
45             ],
46             );
47              
48             $emp->add_to_one_relationships(sql_relationship(
49             table => $dept,
50             condition => sql_cond($dept->column('deptno'), '=', $entity->column('deptno'))
51             ));
52              
53              
54             =head1 DESCRIPTION
55              
56             Represents database table definition.
57              
58             =head2 EXPORT
59              
60             None.
61              
62             all - exports sql_column method
63              
64             =head2 ATTRIBUTES
65              
66             =over
67              
68             =item name
69              
70             =cut
71              
72             has '$.name';
73              
74              
75             =item schema
76              
77             Table schema name
78              
79             =cut
80              
81             has '$.schema';
82              
83              
84             =item primary_key
85              
86             =cut
87              
88             has '@.primary_key';
89              
90              
91             =item alias
92              
93             =cut
94              
95             has '$.alias';
96              
97              
98             =item columns
99              
100             =cut
101              
102             has '%.columns' => (
103             item_accessor => 'column',
104             associated_class => 'SQL::Entity::Column',
105             index_by => 'id',
106             the_other_end => 'table',
107             );
108              
109              
110             =item lobs
111              
112             =cut
113              
114             has '%.lobs' => (
115             item_accessor => 'lob',
116             associated_class => 'SQL::Entity::Column::LOB',
117             index_by => 'id',
118             the_other_end => 'table',
119             );
120              
121              
122             =item indexes
123              
124             =cut
125              
126             has '%.indexes' => (
127             item_accessor => '_index',
128             associated_class => 'SQL::Entity::Index',
129             index_by => 'name',
130             );
131              
132              
133             =item order_index
134              
135             Index name that will be used to enforce order of the result.
136              
137             =cut
138              
139             has '$.order_index';
140              
141             =back
142              
143             =head2 METHODS
144              
145             =over
146              
147             =item initialise
148              
149             =cut
150              
151             sub initialise {
152 13     13 1 1454 my ($self) = @_;
153 13 100       74 $self->set_alias($self->name) unless $self->alias;
154             }
155              
156              
157             =item unique_columns
158              
159             Returns list of unique columns
160              
161             =cut
162              
163             sub unique_columns {
164 0     0 1 0 my ($self) = @_;
165 0         0 (grep { $_->unique } values %{$self->columns});
  0         0  
  0         0  
166             }
167              
168              
169             =item query
170              
171             Returns sql statement and bind variables,
172             Takes optionally array ref of the requeted columns, condition object, bind_variables reference
173              
174             =cut
175              
176             sub query {
177 14     14 1 411 my ($self, $requested_columns, $condition, $bind_variables, $join_methods) = @_;
178 14   100     121 $requested_columns ||=[];
179 14   50     68 $bind_variables ||= [];
180 14   100     56 $join_methods ||= {};
181 14         83 my $where_clause = $self->where_clause($condition, $bind_variables, $join_methods);
182 14         94 my $stmt = $self->select_clause($requested_columns, $join_methods)
183             . $self->from_clause($join_methods)
184             . $where_clause
185             . $self->order_by_clause;
186 14 50       119 wantarray ? ($stmt, $bind_variables) : $stmt;
187             }
188              
189              
190             =item count
191              
192             Retiurn sql and bind variables that returns number of rows for passed in condition,
193              
194             =cut
195              
196             sub count {
197 2     2 1 1716 my ($self, $condition, $bind_variables, $join_methods) = @_;
198 2   50     15 $bind_variables ||= [];
199 2   50     13 $join_methods ||= {};
200 2         8 my $where_clause = $self->where_clause($condition, $bind_variables, $join_methods);
201 2         8 my $stmt = "SELECT COUNT(*) AS count"
202             . $self->from_clause($join_methods)
203             . $where_clause;
204 2 50       27 wantarray ? ($stmt, $bind_variables) : $stmt;
205             }
206              
207              
208             =item from_clause
209              
210             Returns "FROM .... " SQL fragment
211              
212             =cut
213              
214             sub from_clause {
215 16     16 1 27 my ($self, $join_methods) = @_;
216 16         76 "\nFROM "
217             . $self->from_clause_params($join_methods)
218             }
219              
220              
221             =item from_clause_params
222              
223             Returns FROM operand " table1 " SQL fragment
224              
225             =cut
226              
227             sub from_clause_params {
228 17     17 1 30 my ($self) = @_;
229 17         71 my $schema = $self->schema;
230 17 50       173 ($schema ? $schema . "." : "")
231             . $self->name
232             . $self->from_clause_alias;
233             }
234              
235              
236             =item from_clause_alias
237              
238             Returns table alias
239              
240             =cut
241              
242             sub from_clause_alias {
243 18     18 1 180 my ($self) = @_;
244 18         50 my $alias = $self->alias;
245 18 100 66     201 ($alias && $self->name ne $alias ? " $alias" : '')
246             }
247              
248              
249             =item select_clause
250              
251             Returns " SELECT ..." SQL fragment
252              
253             =cut
254              
255             sub select_clause {
256 14     14 1 25 my ($self, $requested_columns, $join_methods) = @_;
257 56         186 "SELECT "
258             . $self->select_hint_clause
259 14         70 . join ",\n ", map { $_->as_string($self, $join_methods) } $self->selectable_columns($requested_columns);
260             }
261              
262              
263             =item selectable_columns
264              
265             Returns list of column that can be used in select clause
266              
267             =cut
268              
269             sub selectable_columns {
270 14     14 1 137 my ($self, $requested_columns) = @_;
271 14 50       43 confess unless $requested_columns;
272 14         66 my $columns = $self->columns;
273 14 100       151 if(@$requested_columns) {
274 1 50       2 return map { $columns->{$_} ? ($columns->{$_}) : () } @$requested_columns;
  1         13  
275             }
276            
277 13 50       39 $self->columns ? (values %$columns) : ();
278             }
279              
280              
281             =item insertable_columns
282              
283             Returns list of column that can be used in insert clause
284              
285             =cut
286              
287             sub insertable_columns {
288 4     4 1 290 my ($self) = @_;
289 4         14 my $query_columns = $self->query_columns;
290 12         80 map {
291 4         44 my $column = $query_columns->{$_};
292 12 50       38 ($column->insertable ? $column : ()) } keys %$query_columns;
293             }
294              
295              
296             =item updatable_columns
297              
298             Returns list of column that can be used in update clause
299              
300             =cut
301              
302             sub updatable_columns {
303 4     4 1 350 my ($self) = @_;
304 4         12 my $query_columns = $self->query_columns;
305 12         84 map {
306 4         46 my $column = $query_columns->{$_};
307 12 50       33 ($column->updatable ? $column : ()) } keys %$query_columns;
308             }
309              
310              
311             =item query_columns
312              
313             Returns hash_ref with all columns that belongs to this object.
314              
315             =cut
316              
317             sub query_columns {
318 21     21 1 332 my ($self) = @_;
319 21         73 $self->columns;
320             }
321              
322              
323             =item where_clause
324              
325             Returns " WHERE ..." SQL fragment
326              
327             =cut
328              
329             sub where_clause {
330 16     16 1 32 my ($self, $condition, $bind_variables, $join_methods) = @_;
331 16 100       67 return "" unless $condition;
332 6 50 33     50 confess "should have condition object"
333             if ($condition && ref($condition) ne 'SQL::Entity::Condition');
334 6         28 my %query_columns = $self->query_columns;
335 6         106 "\nWHERE " . $condition->as_string(\%query_columns, $bind_variables, $self, $join_methods);
336            
337             }
338              
339              
340             =item index
341              
342             Returns order_index object, if order_index is not set then the first index will be seleted.
343              
344             =cut
345              
346             sub index {
347 18     18 1 28 my $self = shift;
348 18         84 my $order_index = $self->order_index;
349 18 100       151 unless ($order_index) {
350 13 50       60 my $indexes = $self->indexes or return;
351 13 50       241 ($order_index) = (keys %$indexes) or return;
352             }
353 5         23 $self->_index($order_index);
354             }
355              
356              
357             =item select_hint_clause
358              
359             Return hinst cluase that will be placed as SELECT operand
360              
361             =cut
362              
363             sub select_hint_clause {
364 10     10 1 18 my ($self) = @_;
365 10         64 ""
366             }
367              
368              
369             =item order_by_clause
370              
371             Returns " ORDER BY ..." SQL fragment
372              
373             =cut
374              
375             sub order_by_clause {
376 10     10 1 76 my ($self) = @_;
377 10 100       53 my $index = $self->index or return "";
378 1         26 " ORDER BY " . $index->order_by_operand($self);
379             }
380              
381              
382             __END__