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   86076 use Object::Simple -base;
  17         1304  
  17         107  
3              
4 17     17   1992 use Carp 'confess';
  17         35  
  17         1012  
5 17     17   564 use DBIx::Custom::Util qw/_subname _deprecate/;
  17         34  
  17         5105  
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   128 no strict 'refs';
  17         37  
  17         16314  
40 39 100   39   3964 *{__PACKAGE__ . "::$method"} = eval $code;
  39 50       658  
  45 50       5657  
  45 50       797  
  21 50       1277  
  21 100       357  
  24 100       1233  
  24 100       779  
  20 100       1225  
  20 50       333  
  5 50       154  
  5 50       87  
  45 100       4276  
  45 100       776  
    100          
    50          
    50          
    50          
    100          
    100          
    100          
    50          
    50          
    50          
    100          
    50          
    100          
    50          
    50          
    100          
    50          
    100          
    50          
    50          
    100          
    100          
    100          
    100          
    50          
    50          
41             confess $code if $@;
42             }
43              
44             # DEPRECATED
45             sub primary_key {
46 169 100   169 1 445 if (@_ == 1) {
47 166         324 return $_[0]{'primary_key'};
48             }
49 3         9 $_[0]{'primary_key'} = $_[1];
50 3         7 $_[0];
51             };
52              
53             # DEPRECATED
54             sub update_or_insert {
55 8     8 0 140 my ($self, $param, %opt) = @_;
56              
57 8         37 _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     266 && (defined $opt{primary_key} || defined $self->{primary_key});
      33        
      33        
62            
63 8   50     39 my $statement_opt = $opt{option} || {};
64 8 50       26 my $rows = $self->select(%opt, %{$statement_opt->{select} || {}})->all;
  8         226  
65 8 100       110 if (@$rows == 0) {
    50          
66 5 50       20 return $self->insert($param, %opt, %{$statement_opt->{insert} || {}});
  5         151  
67             }
68             elsif (@$rows == 1) {
69 0 0       0 return $self->update($param, %opt, %{$statement_opt->{update} || {}});
  0         0  
70             }
71 3         15 else { confess "selected row must be one " . _subname }
72             }
73              
74             # DEPRECATED
75             sub AUTOLOAD {
76 33     33   8486 my $self = shift;
77            
78 33         134 _deprecate('0.39', "DBIx::Custom::Model AUTOLOAD feature is DEPRECATED!");
79            
80             # Method name
81 33         266 my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
82            
83             # Method
84 33   100     181 $self->{_methods} ||= {};
85 33 100 0     675 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         744 $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 51 my $self = shift;
104            
105 3         17 _deprecate('0.39', "DBIx::Custom::Model::helper method is DEPRECATED!");
106            
107             # Merge
108 3 50       18 my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
109 3 50       10 $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
  3         28  
110            
111 3         12 return $self;
112             }
113              
114             sub mycolumn {
115 24     24 1 6114 my $self = shift;
116 24 100       88 my $table = shift unless ref $_[0];
117 24         49 my $columns = shift;
118            
119 24   50     504 $table ||= $self->table || '';
      66        
120            
121 24   66     516 $columns ||= $self->columns;
122            
123 24         527 return $self->dbi->mycolumn($table, $columns);
124             }
125              
126             sub new {
127 223     223 1 830 my $self = shift->SUPER::new(@_);
128            
129             # Check attribute names
130 223         2931 my @attrs = keys %$self;
131 223         504 for my $attr (@attrs) {
132 283 50       1467 confess qq{"$attr" is invalid attribute name } . _subname
133             unless $self->can($attr);
134             }
135            
136             # Cache
137 223         495 for my $attr (qw/dbi table ctime mtime bind_type join primary_key/) {
138 1561         26563 $self->$attr;
139 1561 100       10464 $self->{$attr} = undef unless exists $self->{$attr};
140             }
141 223         4154 $self->columns;
142            
143 223         679 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