File Coverage

blib/lib/DBIx/Custom/Model.pm
Criterion Covered Total %
statement 68 72 94.4
branch 77 110 70.0
condition 11 24 45.8
subroutine 11 12 91.6
pod 3 5 60.0
total 170 223 76.2


line stmt bran cond sub pod time code
1             package DBIx::Custom::Model;
2 17     17   85811 use Object::Simple -base;
  17         1272  
  17         103  
3              
4 17     17   1815 use Carp 'confess';
  17         42  
  17         939  
5 17     17   550 use DBIx::Custom::Util qw/_subname _deprecate/;
  17         32  
  17         4956  
6              
7             has [qw/dbi table name ctime mtime bind_type join/];
8             has columns => sub { [] };
9              
10             our $AUTOLOAD;
11              
12             my @methods = qw(insert update update_all delete delete_all select count);
13             for my $method (@methods) {
14            
15             my $code =
16             qq/sub {/ .
17             qq/my \$self = shift;/ .
18             qq/\$self->dbi->$method(/ .
19             qq/\@_ % 2 ? shift : (),/;
20              
21            
22             my @attrs = qw/table type primary_key bind_type/;
23             my @insert_attrs = qw/ctime mtime/;
24             my @update_attrs = qw/mtime/;
25             my @select_attrs = qw/join/;
26             if ($method eq 'insert') { push @attrs, @insert_attrs }
27             elsif ($method eq 'update') { push @attrs, @update_attrs }
28             elsif (index($method, 'select') != -1 || $method eq 'count') {
29             push @attrs, @select_attrs
30             }
31            
32             for my $attr (@attrs) {
33             $code .= "exists \$self->{$attr} ? ($attr => \$self->{$attr}) : (),";
34             }
35            
36             $code .= qq/\@_);/ .
37             qq/}/;
38            
39 17     17   146 no strict 'refs';
  17         32  
  17         16057  
40 20 50   20   1270 *{__PACKAGE__ . "::$method"} = eval $code;
  20 50       326  
  3 50       71  
  3 50       51  
  94 50       10016  
  94 50       1576  
  45 50       4341  
  45 50       777  
  6 50       164  
  6 50       100  
  23 100       1298  
  23 100       387  
  8 100       323  
  8 100       148  
    50          
    100          
    100          
    50          
    100          
    100          
    100          
    100          
    50          
    100          
    100          
    50          
    100          
    50          
    50          
    50          
    100          
    100          
    100          
    50          
    100          
    100          
    100          
    50          
    50          
    50          
41             confess $code if $@;
42             }
43              
44             # DEPRECATED
45             sub primary_key {
46 169 100   169 1 460 if (@_ == 1) {
47 166         290 return $_[0]{'primary_key'};
48             }
49 3         10 $_[0]{'primary_key'} = $_[1];
50 3         8 $_[0];
51             };
52              
53             # DEPRECATED
54             sub update_or_insert {
55 8     8 0 128 my ($self, $param, %opt) = @_;
56              
57 8         42 _deprecate('0.39', "DBIx::Custom::Model::update_or_insert method is DEPRECATED!");
58              
59             confess "update_or_insert method need primary_key and id option "
60             unless (defined $opt{id} || defined $self->{id})
61 8 50 33     259 && (defined $opt{primary_key} || defined $self->{primary_key});
      33        
      33        
62            
63 8   50     39 my $statement_opt = $opt{option} || {};
64 8 50       36 my $rows = $self->select(%opt, %{$statement_opt->{select} || {}})->all;
  8         227  
65 8 100       122 if (@$rows == 0) {
    50          
66 5 50       21 return $self->insert($param, %opt, %{$statement_opt->{insert} || {}});
  5         177  
67             }
68             elsif (@$rows == 1) {
69 0 0       0 return $self->update($param, %opt, %{$statement_opt->{update} || {}});
  0         0  
70             }
71 3         17 else { confess "selected row must be one " . _subname }
72             }
73              
74             # DEPRECATED
75             sub AUTOLOAD {
76 33     33   6934 my $self = shift;
77            
78 33         126 _deprecate('0.39', "DBIx::Custom::Model AUTOLOAD feature is DEPRECATED!");
79            
80             # Method name
81 33         263 my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
82            
83             # Method
84 33   100     186 $self->{_methods} ||= {};
85 33 100 0     638 if (my $method = $self->{_methods}->{$mname}) {
    50          
    0          
86 3         16 return $self->$method(@_)
87             }
88             elsif (my $dbi_method = $self->dbi->can($mname)) {
89 30         782 $self->dbi->$dbi_method(@_);
90             }
91             elsif ($self->{dbh} && (my $dbh_method = $self->dbh->can($mname))) {
92 0         0 $self->dbi->dbh->$dbh_method(@_);
93             }
94             else {
95 0         0 confess qq{Can't locate object method "$mname" via "$package" }
96             . _subname;
97             }
98             }
99       0     sub DESTROY { }
100              
101             # DEPRECATED
102             sub helper {
103 3     3 0 56 my $self = shift;
104            
105 3         16 _deprecate('0.39', "DBIx::Custom::Model::helper method is DEPRECATED!");
106            
107             # Merge
108 3 50       22 my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
109 3 50       9 $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
  3         31  
110            
111 3         12 return $self;
112             }
113              
114             sub mycolumn {
115 24     24 1 7432 my $self = shift;
116 24 100       84 my $table = shift unless ref $_[0];
117 24         48 my $columns = shift;
118            
119 24   50     459 $table ||= $self->table || '';
      66        
120            
121 24   66     509 $columns ||= $self->columns;
122            
123 24         569 return $self->dbi->mycolumn($table, $columns);
124             }
125              
126             sub new {
127 223     223 1 902 my $self = shift->SUPER::new(@_);
128            
129             # Check attribute names
130 223         2883 my @attrs = keys %$self;
131 223         542 for my $attr (@attrs) {
132 283 50       1462 confess qq{"$attr" is invalid attribute name } . _subname
133             unless $self->can($attr);
134             }
135            
136             # Cache
137 223         506 for my $attr (qw/dbi table ctime mtime bind_type join primary_key/) {
138 1561         26699 $self->$attr;
139 1561 100       10367 $self->{$attr} = undef unless exists $self->{$attr};
140             }
141 223         3986 $self->columns;
142            
143 223         672 return $self;
144             }
145              
146             1;
147              
148             =head1 NAME
149              
150             DBIx::Custom::Model - Model object
151              
152             =head1 SYNOPSIS
153              
154             use DBIx::Custom::Model;
155              
156             my $model = DBIx::Custom::Model->new(table => 'books');
157              
158             =head1 ATTRIBUTES
159              
160             =head2 name
161              
162             my $name = $model->name;
163             $model = $model->name('book');
164              
165             Model name.
166              
167             =head2 table
168              
169             my $table = $model->table;
170             $model = $model->table('book');
171              
172             Table name, this is passed to C, C, C, C, C, C
173              
174             =head2 join
175              
176             my $join = $model->join;
177             $model = $model->join(
178             ['left outer join company on book.company_id = company.id']
179             );
180            
181             Join clause, this value is passed to C
182              
183             =head2 dbi
184              
185             my $dbi = $model->dbi;
186             $model = $model->dbi($dbi);
187              
188             L object.
189              
190             =head2 bind_type
191              
192             my $type = $model->bind_type;
193             $model = $model->bind_type(['image' => DBI::SQL_BLOB]);
194            
195             Database data type, this is used as type option of C,
196             C, C, C, C,
197             and C
198              
199             =head2 mtime
200              
201             my $mtime = $model->mtime;
202             $model = $model->mtime('modified_time');
203              
204             Updated timestamp column, this is passed to C method.
205              
206             =head2 ctime
207              
208             my $ctime = $model->ctime;
209             $model = $model->ctime('created_time');
210              
211             Create timestamp column, this is passed to C or C method.
212              
213             =head2 primary_key
214              
215             my $primary_key = $model->primary_key;
216             $model = $model->primary_key(['id', 'number']);
217              
218             Primary key,this is passed to C, C,
219             C, and C
220              
221             =head1 METHODS
222              
223             L inherits all methods from L,
224             and you can use all methods of L and L
225             and implements the following new ones.
226              
227             =head2 delete
228              
229             $model->delete(...);
230            
231             Same as C of L except that
232             you don't have to specify options if you set attribute in model.
233              
234             =head2 delete_all
235              
236             $model->delete_all(...);
237            
238             Same as C of L except that
239             you don't have to specify options if you set attribute in model.
240              
241             =head2 insert
242              
243             $model->insert(...);
244            
245             Same as C of L except that
246             you don't have to specify options if you set attribute in model.
247              
248             =head2 mycolumn
249              
250             my $column = $self->mycolumn;
251             my $column = $self->mycolumn(book => ['author', 'title']);
252             my $column = $self->mycolumn(['author', 'title']);
253              
254             Create column clause for myself. The following column clause is created.
255              
256             book.author as author,
257             book.title as title
258              
259             If table name is omitted, C attribute of the model is used.
260             If column names is omitted, C attribute of the model is used.
261              
262             =head2 new
263              
264             my $model = DBIx::Custom::Model->new;
265              
266             Create a L object.
267              
268             =head2 select
269              
270             $model->select(...);
271            
272             Same as C
273             you don't have to specify options if you set attribute in model.
274              
275             =head2 update
276              
277             $model->update(...);
278            
279             Same as C of L except that
280             you don't have to specify options if you set attribute in model.
281              
282             =head2 update_all
283              
284             $model->update_all(\%param);
285            
286             Same as C of L except that
287             you don't have to specify options if you set attribute in model.
288              
289             =cut