Showing 97 changed files with 25945 additions and 0 deletions
+527
DBIx-Custom-0.1711/Changes
... ...
@@ -0,0 +1,527 @@
1
+0.1710
2
+    - use more DBIx::Custom information in sub modules to decrease bugs
3
+      (very sorry, this change can't keep backword compatible,
4
+       but maybe no effects,
5
+       because the attributes is automatically set by DBIx::Custom, not user).
6
+    - Fixed fisrt executed where clause failed in some condition.
7
+0.1709
8
+    - fixed named placeholder bug and added escape syntax
9
+0.1708
10
+    - improved execute method performance
11
+0.1707
12
+    - I call :title named placeholder, stoping calling it parameter
13
+    - removed some EXPERIMENTAL status
14
+    - fixed performance
15
+0.1706
16
+    - Added execute method's query option document
17
+      You can get more performance.
18
+    - DBIx::Custom::Query table and filters attribute method and
19
+      filter method is DEPRECATED!
20
+      because I think query object must have only the information
21
+      for statement handle caching.
22
+0.1705
23
+    - insert and update method's param can set constant value by scalara reference
24
+      such as {date => \"NOW()"} This is EXPERIMENTAL.
25
+0.1704
26
+    - added quote method's two character support like []
27
+      for Microsoft SQL Server and Access
28
+    - added EXPERIMENTAL parameter new syntax :name{operator}
29
+0.1703
30
+    - added EXPERIMENTAL join new syntax.
31
+0.1702
32
+    - removed EXPERIMENTAL status of some methods.
33
+    - fixed some join bug
34
+0.1701
35
+    - added DBIx::Cusotm::Order prepend method automatically quoted syntax
36
+    - simplified arguments check
37
+    - added EXPERIMENTAL each_table method
38
+    - select method column option [COLUMN, as => ALIAS] format is DEPRECATED!
39
+      changed to [COLUMN => ALIAS]
40
+    - added EXPERIMENTAL DBIx::Custom::Result header method
41
+    - added EXPERIMENTAL last_sql attribute method
42
+0.1700
43
+    - fixed end_filter DEPRECATED warnings bug
44
+0.1699
45
+    - added tag_parse attribute.
46
+    - added EXPERIMENTAL order method
47
+    - added EXPERIMENTAL DBIx::Custom::Order module
48
+    - changed backword compatible policy
49
+      ------------------------------------------------------------------------
50
+      If a functionality is DEPRECATED, you can know it by DEPRECATED warnings
51
+      except for attribute method.
52
+      You can check all DEPRECATED functionalities by document.
53
+      DEPRECATED functionality is removed after five years,
54
+      but if at least one person use the functionality and tell me that thing
55
+      I extend one year each time you tell me it.
56
+
57
+      EXPERIMENTAL functionality will be changed without warnings.
58
+      ------------------------------------------------------------------------
59
+0.1698
60
+    - fixed DBIx::Custom::Where to_string method small bug
61
+    - added EXPERIMENTAL execute method table_alias option
62
+0.1697
63
+    - added EXPERIMENTAL map_param method
64
+0.1696
65
+    - added new argument format update, delete, select method where option
66
+    - create_query is DEPRECATED! use query option of each method instead.
67
+    - added EXPERIMENTAL insert, update, and select method prefix option
68
+    - fixed small insert, update, delete, select method id option bug
69
+0.1695
70
+    - changed EXPERIMENTAL DBIx::Custom::Result type_rule_off method argument
71
+    - added EXPERIMENTAL DBIx::Custom::Result type_rule_on method
72
+    - changed EXPERIMENTAL DBIx::Custom::Result type_rule1_off method argument
73
+    - added EXPERIMENTAL DBIx::Custom::Result type_rule1_on method
74
+    - changed EXPERIMENTAL DBIx::Custom::Result type_rule2_off method argument
75
+    - added EXPERIMENTAL DBIx::Custom::Result type_rule2_on method
76
+    - changed EXPERIMENTAL DBIx::Custom::Result filter_off method argument
77
+    - added EXPERIMENTAL DBIx::Custom::Result filter_on method
78
+0.1694
79
+    - EXPERIMENTAL type_rule argument format is changed
80
+    - DBIx::Custom::Result type_rule method on setting return self 
81
+    - reserved_word_quote is DEPRECATED! this is renamed to quote
82
+    - DBIx::Custom::Model type attribute is DEPRECATED!
83
+      this is renamed to bind_type.
84
+0.1693
85
+    - separate DBIx::Custom type_rule from filter
86
+    - DBIx::Custom::Model filter attrribute is DEPRECATED!
87
+    - DBIx::Custom::Model name attribute is DEPRECATED!
88
+    - removed EXPERIMENTAL DBIx::Custom::Model alias_table
89
+    - added DBIx::Custom column method's table option
90
+    - separate DBIx::Custom::Result type_rule from filter again
91
+0.1692
92
+    - removed EXPERIMENTAL DBIx::Model result_filter
93
+    - DBIx::Custom::Result filter override type_rule
94
+    - added EXPERIMENTAL DBIx::Custom::Result type_rule
95
+    - added EXPERIMENTAL available_type_name method 
96
+    - EXPERIMENTAL type_rule_off is not passed form execute method 
97
+      to DBIx::Custom::Result object
98
+0.1691
99
+    - DBIx::Custom::Result end_filter, remove_filter, remove_end_filter is DEPRECATED!
100
+    - apply_filter is DEPRECATED!
101
+    - EXPERIMETAL column method and table_alias think about "-" separator
102
+    - EXPERIMTANL column method think about separator
103
+    - removed EXPERIMENTAL col method.
104
+    - added EXPERIMENTAL separater method
105
+    - added EXPERIMENTAL select prefix option.
106
+    - fixed bug that data_source DEPRECATED warnings pirnt STDERR
107
+    - fixed bug that type_rule from option can't receive filter name
108
+0.1690
109
+    - use latest Object::Simple features
110
+0.1689
111
+    - added EXPERIMENTAL available_data_type
112
+    - simplified type_rule
113
+    - changed type_rule arguments format
114
+    - added EXPERIMENTAL DBIx::Custom::Model result_filter attribute
115
+    - added EXPERIMETNAL DBIx::Custom::Result filter_off method
116
+    - EXPERIMENTAL type_rule can receive filter name
117
+0.1688
118
+    - fixed bug that model insert, update, delete select can't
119
+      odd number arguments
120
+    - improved type_rule method
121
+0.1687
122
+    - added EXPERIMENTAL type_rule method
123
+    - added EXPERIMENTAL execute() type_rule_off option
124
+    - execute method can second argument as parameter
125
+0.1686
126
+    - select() column option can receive array reference in array.
127
+      This is EXPERIMENTAL
128
+    - select() EXPERIMETNAL column option hash format
129
+      return table.column, not table__column
130
+    - added EXPERIMENTAL col method.
131
+    - set reserved_word_quote automatically from driver name
132
+0.1685
133
+    - insert_at, update_at, delete_at, select_at is DEPRECATED!
134
+      use insert, update, delete, select method and id option.
135
+    - insert, insert_at, update, update_at can receive odd number arguments,
136
+      first one is parameter.
137
+0.1684
138
+    - added DBIx::Custom::Result all method, this is alias for fetch_hash_all
139
+    - added DBIx::Custom::Result one method, this is alias for fetch_hash_first
140
+    - DBIx::Custom::Result fetch_hash_first can recieve argument
141
+    - select() column option can receive hash reference. This is EXPERIMENTAL
142
+    - update_param_tag is DEPRECATED! use update_param instead.
143
+    - insert_param_tag is DEPRECATED! use insert_param instead.
144
+    - assing_param_tag is DEPRECATED! use assign_param instead.
145
+    - Tag system such as {? title}, {= title} is DEPRECATED!
146
+      and added paramter system such as :title.
147
+0.1683
148
+    - data_source is DEPRECATED! It is renamed to dsn
149
+0.1682
150
+    - improved debug message
151
+    - fixed merge_param bug
152
+0.1681
153
+    - added EXPERIMENTAL assign_tag() method
154
+0.1680
155
+    - DEPRECATED select() param option, this is renamed to where_param
156
+    - added select(), update(), and delete() where_param option
157
+0.1679
158
+    - added EXPERIMENTAL select() wrap option to support Oracle ROWNUM
159
+0.1678
160
+    - DBIx::Custom::Model filter attribute can receive hash reference
161
+    - DBIx::Custom::Where clause attribute can receive clause without column name
162
+    - improved error messages
163
+0.1677
164
+    - improved table search in column and join clause
165
+    - DEPRECATED table tag. use table option.
166
+0.1676
167
+    - fixed test bug
168
+0.1675
169
+    - removed DEPRECATED DBIx::Custom::MySQL and DBIx::Custom::SQLite
170
+      these implementations remine in https://github.com/yuki-kimoto/DBIx-Custom/wiki
171
+      for some users.
172
+    - removed EXPERIMENTAL replace().
173
+    - removed EXPERIMENTAL mark from many methods.
174
+0.1674
175
+    - fixed test bug
176
+0.1673
177
+    - fixed dbh() method bug.
178
+0.1672
179
+    - removed EXPERIMENTAL Prefork server safe implementation, my implementation is very buggy.
180
+    - added EXPERIMETNAL connector() attribute.
181
+    - change retern value to array refrence of EXPERIMENTAL replace()
182
+0,1671
183
+    - added environment variable DBIX_CUSTOM_DEBUG
184
+0.1670
185
+    - removed EXPERIMETNAL select() column hash option. it's a little complex.
186
+    - added EXPERIMENTAL select() param option.
187
+    - added EXPERIMENTAL replace().
188
+0.1669
189
+    - renamed update_param to update_param_tag, update_param is DEPRECATED!
190
+    - renamed insert_param to insert_param_tag, insert_param is DEPRECATED!
191
+0.1668
192
+    - added EXPERIMENTAL update_param no_set option.
193
+    - added EXPERIMENTAL reserved_word_quote attribute.
194
+0.1666
195
+    - removed from cache() and cache_method() document for a while and cache() value
196
+      become 0 because I find something bug.
197
+    - create_model() return model.
198
+    - added document of hash filter
199
+    - adeed EXPERIMENTAL DBIx::Custom::Model method()
200
+0.1665
201
+    - removed EXPERIMETNAL flag from insert_at(), update_at(), delete_at(), select_at(), insert_param(), not_exists(), select()'s query option, update_param(), where, table tag, each column, safety_character, DBIx::Where, where().
202
+    - added EXPERIMETNAL create_model()
203
+0.1664
204
+    - where can recieve array refrence, which contains where cluase and paramter.
205
+0.1663
206
+    - added EXPERIMENTAL type() attribute to DBIx::Custom::Model
207
+    - added EXPERIMENTAL bind_param_option can set bind_param option
208
+      to insert(), update(), delete(), select(), insert_at(),
209
+      update_at(), delete_at(), select_at(), delete_all(), update_all()
210
+0.1662
211
+    - removed EXPERIMENTAL DBIx::Custom::Model column_clause
212
+    - added EXPERIMENTAL column()
213
+    - added EXPERIMENTAL mycolumn()
214
+0.1661
215
+    - added EXPERIMENTAL DBIx::Custom::Model table_alias attribute
216
+    - added EXPERIMENTAL DBIx::Custom::Model mycolumn()
217
+    - added EXPERIMENTAL DBIx::Custom::Model column()
218
+    - fixed autoloading bug
219
+    - added EXPERIMETNAL select() prepend table option
220
+    - added EXPERIMETNAL select() column table option
221
+    - added EXPERIMETNAL select() column all option
222
+    - removed EXPERIMETNAL select() all_column option
223
+    - removed EXPERIMENTAL view()
224
+0.1660
225
+    - added EXPERIMENTAL DBIx::Custom::Model view()
226
+    - added EXPERIMENTAL view()
227
+    - DBIx::Custom::Model inherit DBIx::Custom
228
+    - removed EXPERIMETNAL DBIx::Custom::Model method()
229
+    - added table choice feature to select() EXPERIMENTAL all_column option 
230
+    - removed EXPERIMENTAL DBIx::Custom::Model column attribute for side effect
231
+0.1659
232
+    - EXPERIMETAL fork safety implementaion.
233
+    - removed EXPERIMENTAL selection
234
+    - added select() all_column option
235
+0.1658
236
+    - added EXPERIMENTAL DBIx::Custom::Model column() prefix option.
237
+    - fixed select_at join column invalid bug
238
+    - added DBIx::Custom::Model column() attribute 
239
+0.1657
240
+    - remaned EXPERIMENTAL safty_charcter to safty_name
241
+    - safty_charcter is changed, set only one character regex.
242
+0.1656
243
+    - fixed some select() join opition bug
244
+0.1655
245
+    - added EXPERIMENTAL DBIx::Custom::Model join attribute
246
+    - added EXPERIMENTAL select() join option
247
+    - deprecated select() relation option
248
+    - added EXPERIMENTAL update_param and insert_param
249
+    - remove EXPERIMENTAL DBIx::Custom::Model relation
250
+0.1654
251
+    - selection can contain where clause.
252
+0.1653
253
+    - added EXPERIMENTAL DBIx::Custom::Result remove_filter()
254
+    - added EXPERIMENTAL DBIx::Custom::Result remove_end_filter()
255
+    - added EXPERIMENTAL DBIx::Custom::Model insert_at()
256
+    - added EXPERIMENTAL insert_at()
257
+    - improved error message
258
+0.1652
259
+    - all filter can receive array reference and receiving hash reference is DEPRECATED!
260
+0.1651
261
+    - add EXPERIMENTAL DBIx::Custom::Model filter attribute.
262
+0.1650
263
+    - add EXPERIMENTAL DBIx::Custom::Model name() attribute
264
+0.1649
265
+    - add EXPERIMENTAL DBIx::Custom::Model column_clause() method.
266
+    - select method column option can receive string.
267
+    - DBIx::Custom::Model select() and select_at() think about relation attirbute
268
+0.1648
269
+    - add EXPERIMENTAL DBIx::Custom::Model relation() attribute
270
+    - add EXPERIMENTAL update_at(), delete_at(), select_at()
271
+    - add EXPERIMENTAL setup_model()
272
+    - add EXPERIMENTAL DBIx::Custom::Model columns attirbute
273
+    - add EXPERIMENTAL DBIx::Custom::Model foreign_key() attribute 
274
+    - add EXPERIMENTAL models() attribute
275
+0.1647
276
+    - add default_dbi_option()
277
+0.1646
278
+    - add feture. all model class in namespace is included by include_model
279
+    - rename EXPERIMENTAL include_table to include_model
280
+    - rename EXPERIMENTAL table to model
281
+    - rename EXPERIMENTAL DBIx::Custom::Table to DBIx::Custom::Model
282
+    - remame EXPERIMENTAL DBIx::Custom::Table::name() to DBIx::Custom::Model::table();
283
+0.1645
284
+    - removed EXPERIMENTAL base_table() for class expandability.
285
+    - EXPERIMENTAL table() can't set table object any more.
286
+    - added EXPERIMENTAL include_table().
287
+0.1644
288
+    - update pod
289
+0.1643
290
+    - add EXPERIMENTAL selection option to select()
291
+    - add EXPERIMENTAL table tag
292
+    - fix bug : filter can't overwirite undef value.
293
+    - add EXPERIMENTAL feature to apply_filter(). you can apply end filter.
294
+    - add EXPERIMENTAL feature to apply_filter(). TABLE__COLUMN is filterded now.
295
+0.1642
296
+    - removed EXPERIMENTAL DBIx::Custom::Table base() method
297
+    - table created by tabled method can call base_$method correponding to base_table's one
298
+0.1641
299
+    - select() where can't receive array reference to prevend SQL injection easily(not backward compatible. sorry. use where() instead)
300
+    - added EXPERIMENTAL safety_column_name attribute
301
+    - fix SQL injection security hole about column name
302
+0.1640
303
+    - autoload DBI method
304
+    - removed EXPERIMENTAL expand
305
+0.1639
306
+    - improved delete() and update() where option. you can use DBIx::Custom::Where object
307
+    - added EXPERIMENTAL not_exists()
308
+0.1638
309
+    - table object call dbi object method if not found method.
310
+    - added EXPERIMENTAL base_table attribute and removed EXPERIMENTAL table_class attribute
311
+    - renamed helper to method.
312
+    - added EXPERIMENTAL DBIx::Custom::Result::stash()
313
+    - renamed EXPERIMENTAL DBIx::Custom::Table helper to method
314
+0.1637
315
+    - renamed dbi_options to dbi_option. dbi_options is available, but deprecated.
316
+    - renamed DBIx::Custom::TagProcessor to DBIx::Custom::Tag, and function names is cleanuped.
317
+    - renamed register_tag_processor to register_tag. register_tag_processor is available, but deprecated.
318
+    - renamed tag_processors to tags. tag_prosessors is available, but deprecated.
319
+    - improved error message
320
+    - build all clause if param is undefined.
321
+    - each_column callback receive self as first argument.
322
+    - removed EXPERIMENTAL txn_scope
323
+0.1636
324
+    - added tests and cleanup
325
+0.1635
326
+    - renamed iterate_all_columns to each_column
327
+0.1634
328
+    - became more useful where method
329
+    - changed DBIx::Custom::Where greatly
330
+0.1633
331
+    - fixed test
332
+0.1632
333
+    - added EXPERIMENTAL where method
334
+    - added EXPERIMENTAL DBIx::Custom::Where.
335
+    - removed DBIx::Custom::Or
336
+0.1631
337
+    - added EXPERIMENTAL DBIx::Custom::Result end_filter method
338
+    - EXPERIMENTAL extended select method's where option
339
+    - fix select method empty where failed bug
340
+    - added EXPERIMENTAL suger method query option
341
+    - added EXPERIMENTAL or method
342
+0.1630
343
+    - fix test bug
344
+0.1629
345
+    - renamed auto_filter to apply_filter
346
+    - changed apply_filter method arguments
347
+    - deprecated cache_method
348
+0.1628
349
+    - remove DBIx::Custom::Model
350
+    - move table method and table_class attribute to DBIx::Custom
351
+    - added examples
352
+    - fixed connect method bug
353
+0.1627
354
+    - added insert, update, update_all, delete, delete_all, select method to DBIx::Custom::Table
355
+    - added EXPERIMENTAL txn_scope
356
+0.1626
357
+    - simplified DBIx::Custom::Model and DBIx::Custom::Table
358
+0.1625
359
+    - added EXPERIMENTAL DBIx::Custom::Model and DBIx::Custom::Table
360
+0.1624
361
+    - added EXPERIMENTAL iterate_all_columns method.
362
+0.1623
363
+    - added EXPERIMENTAL auto_filter method
364
+    - deprecated default_bind_filter and default_fetch_filter because these are global effect.
365
+    - changed defautl_bind_filter and default_fetch_filter attributes to methods.
366
+    - changed DBIx::Custom::Result default_filter attribute to method
367
+    - changed DBIx::Custom::Result filter attribute to method.
368
+    - filter_check is always done for usability
369
+0.1622
370
+    - deprecated DBIx::Custom::SQLite and DBIx::Custom::MySQL
371
+    - added dbi_options attribute
372
+    - checked attributes passed to connect method
373
+0.1621
374
+    - cleanup (removed undocumented features)
375
+0.1620
376
+    - updated document
377
+0.1619
378
+    - updated document
379
+    - added EXPERIMENTAL expand method
380
+0.1618
381
+    - added helper method
382
+    - added begin_work, commit, and rollback method
383
+0.1617
384
+    - L<DBIx::Custom> is now stable. APIs keep backword compatible in the feature.
385
+0.1616
386
+    - removed EXPERIMENTAL register_method(), and methods attribute, because it is too magical
387
+0.1615
388
+    - fixed DBIx::Custom::QueryBuilder build_query() bug
389
+    - required Perl 5.008001 to use @CARP_NOT 
390
+0.1614
391
+    - removed DBIx::Custom::Query start_tag and end tag attributes
392
+    - enable escaping '{' and '}' in the source of SQL
393
+    - fixed Carp Carp trust relationship
394
+0.1613
395
+    - added EXPERIMENTAL register_method() method
396
+    - added EXPERIMENTAL methods attribute
397
+0.1612
398
+    - added tests
399
+    - updated document
400
+    - removed DBIx::Custom::SQLite last_insert_rawid() mehtod(not backword compatible)
401
+    - removed DBIx::Custom::MySQL last_insert_id() method(not backword compatible)
402
+0.1611
403
+    - renamed update tag to update_param
404
+    - renamed insert tag to insert_param
405
+    - renamed sql_builder to query_builder
406
+0.1610
407
+    - added filter_check attribute.
408
+0.1609
409
+    - updated document.
410
+0.1608
411
+    - update document
412
+    - renamed DBIx::Custom::QueryBuilder::TagProcessors functions(not backword compatible)
413
+0.1607
414
+    - where argument of select() method can specify array(string, parameters)
415
+    - renamed build_query() to create_query()(not backword compatible)
416
+0.1606
417
+    - fix testing bug
418
+0.1605
419
+    - remove DBIx::Custom::QueryBuilder::tag_syntax()  (not backword compatible)
420
+    - renamed DBIx::Custom::TagProcessor to DBIx::Custom::TagProcessors (not backword compatible)
421
+    - changed arguments of tag processor(not backword compatible)
422
+    - renamed DBIx::Custom::QueryBuilder::TagProcessors functions(not backword compatible)
423
+0.1604
424
+    - changed argument of tag processor(not backword compatible)
425
+    - renamed default_query_filter to default_bind_filter(not backword compatible)
426
+    - renamed DBIx::Custom::SQLTemplate to DBIx::Custom::SQLBuilder(not backword compatible)
427
+    - renamed create_query to build_query(not backword compatible)
428
+    - renamed sql_template to sql_builder(not backword compatible)
429
+    - removed DESTROY method(not backword compatible)
430
+    - removed disconnect method(not backword compatible)
431
+    - fixed DBIx::Custom::MySQL connect_memory
432
+0.1603
433
+    - removed DBIx::Custom commit method (not backword compatible)
434
+    - removed DBIx::Custom rollback method (not backword compatible)
435
+    - removed DBIx::Custom auto_commit method (not backword compatible)
436
+0.1602
437
+    - added cache_method attribute
438
+0.1601
439
+    - added cache attribute
440
+    - select, insert, update, update_all, delete, delete_all, execute only receive hash argument(not backword compatible)
441
+0.1503
442
+    - removed reconnect method
443
+    - removed connected method
444
+    - removed reconnect_memroy method
445
+    - renamed fetch_single to fetch_first
446
+    - renamed fetch_hash_single to fetch_hash_first
447
+    - updated document
448
+0.1502
449
+    - added commit method
450
+    - added rollback method
451
+    - changed select argument, added relation option
452
+    - moved host attribute to DBIx::Custom::MySQL
453
+    - moved port attribute to DBIx::Custom::MySQL
454
+    - moved database attribute to DBIx::Custom::MySQL and DBIx::Custom::SQLite
455
+0.1501
456
+    - removed register_format()
457
+    - removed formats()
458
+    - removed run_transaction()
459
+    - removed create_table()
460
+    - removed drop_table()
461
+    - changed select() arguments
462
+    - changed insert() arguments
463
+    - changed update() arguments
464
+    - changed update_all() arguments
465
+    - changed delete() arguments
466
+    - changed delete_all() arguments
467
+    - changed execute() arguments
468
+0.1402
469
+    - remove finish(), error()
470
+    - can receive code ref to filter()
471
+    - renamed resist to register
472
+0.1401
473
+    - renamed fetch_rows to fetch_multi
474
+    - renamed fetch_hash_rows to fetch_hash_multi
475
+0.1301
476
+    - Changed many(not backword compatible)
477
+0.1201
478
+    - Changed many(not backword compatible)
479
+0.1101
480
+    - rename DBIx::Custom::SQLite last_insert_id to last_insert_rowid
481
+0.1001
482
+    - remove run_transaction().
483
+    - add transaction() and DBIx::Custom::Transaction
484
+    - rename fetch_first to fetch_single
485
+    - rename fetch_hash_first to fetch_hash_single
486
+0.0906
487
+    - fix some bug
488
+0.0905
489
+    - catch up with Object::Simple update
490
+0.0904
491
+    - cleanup
492
+0.0903
493
+    - catch up with Object::Simple update
494
+0.0902
495
+    - cleanup
496
+0.0901
497
+    - DBIx::Basic filter 'encode_utf8' utf8::upgrade process is deleted
498
+0.0801
499
+    - add 'create_table', 'drop_table' methods
500
+0.0701
501
+    - rename sql_template to sql_tmpl (not backword compatible)
502
+    - rename dbi_options to options (not backword compatible)
503
+0.0605
504
+    - fix encode_utf8 filter
505
+0.0604
506
+    - fix timeformat tests
507
+0.0603
508
+    - fix cache system bug
509
+0.0602
510
+    - update document
511
+0.0601
512
+    - bind_filter argument is changed to ($value, $key, $dbi, $infos) (not backword compatible)
513
+    - fetch_filter argument is changed to ($value, $key, $dbi, $infos) (not backword compatible)
514
+    - run_transaction argument is changed to ($dbi)
515
+0.0502
516
+    - update document
517
+0.0501
518
+    - packaging DBIx::Custom::Result DBIx::Custom::Query DBIx::Custom::MySQL DBIx::Custom::SQLite DBIx::Custom::SQL::Template 
519
+0.0401
520
+    - catch up with DBIx::Custom::Result version up
521
+0.0301
522
+    - exchange filter argument 'key', 'value' (not backword compatible)
523
+0.0201
524
+    - rename tranzaction to transaction
525
+    - add filter_off
526
+0.0101
527
+    - First release
+527
DBIx-Custom-0.1711/DBIx-Custom-0.1711/Changes
... ...
@@ -0,0 +1,527 @@
1
+0.1710
2
+    - use more DBIx::Custom information in sub modules to decrease bugs
3
+      (very sorry, this change can't keep backword compatible,
4
+       but maybe no effects,
5
+       because the attributes is automatically set by DBIx::Custom, not user).
6
+    - Fixed fisrt executed where clause failed in some condition.
7
+0.1709
8
+    - fixed named placeholder bug and added escape syntax
9
+0.1708
10
+    - improved execute method performance
11
+0.1707
12
+    - I call :title named placeholder, stoping calling it parameter
13
+    - removed some EXPERIMENTAL status
14
+    - fixed performance
15
+0.1706
16
+    - Added execute method's query option document
17
+      You can get more performance.
18
+    - DBIx::Custom::Query table and filters attribute method and
19
+      filter method is DEPRECATED!
20
+      because I think query object must have only the information
21
+      for statement handle caching.
22
+0.1705
23
+    - insert and update method's param can set constant value by scalara reference
24
+      such as {date => \"NOW()"} This is EXPERIMENTAL.
25
+0.1704
26
+    - added quote method's two character support like []
27
+      for Microsoft SQL Server and Access
28
+    - added EXPERIMENTAL parameter new syntax :name{operator}
29
+0.1703
30
+    - added EXPERIMENTAL join new syntax.
31
+0.1702
32
+    - removed EXPERIMENTAL status of some methods.
33
+    - fixed some join bug
34
+0.1701
35
+    - added DBIx::Cusotm::Order prepend method automatically quoted syntax
36
+    - simplified arguments check
37
+    - added EXPERIMENTAL each_table method
38
+    - select method column option [COLUMN, as => ALIAS] format is DEPRECATED!
39
+      changed to [COLUMN => ALIAS]
40
+    - added EXPERIMENTAL DBIx::Custom::Result header method
41
+    - added EXPERIMENTAL last_sql attribute method
42
+0.1700
43
+    - fixed end_filter DEPRECATED warnings bug
44
+0.1699
45
+    - added tag_parse attribute.
46
+    - added EXPERIMENTAL order method
47
+    - added EXPERIMENTAL DBIx::Custom::Order module
48
+    - changed backword compatible policy
49
+      ------------------------------------------------------------------------
50
+      If a functionality is DEPRECATED, you can know it by DEPRECATED warnings
51
+      except for attribute method.
52
+      You can check all DEPRECATED functionalities by document.
53
+      DEPRECATED functionality is removed after five years,
54
+      but if at least one person use the functionality and tell me that thing
55
+      I extend one year each time you tell me it.
56
+
57
+      EXPERIMENTAL functionality will be changed without warnings.
58
+      ------------------------------------------------------------------------
59
+0.1698
60
+    - fixed DBIx::Custom::Where to_string method small bug
61
+    - added EXPERIMENTAL execute method table_alias option
62
+0.1697
63
+    - added EXPERIMENTAL map_param method
64
+0.1696
65
+    - added new argument format update, delete, select method where option
66
+    - create_query is DEPRECATED! use query option of each method instead.
67
+    - added EXPERIMENTAL insert, update, and select method prefix option
68
+    - fixed small insert, update, delete, select method id option bug
69
+0.1695
70
+    - changed EXPERIMENTAL DBIx::Custom::Result type_rule_off method argument
71
+    - added EXPERIMENTAL DBIx::Custom::Result type_rule_on method
72
+    - changed EXPERIMENTAL DBIx::Custom::Result type_rule1_off method argument
73
+    - added EXPERIMENTAL DBIx::Custom::Result type_rule1_on method
74
+    - changed EXPERIMENTAL DBIx::Custom::Result type_rule2_off method argument
75
+    - added EXPERIMENTAL DBIx::Custom::Result type_rule2_on method
76
+    - changed EXPERIMENTAL DBIx::Custom::Result filter_off method argument
77
+    - added EXPERIMENTAL DBIx::Custom::Result filter_on method
78
+0.1694
79
+    - EXPERIMENTAL type_rule argument format is changed
80
+    - DBIx::Custom::Result type_rule method on setting return self 
81
+    - reserved_word_quote is DEPRECATED! this is renamed to quote
82
+    - DBIx::Custom::Model type attribute is DEPRECATED!
83
+      this is renamed to bind_type.
84
+0.1693
85
+    - separate DBIx::Custom type_rule from filter
86
+    - DBIx::Custom::Model filter attrribute is DEPRECATED!
87
+    - DBIx::Custom::Model name attribute is DEPRECATED!
88
+    - removed EXPERIMENTAL DBIx::Custom::Model alias_table
89
+    - added DBIx::Custom column method's table option
90
+    - separate DBIx::Custom::Result type_rule from filter again
91
+0.1692
92
+    - removed EXPERIMENTAL DBIx::Model result_filter
93
+    - DBIx::Custom::Result filter override type_rule
94
+    - added EXPERIMENTAL DBIx::Custom::Result type_rule
95
+    - added EXPERIMENTAL available_type_name method 
96
+    - EXPERIMENTAL type_rule_off is not passed form execute method 
97
+      to DBIx::Custom::Result object
98
+0.1691
99
+    - DBIx::Custom::Result end_filter, remove_filter, remove_end_filter is DEPRECATED!
100
+    - apply_filter is DEPRECATED!
101
+    - EXPERIMETAL column method and table_alias think about "-" separator
102
+    - EXPERIMTANL column method think about separator
103
+    - removed EXPERIMENTAL col method.
104
+    - added EXPERIMENTAL separater method
105
+    - added EXPERIMENTAL select prefix option.
106
+    - fixed bug that data_source DEPRECATED warnings pirnt STDERR
107
+    - fixed bug that type_rule from option can't receive filter name
108
+0.1690
109
+    - use latest Object::Simple features
110
+0.1689
111
+    - added EXPERIMENTAL available_data_type
112
+    - simplified type_rule
113
+    - changed type_rule arguments format
114
+    - added EXPERIMENTAL DBIx::Custom::Model result_filter attribute
115
+    - added EXPERIMETNAL DBIx::Custom::Result filter_off method
116
+    - EXPERIMENTAL type_rule can receive filter name
117
+0.1688
118
+    - fixed bug that model insert, update, delete select can't
119
+      odd number arguments
120
+    - improved type_rule method
121
+0.1687
122
+    - added EXPERIMENTAL type_rule method
123
+    - added EXPERIMENTAL execute() type_rule_off option
124
+    - execute method can second argument as parameter
125
+0.1686
126
+    - select() column option can receive array reference in array.
127
+      This is EXPERIMENTAL
128
+    - select() EXPERIMETNAL column option hash format
129
+      return table.column, not table__column
130
+    - added EXPERIMENTAL col method.
131
+    - set reserved_word_quote automatically from driver name
132
+0.1685
133
+    - insert_at, update_at, delete_at, select_at is DEPRECATED!
134
+      use insert, update, delete, select method and id option.
135
+    - insert, insert_at, update, update_at can receive odd number arguments,
136
+      first one is parameter.
137
+0.1684
138
+    - added DBIx::Custom::Result all method, this is alias for fetch_hash_all
139
+    - added DBIx::Custom::Result one method, this is alias for fetch_hash_first
140
+    - DBIx::Custom::Result fetch_hash_first can recieve argument
141
+    - select() column option can receive hash reference. This is EXPERIMENTAL
142
+    - update_param_tag is DEPRECATED! use update_param instead.
143
+    - insert_param_tag is DEPRECATED! use insert_param instead.
144
+    - assing_param_tag is DEPRECATED! use assign_param instead.
145
+    - Tag system such as {? title}, {= title} is DEPRECATED!
146
+      and added paramter system such as :title.
147
+0.1683
148
+    - data_source is DEPRECATED! It is renamed to dsn
149
+0.1682
150
+    - improved debug message
151
+    - fixed merge_param bug
152
+0.1681
153
+    - added EXPERIMENTAL assign_tag() method
154
+0.1680
155
+    - DEPRECATED select() param option, this is renamed to where_param
156
+    - added select(), update(), and delete() where_param option
157
+0.1679
158
+    - added EXPERIMENTAL select() wrap option to support Oracle ROWNUM
159
+0.1678
160
+    - DBIx::Custom::Model filter attribute can receive hash reference
161
+    - DBIx::Custom::Where clause attribute can receive clause without column name
162
+    - improved error messages
163
+0.1677
164
+    - improved table search in column and join clause
165
+    - DEPRECATED table tag. use table option.
166
+0.1676
167
+    - fixed test bug
168
+0.1675
169
+    - removed DEPRECATED DBIx::Custom::MySQL and DBIx::Custom::SQLite
170
+      these implementations remine in https://github.com/yuki-kimoto/DBIx-Custom/wiki
171
+      for some users.
172
+    - removed EXPERIMENTAL replace().
173
+    - removed EXPERIMENTAL mark from many methods.
174
+0.1674
175
+    - fixed test bug
176
+0.1673
177
+    - fixed dbh() method bug.
178
+0.1672
179
+    - removed EXPERIMENTAL Prefork server safe implementation, my implementation is very buggy.
180
+    - added EXPERIMETNAL connector() attribute.
181
+    - change retern value to array refrence of EXPERIMENTAL replace()
182
+0,1671
183
+    - added environment variable DBIX_CUSTOM_DEBUG
184
+0.1670
185
+    - removed EXPERIMETNAL select() column hash option. it's a little complex.
186
+    - added EXPERIMENTAL select() param option.
187
+    - added EXPERIMENTAL replace().
188
+0.1669
189
+    - renamed update_param to update_param_tag, update_param is DEPRECATED!
190
+    - renamed insert_param to insert_param_tag, insert_param is DEPRECATED!
191
+0.1668
192
+    - added EXPERIMENTAL update_param no_set option.
193
+    - added EXPERIMENTAL reserved_word_quote attribute.
194
+0.1666
195
+    - removed from cache() and cache_method() document for a while and cache() value
196
+      become 0 because I find something bug.
197
+    - create_model() return model.
198
+    - added document of hash filter
199
+    - adeed EXPERIMENTAL DBIx::Custom::Model method()
200
+0.1665
201
+    - removed EXPERIMETNAL flag from insert_at(), update_at(), delete_at(), select_at(), insert_param(), not_exists(), select()'s query option, update_param(), where, table tag, each column, safety_character, DBIx::Where, where().
202
+    - added EXPERIMETNAL create_model()
203
+0.1664
204
+    - where can recieve array refrence, which contains where cluase and paramter.
205
+0.1663
206
+    - added EXPERIMENTAL type() attribute to DBIx::Custom::Model
207
+    - added EXPERIMENTAL bind_param_option can set bind_param option
208
+      to insert(), update(), delete(), select(), insert_at(),
209
+      update_at(), delete_at(), select_at(), delete_all(), update_all()
210
+0.1662
211
+    - removed EXPERIMENTAL DBIx::Custom::Model column_clause
212
+    - added EXPERIMENTAL column()
213
+    - added EXPERIMENTAL mycolumn()
214
+0.1661
215
+    - added EXPERIMENTAL DBIx::Custom::Model table_alias attribute
216
+    - added EXPERIMENTAL DBIx::Custom::Model mycolumn()
217
+    - added EXPERIMENTAL DBIx::Custom::Model column()
218
+    - fixed autoloading bug
219
+    - added EXPERIMETNAL select() prepend table option
220
+    - added EXPERIMETNAL select() column table option
221
+    - added EXPERIMETNAL select() column all option
222
+    - removed EXPERIMETNAL select() all_column option
223
+    - removed EXPERIMENTAL view()
224
+0.1660
225
+    - added EXPERIMENTAL DBIx::Custom::Model view()
226
+    - added EXPERIMENTAL view()
227
+    - DBIx::Custom::Model inherit DBIx::Custom
228
+    - removed EXPERIMETNAL DBIx::Custom::Model method()
229
+    - added table choice feature to select() EXPERIMENTAL all_column option 
230
+    - removed EXPERIMENTAL DBIx::Custom::Model column attribute for side effect
231
+0.1659
232
+    - EXPERIMETAL fork safety implementaion.
233
+    - removed EXPERIMENTAL selection
234
+    - added select() all_column option
235
+0.1658
236
+    - added EXPERIMENTAL DBIx::Custom::Model column() prefix option.
237
+    - fixed select_at join column invalid bug
238
+    - added DBIx::Custom::Model column() attribute 
239
+0.1657
240
+    - remaned EXPERIMENTAL safty_charcter to safty_name
241
+    - safty_charcter is changed, set only one character regex.
242
+0.1656
243
+    - fixed some select() join opition bug
244
+0.1655
245
+    - added EXPERIMENTAL DBIx::Custom::Model join attribute
246
+    - added EXPERIMENTAL select() join option
247
+    - deprecated select() relation option
248
+    - added EXPERIMENTAL update_param and insert_param
249
+    - remove EXPERIMENTAL DBIx::Custom::Model relation
250
+0.1654
251
+    - selection can contain where clause.
252
+0.1653
253
+    - added EXPERIMENTAL DBIx::Custom::Result remove_filter()
254
+    - added EXPERIMENTAL DBIx::Custom::Result remove_end_filter()
255
+    - added EXPERIMENTAL DBIx::Custom::Model insert_at()
256
+    - added EXPERIMENTAL insert_at()
257
+    - improved error message
258
+0.1652
259
+    - all filter can receive array reference and receiving hash reference is DEPRECATED!
260
+0.1651
261
+    - add EXPERIMENTAL DBIx::Custom::Model filter attribute.
262
+0.1650
263
+    - add EXPERIMENTAL DBIx::Custom::Model name() attribute
264
+0.1649
265
+    - add EXPERIMENTAL DBIx::Custom::Model column_clause() method.
266
+    - select method column option can receive string.
267
+    - DBIx::Custom::Model select() and select_at() think about relation attirbute
268
+0.1648
269
+    - add EXPERIMENTAL DBIx::Custom::Model relation() attribute
270
+    - add EXPERIMENTAL update_at(), delete_at(), select_at()
271
+    - add EXPERIMENTAL setup_model()
272
+    - add EXPERIMENTAL DBIx::Custom::Model columns attirbute
273
+    - add EXPERIMENTAL DBIx::Custom::Model foreign_key() attribute 
274
+    - add EXPERIMENTAL models() attribute
275
+0.1647
276
+    - add default_dbi_option()
277
+0.1646
278
+    - add feture. all model class in namespace is included by include_model
279
+    - rename EXPERIMENTAL include_table to include_model
280
+    - rename EXPERIMENTAL table to model
281
+    - rename EXPERIMENTAL DBIx::Custom::Table to DBIx::Custom::Model
282
+    - remame EXPERIMENTAL DBIx::Custom::Table::name() to DBIx::Custom::Model::table();
283
+0.1645
284
+    - removed EXPERIMENTAL base_table() for class expandability.
285
+    - EXPERIMENTAL table() can't set table object any more.
286
+    - added EXPERIMENTAL include_table().
287
+0.1644
288
+    - update pod
289
+0.1643
290
+    - add EXPERIMENTAL selection option to select()
291
+    - add EXPERIMENTAL table tag
292
+    - fix bug : filter can't overwirite undef value.
293
+    - add EXPERIMENTAL feature to apply_filter(). you can apply end filter.
294
+    - add EXPERIMENTAL feature to apply_filter(). TABLE__COLUMN is filterded now.
295
+0.1642
296
+    - removed EXPERIMENTAL DBIx::Custom::Table base() method
297
+    - table created by tabled method can call base_$method correponding to base_table's one
298
+0.1641
299
+    - select() where can't receive array reference to prevend SQL injection easily(not backward compatible. sorry. use where() instead)
300
+    - added EXPERIMENTAL safety_column_name attribute
301
+    - fix SQL injection security hole about column name
302
+0.1640
303
+    - autoload DBI method
304
+    - removed EXPERIMENTAL expand
305
+0.1639
306
+    - improved delete() and update() where option. you can use DBIx::Custom::Where object
307
+    - added EXPERIMENTAL not_exists()
308
+0.1638
309
+    - table object call dbi object method if not found method.
310
+    - added EXPERIMENTAL base_table attribute and removed EXPERIMENTAL table_class attribute
311
+    - renamed helper to method.
312
+    - added EXPERIMENTAL DBIx::Custom::Result::stash()
313
+    - renamed EXPERIMENTAL DBIx::Custom::Table helper to method
314
+0.1637
315
+    - renamed dbi_options to dbi_option. dbi_options is available, but deprecated.
316
+    - renamed DBIx::Custom::TagProcessor to DBIx::Custom::Tag, and function names is cleanuped.
317
+    - renamed register_tag_processor to register_tag. register_tag_processor is available, but deprecated.
318
+    - renamed tag_processors to tags. tag_prosessors is available, but deprecated.
319
+    - improved error message
320
+    - build all clause if param is undefined.
321
+    - each_column callback receive self as first argument.
322
+    - removed EXPERIMENTAL txn_scope
323
+0.1636
324
+    - added tests and cleanup
325
+0.1635
326
+    - renamed iterate_all_columns to each_column
327
+0.1634
328
+    - became more useful where method
329
+    - changed DBIx::Custom::Where greatly
330
+0.1633
331
+    - fixed test
332
+0.1632
333
+    - added EXPERIMENTAL where method
334
+    - added EXPERIMENTAL DBIx::Custom::Where.
335
+    - removed DBIx::Custom::Or
336
+0.1631
337
+    - added EXPERIMENTAL DBIx::Custom::Result end_filter method
338
+    - EXPERIMENTAL extended select method's where option
339
+    - fix select method empty where failed bug
340
+    - added EXPERIMENTAL suger method query option
341
+    - added EXPERIMENTAL or method
342
+0.1630
343
+    - fix test bug
344
+0.1629
345
+    - renamed auto_filter to apply_filter
346
+    - changed apply_filter method arguments
347
+    - deprecated cache_method
348
+0.1628
349
+    - remove DBIx::Custom::Model
350
+    - move table method and table_class attribute to DBIx::Custom
351
+    - added examples
352
+    - fixed connect method bug
353
+0.1627
354
+    - added insert, update, update_all, delete, delete_all, select method to DBIx::Custom::Table
355
+    - added EXPERIMENTAL txn_scope
356
+0.1626
357
+    - simplified DBIx::Custom::Model and DBIx::Custom::Table
358
+0.1625
359
+    - added EXPERIMENTAL DBIx::Custom::Model and DBIx::Custom::Table
360
+0.1624
361
+    - added EXPERIMENTAL iterate_all_columns method.
362
+0.1623
363
+    - added EXPERIMENTAL auto_filter method
364
+    - deprecated default_bind_filter and default_fetch_filter because these are global effect.
365
+    - changed defautl_bind_filter and default_fetch_filter attributes to methods.
366
+    - changed DBIx::Custom::Result default_filter attribute to method
367
+    - changed DBIx::Custom::Result filter attribute to method.
368
+    - filter_check is always done for usability
369
+0.1622
370
+    - deprecated DBIx::Custom::SQLite and DBIx::Custom::MySQL
371
+    - added dbi_options attribute
372
+    - checked attributes passed to connect method
373
+0.1621
374
+    - cleanup (removed undocumented features)
375
+0.1620
376
+    - updated document
377
+0.1619
378
+    - updated document
379
+    - added EXPERIMENTAL expand method
380
+0.1618
381
+    - added helper method
382
+    - added begin_work, commit, and rollback method
383
+0.1617
384
+    - L<DBIx::Custom> is now stable. APIs keep backword compatible in the feature.
385
+0.1616
386
+    - removed EXPERIMENTAL register_method(), and methods attribute, because it is too magical
387
+0.1615
388
+    - fixed DBIx::Custom::QueryBuilder build_query() bug
389
+    - required Perl 5.008001 to use @CARP_NOT 
390
+0.1614
391
+    - removed DBIx::Custom::Query start_tag and end tag attributes
392
+    - enable escaping '{' and '}' in the source of SQL
393
+    - fixed Carp Carp trust relationship
394
+0.1613
395
+    - added EXPERIMENTAL register_method() method
396
+    - added EXPERIMENTAL methods attribute
397
+0.1612
398
+    - added tests
399
+    - updated document
400
+    - removed DBIx::Custom::SQLite last_insert_rawid() mehtod(not backword compatible)
401
+    - removed DBIx::Custom::MySQL last_insert_id() method(not backword compatible)
402
+0.1611
403
+    - renamed update tag to update_param
404
+    - renamed insert tag to insert_param
405
+    - renamed sql_builder to query_builder
406
+0.1610
407
+    - added filter_check attribute.
408
+0.1609
409
+    - updated document.
410
+0.1608
411
+    - update document
412
+    - renamed DBIx::Custom::QueryBuilder::TagProcessors functions(not backword compatible)
413
+0.1607
414
+    - where argument of select() method can specify array(string, parameters)
415
+    - renamed build_query() to create_query()(not backword compatible)
416
+0.1606
417
+    - fix testing bug
418
+0.1605
419
+    - remove DBIx::Custom::QueryBuilder::tag_syntax()  (not backword compatible)
420
+    - renamed DBIx::Custom::TagProcessor to DBIx::Custom::TagProcessors (not backword compatible)
421
+    - changed arguments of tag processor(not backword compatible)
422
+    - renamed DBIx::Custom::QueryBuilder::TagProcessors functions(not backword compatible)
423
+0.1604
424
+    - changed argument of tag processor(not backword compatible)
425
+    - renamed default_query_filter to default_bind_filter(not backword compatible)
426
+    - renamed DBIx::Custom::SQLTemplate to DBIx::Custom::SQLBuilder(not backword compatible)
427
+    - renamed create_query to build_query(not backword compatible)
428
+    - renamed sql_template to sql_builder(not backword compatible)
429
+    - removed DESTROY method(not backword compatible)
430
+    - removed disconnect method(not backword compatible)
431
+    - fixed DBIx::Custom::MySQL connect_memory
432
+0.1603
433
+    - removed DBIx::Custom commit method (not backword compatible)
434
+    - removed DBIx::Custom rollback method (not backword compatible)
435
+    - removed DBIx::Custom auto_commit method (not backword compatible)
436
+0.1602
437
+    - added cache_method attribute
438
+0.1601
439
+    - added cache attribute
440
+    - select, insert, update, update_all, delete, delete_all, execute only receive hash argument(not backword compatible)
441
+0.1503
442
+    - removed reconnect method
443
+    - removed connected method
444
+    - removed reconnect_memroy method
445
+    - renamed fetch_single to fetch_first
446
+    - renamed fetch_hash_single to fetch_hash_first
447
+    - updated document
448
+0.1502
449
+    - added commit method
450
+    - added rollback method
451
+    - changed select argument, added relation option
452
+    - moved host attribute to DBIx::Custom::MySQL
453
+    - moved port attribute to DBIx::Custom::MySQL
454
+    - moved database attribute to DBIx::Custom::MySQL and DBIx::Custom::SQLite
455
+0.1501
456
+    - removed register_format()
457
+    - removed formats()
458
+    - removed run_transaction()
459
+    - removed create_table()
460
+    - removed drop_table()
461
+    - changed select() arguments
462
+    - changed insert() arguments
463
+    - changed update() arguments
464
+    - changed update_all() arguments
465
+    - changed delete() arguments
466
+    - changed delete_all() arguments
467
+    - changed execute() arguments
468
+0.1402
469
+    - remove finish(), error()
470
+    - can receive code ref to filter()
471
+    - renamed resist to register
472
+0.1401
473
+    - renamed fetch_rows to fetch_multi
474
+    - renamed fetch_hash_rows to fetch_hash_multi
475
+0.1301
476
+    - Changed many(not backword compatible)
477
+0.1201
478
+    - Changed many(not backword compatible)
479
+0.1101
480
+    - rename DBIx::Custom::SQLite last_insert_id to last_insert_rowid
481
+0.1001
482
+    - remove run_transaction().
483
+    - add transaction() and DBIx::Custom::Transaction
484
+    - rename fetch_first to fetch_single
485
+    - rename fetch_hash_first to fetch_hash_single
486
+0.0906
487
+    - fix some bug
488
+0.0905
489
+    - catch up with Object::Simple update
490
+0.0904
491
+    - cleanup
492
+0.0903
493
+    - catch up with Object::Simple update
494
+0.0902
495
+    - cleanup
496
+0.0901
497
+    - DBIx::Basic filter 'encode_utf8' utf8::upgrade process is deleted
498
+0.0801
499
+    - add 'create_table', 'drop_table' methods
500
+0.0701
501
+    - rename sql_template to sql_tmpl (not backword compatible)
502
+    - rename dbi_options to options (not backword compatible)
503
+0.0605
504
+    - fix encode_utf8 filter
505
+0.0604
506
+    - fix timeformat tests
507
+0.0603
508
+    - fix cache system bug
509
+0.0602
510
+    - update document
511
+0.0601
512
+    - bind_filter argument is changed to ($value, $key, $dbi, $infos) (not backword compatible)
513
+    - fetch_filter argument is changed to ($value, $key, $dbi, $infos) (not backword compatible)
514
+    - run_transaction argument is changed to ($dbi)
515
+0.0502
516
+    - update document
517
+0.0501
518
+    - packaging DBIx::Custom::Result DBIx::Custom::Query DBIx::Custom::MySQL DBIx::Custom::SQLite DBIx::Custom::SQL::Template 
519
+0.0401
520
+    - catch up with DBIx::Custom::Result version up
521
+0.0301
522
+    - exchange filter argument 'key', 'value' (not backword compatible)
523
+0.0201
524
+    - rename tranzaction to transaction
525
+    - add filter_off
526
+0.0101
527
+    - First release
+3203
DBIx-Custom-0.1711/DBIx-Custom-0.1711/lib/DBIx/Custom.pm
... ...
@@ -0,0 +1,3203 @@
1
+package DBIx::Custom;
2
+use Object::Simple -base;
3
+
4
+our $VERSION = '0.1711';
5
+use 5.008001;
6
+
7
+use Carp 'croak';
8
+use DBI;
9
+use DBIx::Custom::Result;
10
+use DBIx::Custom::Query;
11
+use DBIx::Custom::QueryBuilder;
12
+use DBIx::Custom::Where;
13
+use DBIx::Custom::Model;
14
+use DBIx::Custom::Tag;
15
+use DBIx::Custom::Order;
16
+use DBIx::Custom::Util qw/_array_to_hash _subname/;
17
+use Encode qw/encode encode_utf8 decode_utf8/;
18
+
19
+use constant DEBUG => $ENV{DBIX_CUSTOM_DEBUG} || 0;
20
+use constant DEBUG_ENCODING => $ENV{DBIX_CUSTOM_DEBUG_ENCODING} || 'UTF-8';
21
+
22
+has [qw/connector dsn password quote user/],
23
+    cache => 0,
24
+    cache_method => sub {
25
+        sub {
26
+            my $self = shift;
27
+            
28
+            $self->{_cached} ||= {};
29
+            
30
+            if (@_ > 1) {
31
+                $self->{_cached}{$_[0]} = $_[1];
32
+            }
33
+            else {
34
+                return $self->{_cached}{$_[0]};
35
+            }
36
+        }
37
+    },
38
+    dbi_option => sub { {} },
39
+    default_dbi_option => sub {
40
+        {
41
+            RaiseError => 1,
42
+            PrintError => 0,
43
+            AutoCommit => 1
44
+        }
45
+    },
46
+    filters => sub {
47
+        {
48
+            encode_utf8 => sub { encode_utf8($_[0]) },
49
+            decode_utf8 => sub { decode_utf8($_[0]) }
50
+        }
51
+    },
52
+    last_sql => '',
53
+    models => sub { {} },
54
+    query_builder => sub { DBIx::Custom::QueryBuilder->new(dbi => shift) },
55
+    result_class  => 'DBIx::Custom::Result',
56
+    safety_character => '\w',
57
+    stash => sub { {} },
58
+    tag_parse => 1;
59
+
60
+our $AUTOLOAD;
61
+sub AUTOLOAD {
62
+    my $self = shift;
63
+
64
+    # Method name
65
+    my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
66
+
67
+    # Call method
68
+    $self->{_methods} ||= {};
69
+    if (my $method = $self->{_methods}->{$mname}) {
70
+        return $self->$method(@_)
71
+    }
72
+    elsif ($self->{dbh} && (my $dbh_method = $self->dbh->can($mname))) {
73
+        $self->dbh->$dbh_method(@_);
74
+    }
75
+    else {
76
+        croak qq{Can't locate object method "$mname" via "$package" }
77
+            . _subname;
78
+    }
79
+}
80
+
81
+sub assign_param {
82
+    my ($self, $param) = @_;
83
+    
84
+    # Create set tag
85
+    my @params;
86
+    my $safety = $self->safety_character;
87
+    foreach my $column (sort keys %$param) {
88
+        croak qq{"$column" is not safety column name } . _subname
89
+          unless $column =~ /^[$safety\.]+$/;
90
+        my $column_quote = $self->_q($column);
91
+        $column_quote =~ s/\./$self->_q(".")/e;
92
+        push @params, ref $param->{$column} eq 'SCALAR'
93
+          ? "$column_quote = " . ${$param->{$column}}
94
+          : "$column_quote = :$column";
95
+
96
+    }
97
+    my $tag = join(', ', @params);
98
+    
99
+    return $tag;
100
+}
101
+
102
+sub column {
103
+    my $self = shift;
104
+    my $option = pop if ref $_[-1] eq 'HASH';
105
+    my $real_table = shift;
106
+    my $columns = shift;
107
+    my $table = $option->{alias} || $real_table;
108
+    
109
+    # Columns
110
+    unless ($columns) {
111
+        $columns ||= $self->model($real_table)->columns;
112
+    }
113
+    
114
+    # Separator
115
+    my $separator = $self->separator;
116
+    
117
+    # Column clause
118
+    my @column;
119
+    $columns ||= [];
120
+    push @column, $self->_q($table) . "." . $self->_q($_) .
121
+      " as " . $self->_q("${table}${separator}$_")
122
+      for @$columns;
123
+    
124
+    return join (', ', @column);
125
+}
126
+
127
+sub connect {
128
+    my $self = ref $_[0] ? shift : shift->new(@_);;
129
+    
130
+    # Connect
131
+    $self->dbh;
132
+    
133
+    return $self;
134
+}
135
+
136
+sub dbh {
137
+    my $self = shift;
138
+    
139
+    # Set
140
+    if (@_) {
141
+        $self->{dbh} = $_[0];
142
+        
143
+        return $self;
144
+    }
145
+    
146
+    # Get
147
+    else {
148
+        # From Connction manager
149
+        if (my $connector = $self->connector) {
150
+            croak "connector must have dbh() method " . _subname
151
+              unless ref $connector && $connector->can('dbh');
152
+              
153
+            $self->{dbh} = $connector->dbh;
154
+        }
155
+        
156
+        # Connect
157
+        $self->{dbh} ||= $self->_connect;
158
+        
159
+        # Quote
160
+        if (!defined $self->reserved_word_quote && !defined $self->quote) {
161
+            my $driver = $self->{dbh}->{Driver}->{Name};
162
+            my $quote = $driver eq 'mysql' ? '`' : '"';
163
+            $self->quote($quote);
164
+        }
165
+        
166
+        return $self->{dbh};
167
+    }
168
+}
169
+
170
+sub delete {
171
+    my ($self, %args) = @_;
172
+
173
+    # Arguments
174
+    my $table = $args{table} || '';
175
+    croak qq{"table" option must be specified. } . _subname
176
+      unless $table;
177
+    my $where            = delete $args{where} || {};
178
+    my $append           = delete $args{append};
179
+    my $allow_delete_all = delete $args{allow_delete_all};
180
+    my $where_param      = delete $args{where_param} || {};
181
+    my $id = delete $args{id};
182
+    my $primary_key = delete $args{primary_key};
183
+    croak "update method primary_key option " .
184
+          "must be specified when id is specified " . _subname
185
+      if defined $id && !defined $primary_key;
186
+    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
187
+    my $prefix = delete $args{prefix};
188
+    
189
+    # Where
190
+    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
191
+    my $where_clause = '';
192
+    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
193
+        $where_clause = "where " . $where->[0];
194
+        $where_param = $where->[1];
195
+    }
196
+    elsif (ref $where) {
197
+        $where = $self->_where_to_obj($where);
198
+        $where_param = keys %$where_param
199
+                     ? $self->merge_param($where_param, $where->param)
200
+                     : $where->param;
201
+        
202
+        # String where
203
+        $where_clause = $where->to_string;
204
+    }
205
+    elsif ($where) { $where_clause = "where $where" }
206
+    croak qq{"where" must be specified } . _subname
207
+      if $where_clause eq '' && !$allow_delete_all;
208
+
209
+    # Delete statement
210
+    my @sql;
211
+    push @sql, "delete";
212
+    push @sql, $prefix if defined $prefix;
213
+    push @sql, "from " . $self->_q($table) . " $where_clause";
214
+    push @sql, $append if defined $append;
215
+    my $sql = join(' ', @sql);
216
+    
217
+    # Execute query
218
+    return $self->execute($sql, $where_param, table => $table, %args);
219
+}
220
+
221
+sub delete_all { shift->delete(allow_delete_all => 1, @_) }
222
+
223
+sub DESTROY { }
224
+
225
+sub create_model {
226
+    my $self = shift;
227
+    
228
+    # Arguments
229
+    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
230
+    $args->{dbi} = $self;
231
+    my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
232
+    my $model_name  = delete $args->{name};
233
+    my $model_table = delete $args->{table};
234
+    $model_name ||= $model_table;
235
+    
236
+    # Create model
237
+    my $model = $model_class->new($args);
238
+    $model->name($model_name) unless $model->name;
239
+    $model->table($model_table) unless $model->table;
240
+    
241
+    # Apply filter(DEPRECATED logic)
242
+    if ($model->{filter}) {
243
+        my $filter = ref $model->filter eq 'HASH'
244
+                   ? [%{$model->filter}]
245
+                   : $model->filter;
246
+        $filter ||= [];
247
+        warn "DBIx::Custom::Model filter method is DEPRECATED!"
248
+          if @$filter;
249
+        $self->_apply_filter($model->table, @$filter);
250
+    }
251
+    
252
+    # Set model
253
+    $self->model($model->name, $model);
254
+    
255
+    return $self->model($model->name);
256
+}
257
+
258
+sub each_column {
259
+    my ($self, $cb) = @_;
260
+    
261
+    # Iterate all tables
262
+    my $sth_tables = $self->dbh->table_info;
263
+    while (my $table_info = $sth_tables->fetchrow_hashref) {
264
+        
265
+        # Table
266
+        my $table = $table_info->{TABLE_NAME};
267
+        
268
+        # Iterate all columns
269
+        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
270
+        while (my $column_info = $sth_columns->fetchrow_hashref) {
271
+            my $column = $column_info->{COLUMN_NAME};
272
+            $self->$cb($table, $column, $column_info);
273
+        }
274
+    }
275
+}
276
+
277
+sub each_table {
278
+    my ($self, $cb) = @_;
279
+    
280
+    # Iterate all tables
281
+    my $sth_tables = $self->dbh->table_info;
282
+    while (my $table_info = $sth_tables->fetchrow_hashref) {
283
+        
284
+        # Table
285
+        my $table = $table_info->{TABLE_NAME};
286
+        $self->$cb($table, $table_info);
287
+    }
288
+}
289
+
290
+our %VALID_ARGS = map { $_ => 1 } qw/append allow_delete_all
291
+  allow_update_all bind_type column filter id join param prefix primary_key
292
+  query relation table table_alias type type_rule_off type_rule1_off
293
+  type_rule2_off wrap/;
294
+
295
+sub execute {
296
+    my $self = shift;
297
+    my $query = shift;
298
+    my $param;
299
+    $param = shift if @_ % 2;
300
+    my %args = @_;
301
+    
302
+    # Arguments
303
+    my $p = delete $args{param} || {};
304
+    $param ||= $p;
305
+    my $tables = delete $args{table} || [];
306
+    $tables = [$tables] unless ref $tables eq 'ARRAY';
307
+    my $filter = delete $args{filter};
308
+    $filter = _array_to_hash($filter);
309
+    my $bind_type = delete $args{bind_type} || delete $args{type};
310
+    $bind_type = _array_to_hash($bind_type);
311
+    my $type_rule_off = delete $args{type_rule_off};
312
+    my $type_rule_off_parts = {
313
+        1 => delete $args{type_rule1_off},
314
+        2 => delete $args{type_rule2_off}
315
+    };
316
+    my $query_return = delete $args{query};
317
+    my $table_alias = delete $args{table_alias} || {};
318
+    
319
+    # Check argument names
320
+    foreach my $name (keys %args) {
321
+        croak qq{"$name" is wrong option } . _subname
322
+          unless $VALID_ARGS{$name};
323
+    }
324
+    
325
+    # Create query
326
+    $query = $self->_create_query($query) unless ref $query;
327
+    
328
+    # Save query
329
+    $self->last_sql($query->sql);
330
+
331
+    return $query if $query_return;
332
+    
333
+    # DEPRECATED! Merge query filter
334
+    $filter ||= $query->{filter} || {};
335
+    
336
+    # Tables
337
+    unshift @$tables, @{$query->{tables} || []};
338
+    my $main_table = @{$tables}[-1];
339
+    
340
+    # DEPRECATED! Cleanup tables
341
+    $tables = $self->_remove_duplicate_table($tables, $main_table)
342
+      if @$tables > 1;
343
+    
344
+    # Type rule
345
+    my $type_filters = {};
346
+    unless ($type_rule_off) {
347
+        foreach my $i (1, 2) {
348
+            unless ($type_rule_off_parts->{$i}) {
349
+                $type_filters->{$i} = {};
350
+                foreach my $alias (keys %$table_alias) {
351
+                    my $table = $table_alias->{$alias};
352
+                    
353
+                    foreach my $column (keys %{$self->{"_into$i"}{key}{$table} || {}}) {
354
+                        $type_filters->{$i}->{"$alias.$column"} = $self->{"_into$i"}{key}{$table}{$column};
355
+                    }
356
+                }
357
+                $type_filters->{$i} = {%{$type_filters->{$i}}, %{$self->{"_into$i"}{key}{$main_table} || {}}}
358
+                  if $main_table;
359
+            }
360
+        }
361
+    }
362
+    
363
+    # DEPRECATED! Applied filter
364
+    if ($self->{filter}{on}) {
365
+        my $applied_filter = {};
366
+        foreach my $table (@$tables) {
367
+            $applied_filter = {
368
+                %$applied_filter,
369
+                %{$self->{filter}{out}->{$table} || {}}
370
+            }
371
+        }
372
+        $filter = {%$applied_filter, %$filter};
373
+    }
374
+    
375
+    # Replace filter name to code
376
+    foreach my $column (keys %$filter) {
377
+        my $name = $filter->{$column};
378
+        if (!defined $name) {
379
+            $filter->{$column} = undef;
380
+        }
381
+        elsif (ref $name ne 'CODE') {
382
+          croak qq{Filter "$name" is not registered" } . _subname
383
+            unless exists $self->filters->{$name};
384
+          $filter->{$column} = $self->filters->{$name};
385
+        }
386
+    }
387
+    
388
+    # Create bind values
389
+    my $bind = $self->_create_bind_values(
390
+        $param,
391
+        $query->columns,
392
+        $filter,
393
+        $type_filters,
394
+        $bind_type
395
+    );
396
+    
397
+    # Execute
398
+    my $sth = $query->sth;
399
+    my $affected;
400
+    eval {
401
+        for (my $i = 0; $i < @$bind; $i++) {
402
+            my $bind_type = $bind->[$i]->{bind_type};
403
+            $sth->bind_param(
404
+                $i + 1,
405
+                $bind->[$i]->{value},
406
+                $bind_type ? $bind_type : ()
407
+            );
408
+        }
409
+        $affected = $sth->execute;
410
+    };
411
+    
412
+    $self->_croak($@, qq{. Following SQL is executed.\n}
413
+      . qq{$query->{sql}\n} . _subname) if $@;
414
+    
415
+    # DEBUG message
416
+    if (DEBUG) {
417
+        print STDERR "SQL:\n" . $query->sql . "\n";
418
+        my @output;
419
+        foreach my $b (@$bind) {
420
+            my $value = $b->{value};
421
+            $value = 'undef' unless defined $value;
422
+            $value = encode(DEBUG_ENCODING(), $value)
423
+              if utf8::is_utf8($value);
424
+            push @output, $value;
425
+        }
426
+        print STDERR "Bind values: " . join(', ', @output) . "\n\n";
427
+    }
428
+    
429
+    # Select statement
430
+    if ($sth->{NUM_OF_FIELDS}) {
431
+        
432
+        # DEPRECATED! Filter
433
+        my $filter = {};
434
+        if ($self->{filter}{on}) {
435
+            $filter->{in}  = {};
436
+            $filter->{end} = {};
437
+            push @$tables, $main_table if $main_table;
438
+            foreach my $table (@$tables) {
439
+                foreach my $way (qw/in end/) {
440
+                    $filter->{$way} = {
441
+                        %{$filter->{$way}},
442
+                        %{$self->{filter}{$way}{$table} || {}}
443
+                    };
444
+                }
445
+            }
446
+        }
447
+        
448
+        # Result
449
+        my $result = $self->result_class->new(
450
+            sth => $sth,
451
+            dbi => $self,
452
+            default_filter => $self->{default_in_filter},
453
+            filter => $filter->{in} || {},
454
+            end_filter => $filter->{end} || {},
455
+            type_rule => {
456
+                from1 => $self->type_rule->{from1},
457
+                from2 => $self->type_rule->{from2}
458
+            },
459
+        );
460
+
461
+        return $result;
462
+    }
463
+    
464
+    # Not select statement
465
+    else { return $affected }
466
+}
467
+
468
+sub insert {
469
+    my $self = shift;
470
+    
471
+    # Arguments
472
+    my $param;
473
+    $param = shift if @_ % 2;
474
+    my %args = @_;
475
+    my $table  = delete $args{table};
476
+    croak qq{"table" option must be specified } . _subname
477
+      unless defined $table;
478
+    my $p = delete $args{param} || {};
479
+    $param  ||= $p;
480
+    my $append = delete $args{append} || '';
481
+    my $id = delete $args{id};
482
+    my $primary_key = delete $args{primary_key};
483
+    croak "insert method primary_key option " .
484
+          "must be specified when id is specified " . _subname
485
+      if defined $id && !defined $primary_key;
486
+    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
487
+    my $prefix = delete $args{prefix};
488
+
489
+    # Merge parameter
490
+    if (defined $id) {
491
+        my $id_param = $self->_create_param_from_id($id, $primary_key);
492
+        $param = $self->merge_param($id_param, $param);
493
+    }
494
+
495
+    # Insert statement
496
+    my @sql;
497
+    push @sql, "insert";
498
+    push @sql, $prefix if defined $prefix;
499
+    push @sql, "into " . $self->_q($table) . " " . $self->insert_param($param);
500
+    push @sql, $append if defined $append;
501
+    my $sql = join (' ', @sql);
502
+    
503
+    # Execute query
504
+    return $self->execute($sql, $param, table => $table, %args);
505
+}
506
+
507
+sub insert_param {
508
+    my ($self, $param) = @_;
509
+    
510
+    # Create insert parameter tag
511
+    my $safety = $self->safety_character;
512
+    my @columns;
513
+    my @placeholders;
514
+    foreach my $column (sort keys %$param) {
515
+        croak qq{"$column" is not safety column name } . _subname
516
+          unless $column =~ /^[$safety\.]+$/;
517
+        my $column_quote = $self->_q($column);
518
+        $column_quote =~ s/\./$self->_q(".")/e;
519
+        push @columns, $column_quote;
520
+        push @placeholders, ref $param->{$column} eq 'SCALAR'
521
+          ? ${$param->{$column}} : ":$column";
522
+    }
523
+    
524
+    return '(' . join(', ', @columns) . ') ' . 'values ' .
525
+           '(' . join(', ', @placeholders) . ')'
526
+}
527
+
528
+sub include_model {
529
+    my ($self, $name_space, $model_infos) = @_;
530
+    
531
+    # Name space
532
+    $name_space ||= '';
533
+    
534
+    # Get Model infomations
535
+    unless ($model_infos) {
536
+
537
+        # Load name space module
538
+        croak qq{"$name_space" is invalid class name } . _subname
539
+          if $name_space =~ /[^\w:]/;
540
+        eval "use $name_space";
541
+        croak qq{Name space module "$name_space.pm" is needed. $@ }
542
+            . _subname
543
+          if $@;
544
+        
545
+        # Search model modules
546
+        my $path = $INC{"$name_space.pm"};
547
+        $path =~ s/\.pm$//;
548
+        opendir my $dh, $path
549
+          or croak qq{Can't open directory "$path": $! } . _subname
550
+        $model_infos = [];
551
+        while (my $module = readdir $dh) {
552
+            push @$model_infos, $module
553
+              if $module =~ s/\.pm$//;
554
+        }
555
+        close $dh;
556
+    }
557
+    
558
+    # Include models
559
+    foreach my $model_info (@$model_infos) {
560
+        
561
+        # Load model
562
+        my $model_class;
563
+        my $model_name;
564
+        my $model_table;
565
+        if (ref $model_info eq 'HASH') {
566
+            $model_class = $model_info->{class};
567
+            $model_name  = $model_info->{name};
568
+            $model_table = $model_info->{table};
569
+            
570
+            $model_name  ||= $model_class;
571
+            $model_table ||= $model_name;
572
+        }
573
+        else { $model_class = $model_name = $model_table = $model_info }
574
+        my $mclass = "${name_space}::$model_class";
575
+        croak qq{"$mclass" is invalid class name } . _subname
576
+          if $mclass =~ /[^\w:]/;
577
+        unless ($mclass->can('isa')) {
578
+            eval "use $mclass";
579
+            croak "$@ " . _subname if $@;
580
+        }
581
+        
582
+        # Create model
583
+        my $args = {};
584
+        $args->{model_class} = $mclass if $mclass;
585
+        $args->{name}        = $model_name if $model_name;
586
+        $args->{table}       = $model_table if $model_table;
587
+        $self->create_model($args);
588
+    }
589
+    
590
+    return $self;
591
+}
592
+
593
+sub map_param {
594
+    my $self = shift;
595
+    my $param = shift;
596
+    my %map = @_;
597
+    
598
+    # Mapping
599
+    my $map_param = {};
600
+    foreach my $key (keys %map) {
601
+        my $value_cb;
602
+        my $condition;
603
+        my $map_key;
604
+        
605
+        # Get mapping information
606
+        if (ref $map{$key} eq 'ARRAY') {
607
+            foreach my $some (@{$map{$key}}) {
608
+                $map_key = $some unless ref $some;
609
+                $condition = $some->{if} if ref $some eq 'HASH';
610
+                $value_cb = $some if ref $some eq 'CODE';
611
+            }
612
+        }
613
+        else {
614
+            $map_key = $map{$key};
615
+        }
616
+        $value_cb ||= sub { $_[0] };
617
+        $condition ||= sub { defined $_[0] && length $_[0] };
618
+
619
+        # Map parameter
620
+        my $value;
621
+        if (ref $condition eq 'CODE') {
622
+            $map_param->{$map_key} = $value_cb->($param->{$key})
623
+              if $condition->($param->{$key});
624
+        }
625
+        elsif ($condition eq 'exists') {
626
+            $map_param->{$map_key} = $value_cb->($param->{$key})
627
+              if exists $param->{$key};
628
+        }
629
+        else { croak qq/Condition must be code reference or "exists" / . _subname }
630
+    }
631
+    
632
+    return $map_param;
633
+}
634
+
635
+sub merge_param {
636
+    my ($self, @params) = @_;
637
+    
638
+    # Merge parameters
639
+    my $merge = {};
640
+    foreach my $param (@params) {
641
+        foreach my $column (keys %$param) {
642
+            my $param_is_array = ref $param->{$column} eq 'ARRAY' ? 1 : 0;
643
+            
644
+            if (exists $merge->{$column}) {
645
+                $merge->{$column} = [$merge->{$column}]
646
+                  unless ref $merge->{$column} eq 'ARRAY';
647
+                push @{$merge->{$column}},
648
+                  ref $param->{$column} ? @{$param->{$column}} : $param->{$column};
649
+            }
650
+            else {
651
+                $merge->{$column} = $param->{$column};
652
+            }
653
+        }
654
+    }
655
+    
656
+    return $merge;
657
+}
658
+
659
+sub method {
660
+    my $self = shift;
661
+    
662
+    # Register method
663
+    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
664
+    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
665
+    
666
+    return $self;
667
+}
668
+
669
+sub model {
670
+    my ($self, $name, $model) = @_;
671
+    
672
+    # Set model
673
+    if ($model) {
674
+        $self->models->{$name} = $model;
675
+        return $self;
676
+    }
677
+    
678
+    # Check model existance
679
+    croak qq{Model "$name" is not included } . _subname
680
+      unless $self->models->{$name};
681
+    
682
+    # Get model
683
+    return $self->models->{$name};
684
+}
685
+
686
+sub mycolumn {
687
+    my ($self, $table, $columns) = @_;
688
+    
689
+    # Create column clause
690
+    my @column;
691
+    $columns ||= [];
692
+    push @column, $self->_q($table) . "." . $self->_q($_) .
693
+      " as " . $self->_q($_)
694
+      for @$columns;
695
+    
696
+    return join (', ', @column);
697
+}
698
+
699
+sub new {
700
+    my $self = shift->SUPER::new(@_);
701
+    
702
+    # Check attributes
703
+    my @attrs = keys %$self;
704
+    foreach my $attr (@attrs) {
705
+        croak qq{"$attr" is wrong name } . _subname
706
+          unless $self->can($attr);
707
+    }
708
+    
709
+    # DEPRECATED!
710
+    $self->query_builder->{tags} = {
711
+        '?'     => \&DBIx::Custom::Tag::placeholder,
712
+        '='     => \&DBIx::Custom::Tag::equal,
713
+        '<>'    => \&DBIx::Custom::Tag::not_equal,
714
+        '>'     => \&DBIx::Custom::Tag::greater_than,
715
+        '<'     => \&DBIx::Custom::Tag::lower_than,
716
+        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
717
+        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
718
+        'like'  => \&DBIx::Custom::Tag::like,
719
+        'in'    => \&DBIx::Custom::Tag::in,
720
+        'insert_param' => \&DBIx::Custom::Tag::insert_param,
721
+        'update_param' => \&DBIx::Custom::Tag::update_param
722
+    };
723
+    
724
+    return $self;
725
+}
726
+
727
+sub not_exists { bless {}, 'DBIx::Custom::NotExists' }
728
+
729
+sub order {
730
+    my $self = shift;
731
+    return DBIx::Custom::Order->new(dbi => $self, @_);
732
+}
733
+
734
+sub register_filter {
735
+    my $self = shift;
736
+    
737
+    # Register filter
738
+    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
739
+    $self->filters({%{$self->filters}, %$filters});
740
+    
741
+    return $self;
742
+}
743
+
744
+sub select {
745
+    my ($self, %args) = @_;
746
+
747
+    # Arguments
748
+    my $table = delete $args{table};
749
+    my $tables = ref $table eq 'ARRAY' ? $table
750
+               : defined $table ? [$table]
751
+               : [];
752
+    my $columns   = delete $args{column};
753
+    my $where     = delete $args{where} || {};
754
+    my $append    = delete $args{append};
755
+    my $join      = delete $args{join} || [];
756
+    croak qq{"join" must be array reference } . _subname
757
+      unless ref $join eq 'ARRAY';
758
+    my $relation = delete $args{relation};
759
+    warn "select() relation option is DEPRECATED!"
760
+      if $relation;
761
+    my $param = delete $args{param} || {}; # DEPRECATED!
762
+    warn "select() param option is DEPRECATED!"
763
+      if keys %$param;
764
+    my $where_param = delete $args{where_param} || $param || {};
765
+    my $wrap = delete $args{wrap};
766
+    my $id = delete $args{id};
767
+    my $primary_key = delete $args{primary_key};
768
+    croak "update method primary_key option " .
769
+          "must be specified when id is specified " . _subname
770
+      if defined $id && !defined $primary_key;
771
+    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
772
+    my $prefix = delete $args{prefix};
773
+    
774
+    # Add relation tables(DEPRECATED!);
775
+    $self->_add_relation_table($tables, $relation);
776
+    
777
+    # Select statement
778
+    my @sql;
779
+    push @sql, 'select';
780
+    
781
+    # Prefix
782
+    push @sql, $prefix if defined $prefix;
783
+    
784
+    # Column clause
785
+    if ($columns) {
786
+        $columns = [$columns] unless ref $columns eq 'ARRAY';
787
+        foreach my $column (@$columns) {
788
+            if (ref $column eq 'HASH') {
789
+                $column = $self->column(%$column) if ref $column eq 'HASH';
790
+            }
791
+            elsif (ref $column eq 'ARRAY') {
792
+                if (@$column == 3 && $column->[1] eq 'as') {
793
+                    warn "[COLUMN, as => ALIAS] is DEPRECATED! use [COLUMN => ALIAS]";
794
+                    splice @$column, 1, 1;
795
+                }
796
+                
797
+                $column = join(' ', $column->[0], 'as', $self->_q($column->[1]));
798
+            }
799
+            unshift @$tables, @{$self->_search_tables($column)};
800
+            push @sql, ($column, ',');
801
+        }
802
+        pop @sql if $sql[-1] eq ',';
803
+    }
804
+    else { push @sql, '*' }
805
+    
806
+    # Table
807
+    push @sql, 'from';
808
+    if ($relation) {
809
+        my $found = {};
810
+        foreach my $table (@$tables) {
811
+            push @sql, ($self->_q($table), ',') unless $found->{$table};
812
+            $found->{$table} = 1;
813
+        }
814
+    }
815
+    else {
816
+        my $main_table = $tables->[-1] || '';
817
+        push @sql, $self->_q($main_table);
818
+    }
819
+    pop @sql if ($sql[-1] || '') eq ',';
820
+    croak "Not found table name " . _subname
821
+      unless $tables->[-1];
822
+
823
+    # Add tables in parameter
824
+    unshift @$tables,
825
+            @{$self->_search_tables(join(' ', keys %$where_param) || '')};
826
+    
827
+    # Where
828
+    my $where_clause = '';
829
+    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
830
+    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
831
+        $where_clause = "where " . $where->[0];
832
+        $where_param = $where->[1];
833
+    }
834
+    elsif (ref $where) {
835
+        $where = $self->_where_to_obj($where);
836
+        $where_param = keys %$where_param
837
+                     ? $self->merge_param($where_param, $where->param)
838
+                     : $where->param;
839
+        
840
+        # String where
841
+        $where_clause = $where->to_string;
842
+    }
843
+    elsif ($where) { $where_clause = "where $where" }
844
+    
845
+    # Add table names in where clause
846
+    unshift @$tables, @{$self->_search_tables($where_clause)};
847
+    
848
+    # Push join
849
+    $self->_push_join(\@sql, $join, $tables);
850
+    
851
+    # Add where clause
852
+    push @sql, $where_clause;
853
+    
854
+    # Relation(DEPRECATED!);
855
+    $self->_push_relation(\@sql, $tables, $relation, $where_clause eq '' ? 1 : 0);
856
+    
857
+    # Append
858
+    push @sql, $append if defined $append;
859
+    
860
+    # Wrap
861
+    if ($wrap) {
862
+        croak "wrap option must be array refrence " . _subname
863
+          unless ref $wrap eq 'ARRAY';
864
+        unshift @sql, $wrap->[0];
865
+        push @sql, $wrap->[1];
866
+    }
867
+    
868
+    # SQL
869
+    my $sql = join (' ', @sql);
870
+    
871
+    # Execute query
872
+    my $result = $self->execute($sql, $where_param, table => $tables, %args);
873
+    
874
+    return $result;
875
+}
876
+
877
+sub separator {
878
+    my $self = shift;
879
+    
880
+    if (@_) {
881
+        my $separator = $_[0] || '';
882
+        croak qq{Separator must be "." or "__" or "-" } . _subname
883
+          unless $separator eq '.' || $separator eq '__'
884
+              || $separator eq '-';
885
+        
886
+        $self->{separator} = $separator;
887
+    
888
+        return $self;
889
+    }
890
+    return $self->{separator} ||= '.';
891
+}
892
+
893
+sub setup_model {
894
+    my $self = shift;
895
+    
896
+    # Setup model
897
+    $self->each_column(
898
+        sub {
899
+            my ($self, $table, $column, $column_info) = @_;
900
+            if (my $model = $self->models->{$table}) {
901
+                push @{$model->columns}, $column;
902
+            }
903
+        }
904
+    );
905
+    return $self;
906
+}
907
+
908
+sub available_data_type {
909
+    my $self = shift;
910
+    
911
+    my $data_types = '';
912
+    foreach my $i (-1000 .. 1000) {
913
+         my $type_info = $self->dbh->type_info($i);
914
+         my $data_type = $type_info->{DATA_TYPE};
915
+         my $type_name = $type_info->{TYPE_NAME};
916
+         $data_types .= "$data_type ($type_name)\n"
917
+           if defined $data_type;
918
+    }
919
+    return "Data Type maybe equal to Type Name" unless $data_types;
920
+    $data_types = "Data Type (Type name)\n" . $data_types;
921
+    return $data_types;
922
+}
923
+
924
+sub available_type_name {
925
+    my $self = shift;
926
+    
927
+    # Type Names
928
+    my $type_names = {};
929
+    $self->each_column(sub {
930
+        my ($self, $table, $column, $column_info) = @_;
931
+        $type_names->{$column_info->{TYPE_NAME}} = 1
932
+          if $column_info->{TYPE_NAME};
933
+    });
934
+    my @output = sort keys %$type_names;
935
+    unshift @output, "Type Name";
936
+    return join "\n", @output;
937
+}
938
+
939
+sub type_rule {
940
+    my $self = shift;
941
+    
942
+    if (@_) {
943
+        my $type_rule = ref $_[0] eq 'HASH' ? $_[0] : {@_};
944
+        
945
+        # Into
946
+        foreach my $i (1 .. 2) {
947
+            my $into = "into$i";
948
+            $type_rule->{$into} = _array_to_hash($type_rule->{$into});
949
+            $self->{type_rule} = $type_rule;
950
+            $self->{"_$into"} = {};
951
+            foreach my $type_name (keys %{$type_rule->{$into} || {}}) {
952
+                croak qq{type name of $into section must be lower case}
953
+                  if $type_name =~ /[A-Z]/;
954
+            }
955
+            $self->each_column(sub {
956
+                my ($dbi, $table, $column, $column_info) = @_;
957
+                
958
+                my $type_name = lc $column_info->{TYPE_NAME};
959
+                if ($type_rule->{$into} &&
960
+                    (my $filter = $type_rule->{$into}->{$type_name}))
961
+                {
962
+                    return unless exists $type_rule->{$into}->{$type_name};
963
+                    if  (defined $filter && ref $filter ne 'CODE') 
964
+                    {
965
+                        my $fname = $filter;
966
+                        croak qq{Filter "$fname" is not registered" } . _subname
967
+                          unless exists $self->filters->{$fname};
968
+                        
969
+                        $filter = $self->filters->{$fname};
970
+                    }
971
+
972
+                    $self->{"_$into"}{key}{$table}{$column} = $filter;
973
+                    $self->{"_$into"}{dot}{"$table.$column"} = $filter;
974
+                }
975
+            });
976
+        }
977
+
978
+        # From
979
+        foreach my $i (1 .. 2) {
980
+            $type_rule->{"from$i"} = _array_to_hash($type_rule->{"from$i"});
981
+            foreach my $data_type (keys %{$type_rule->{"from$i"} || {}}) {
982
+                croak qq{data type of from$i section must be lower case or number}
983
+                  if $data_type =~ /[A-Z]/;
984
+                my $fname = $type_rule->{"from$i"}{$data_type};
985
+                if (defined $fname && ref $fname ne 'CODE') {
986
+                    croak qq{Filter "$fname" is not registered" } . _subname
987
+                      unless exists $self->filters->{$fname};
988
+                    
989
+                    $type_rule->{"from$i"}{$data_type} = $self->filters->{$fname};
990
+                }
991
+            }
992
+        }
993
+        
994
+        return $self;
995
+    }
996
+    
997
+    return $self->{type_rule} || {};
998
+}
999
+
1000
+sub update {
1001
+    my $self = shift;
1002
+
1003
+    # Arguments
1004
+    my $param;
1005
+    $param = shift if @_ % 2;
1006
+    my %args = @_;
1007
+    my $table = delete $args{table} || '';
1008
+    croak qq{"table" option must be specified } . _subname
1009
+      unless $table;
1010
+    my $p = delete $args{param} || {};
1011
+    $param  ||= $p;
1012
+    my $where = delete $args{where} || {};
1013
+    my $where_param = delete $args{where_param} || {};
1014
+    my $append = delete $args{append} || '';
1015
+    my $allow_update_all = delete $args{allow_update_all};
1016
+    my $id = delete $args{id};
1017
+    my $primary_key = delete $args{primary_key};
1018
+    croak "update method primary_key option " .
1019
+          "must be specified when id is specified " . _subname
1020
+      if defined $id && !defined $primary_key;
1021
+    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
1022
+    my $prefix = delete $args{prefix};
1023
+
1024
+    # Update clause
1025
+    my $update_clause = $self->update_param($param);
1026
+
1027
+    # Where
1028
+    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
1029
+    my $where_clause = '';
1030
+    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
1031
+        $where_clause = "where " . $where->[0];
1032
+        $where_param = $where->[1];
1033
+    }
1034
+    elsif (ref $where) {
1035
+        $where = $self->_where_to_obj($where);
1036
+        $where_param = keys %$where_param
1037
+                     ? $self->merge_param($where_param, $where->param)
1038
+                     : $where->param;
1039
+        
1040
+        # String where
1041
+        $where_clause = $where->to_string;
1042
+    }
1043
+    elsif ($where) { $where_clause = "where $where" }
1044
+    croak qq{"where" must be specified } . _subname
1045
+      if "$where_clause" eq '' && !$allow_update_all;
1046
+    
1047
+    # Merge param
1048
+    $param = $self->merge_param($param, $where_param) if keys %$where_param;
1049
+    
1050
+    # Update statement
1051
+    my @sql;
1052
+    push @sql, "update";
1053
+    push @sql, $prefix if defined $prefix;
1054
+    push @sql, $self->_q($table) . " $update_clause $where_clause";
1055
+    push @sql, $append if defined $append;
1056
+    
1057
+    # SQL
1058
+    my $sql = join(' ', @sql);
1059
+    
1060
+    # Execute query
1061
+    return $self->execute($sql, $param, table => $table, %args);
1062
+}
1063
+
1064
+sub update_all { shift->update(allow_update_all => 1, @_) };
1065
+
1066
+sub update_param {
1067
+    my ($self, $param, $opt) = @_;
1068
+    
1069
+    # Create update parameter tag
1070
+    my $tag = $self->assign_param($param);
1071
+    $tag = "set $tag" unless $opt->{no_set};
1072
+
1073
+    return $tag;
1074
+}
1075
+
1076
+sub where { DBIx::Custom::Where->new(dbi => shift, @_) }
1077
+
1078
+sub _create_query {
1079
+    
1080
+    my ($self, $source) = @_;
1081
+    
1082
+    # Cache
1083
+    my $cache = $self->cache;
1084
+    
1085
+    # Query
1086
+    my $query;
1087
+    
1088
+    # Get cached query
1089
+    if ($cache) {
1090
+        
1091
+        # Get query
1092
+        my $q = $self->cache_method->($self, $source);
1093
+        
1094
+        # Create query
1095
+        if ($q) {
1096
+            $query = DBIx::Custom::Query->new($q);
1097
+            $query->{filters} = $self->filters;
1098
+        }
1099
+    }
1100
+    
1101
+    # Create query
1102
+    unless ($query) {
1103
+
1104
+        # Create query
1105
+        my $builder = $self->query_builder;
1106
+        $query = $builder->build_query($source);
1107
+
1108
+        # Remove reserved word quote
1109
+        if (my $q = $self->_quote) {
1110
+            $q = quotemeta($q);
1111
+            $_ =~ s/[$q]//g for @{$query->columns}
1112
+        }
1113
+
1114
+        # Save query to cache
1115
+        $self->cache_method->(
1116
+            $self, $source,
1117
+            {
1118
+                sql     => $query->sql, 
1119
+                columns => $query->columns,
1120
+                tables  => $query->{tables} || []
1121
+            }
1122
+        ) if $cache;
1123
+    }
1124
+    
1125
+    # Save sql
1126
+    $self->last_sql($query->sql);
1127
+    
1128
+    # Prepare statement handle
1129
+    my $sth;
1130
+    eval { $sth = $self->dbh->prepare($query->{sql})};
1131
+    
1132
+    if ($@) {
1133
+        $self->_croak($@, qq{. Following SQL is executed.\n}
1134
+                        . qq{$query->{sql}\n} . _subname);
1135
+    }
1136
+    
1137
+    # Set statement handle
1138
+    $query->sth($sth);
1139
+    
1140
+    # Set filters
1141
+    $query->{filters} = $self->filters;
1142
+    
1143
+    return $query;
1144
+}
1145
+
1146
+sub _create_bind_values {
1147
+    my ($self, $params, $columns, $filter, $type_filters, $bind_type) = @_;
1148
+    
1149
+    # Create bind values
1150
+    my $bind = [];
1151
+    my $count = {};
1152
+    my $not_exists = {};
1153
+    foreach my $column (@$columns) {
1154
+        
1155
+        # Value
1156
+        my $value;
1157
+        if(ref $params->{$column} eq 'ARRAY') {
1158
+            my $i = $count->{$column} || 0;
1159
+            $i += $not_exists->{$column} || 0;
1160
+            my $found;
1161
+            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1162
+                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1163
+                    $not_exists->{$column}++;
1164
+                }
1165
+                else  {
1166
+                    $value = $params->{$column}->[$k];
1167
+                    $found = 1;
1168
+                    last
1169
+                }
1170
+            }
1171
+            next unless $found;
1172
+        }
1173
+        else { $value = $params->{$column} }
1174
+        
1175
+        # Filter
1176
+        my $f = $filter->{$column} || $self->{default_out_filter} || '';
1177
+        $value = $f->($value) if $f;
1178
+        
1179
+        # Type rule
1180
+        foreach my $i (1 .. 2) {
1181
+            my $type_filter = $type_filters->{$i};
1182
+            my $tf = $self->{"_into$i"}->{dot}->{$column} || $type_filter->{$column};
1183
+            $value = $tf->($value) if $tf;
1184
+        }
1185
+        
1186
+        # Bind values
1187
+        push @$bind, {value => $value, bind_type => $bind_type->{$column}};
1188
+        
1189
+        # Count up 
1190
+        $count->{$column}++;
1191
+    }
1192
+    
1193
+    return $bind;
1194
+}
1195
+
1196
+sub _create_param_from_id {
1197
+    my ($self, $id, $primary_keys) = @_;
1198
+    
1199
+    # Create parameter
1200
+    my $param = {};
1201
+    if (defined $id) {
1202
+        $id = [$id] unless ref $id;
1203
+        croak qq{"id" must be constant value or array reference}
1204
+            . " (" . (caller 1)[3] . ")"
1205
+          unless !ref $id || ref $id eq 'ARRAY';
1206
+        croak qq{"id" must contain values same count as primary key}
1207
+            . " (" . (caller 1)[3] . ")"
1208
+          unless @$primary_keys eq @$id;
1209
+        for(my $i = 0; $i < @$primary_keys; $i ++) {
1210
+           $param->{$primary_keys->[$i]} = $id->[$i];
1211
+        }
1212
+    }
1213
+    
1214
+    return $param;
1215
+}
1216
+
1217
+sub _connect {
1218
+    my $self = shift;
1219
+    
1220
+    # Attributes
1221
+    my $dsn = $self->data_source;
1222
+    warn "data_source is DEPRECATED!\n"
1223
+      if $dsn;
1224
+    $dsn ||= $self->dsn;
1225
+    croak qq{"dsn" must be specified } . _subname
1226
+      unless $dsn;
1227
+    my $user        = $self->user;
1228
+    my $password    = $self->password;
1229
+    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1230
+    warn "dbi_options is DEPRECATED! use dbi_option instead\n"
1231
+      if keys %{$self->dbi_options};
1232
+    
1233
+    # Connect
1234
+    my $dbh = eval {DBI->connect(
1235
+        $dsn,
1236
+        $user,
1237
+        $password,
1238
+        {
1239
+            %{$self->default_dbi_option},
1240
+            %$dbi_option
1241
+        }
1242
+    )};
1243
+    
1244
+    # Connect error
1245
+    croak "$@ " . _subname if $@;
1246
+    
1247
+    return $dbh;
1248
+}
1249
+
1250
+sub _croak {
1251
+    my ($self, $error, $append) = @_;
1252
+    
1253
+    # Append
1254
+    $append ||= "";
1255
+    
1256
+    # Verbose
1257
+    if ($Carp::Verbose) { croak $error }
1258
+    
1259
+    # Not verbose
1260
+    else {
1261
+        
1262
+        # Remove line and module infromation
1263
+        my $at_pos = rindex($error, ' at ');
1264
+        $error = substr($error, 0, $at_pos);
1265
+        $error =~ s/\s+$//;
1266
+        croak "$error$append";
1267
+    }
1268
+}
1269
+
1270
+sub _need_tables {
1271
+    my ($self, $tree, $need_tables, $tables) = @_;
1272
+    
1273
+    # Get needed tables
1274
+    foreach my $table (@$tables) {
1275
+        if ($tree->{$table}) {
1276
+            $need_tables->{$table} = 1;
1277
+            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1278
+        }
1279
+    }
1280
+}
1281
+
1282
+sub _push_join {
1283
+    my ($self, $sql, $join, $join_tables) = @_;
1284
+    
1285
+    # No join
1286
+    return unless @$join;
1287
+    
1288
+    # Push join clause
1289
+    my $tree = {};
1290
+    for (my $i = 0; $i < @$join; $i++) {
1291
+        
1292
+        # Arrange
1293
+        my $join_clause;;
1294
+        my $option;
1295
+        if (ref $join->[$i] eq 'HASH') {
1296
+            $join_clause = $join->[$i]->{clause};
1297
+            $option = {table => $join->[$i]->{table}};
1298
+        }
1299
+        else {
1300
+            $join_clause = $join->[$i];
1301
+            $option = {};
1302
+        };
1303
+
1304
+        # Find tables in join clause
1305
+        my $table1;
1306
+        my $table2;
1307
+        if (my $table = $option->{table}) {
1308
+            $table1 = $table->[0];
1309
+            $table2 = $table->[1];
1310
+        }
1311
+        else {
1312
+            my $q = $self->_quote;
1313
+            my $j_clause = (split /\s+on\s+/, $join_clause)[-1];
1314
+            $j_clause =~ s/'.+?'//g;
1315
+            my $q_re = quotemeta($q);
1316
+            $j_clause =~ s/[$q_re]//g;
1317
+            my $c = $self->safety_character;
1318
+            my $join_re = qr/(?:^|\s)($c+)\.$c+\s+=\s+($c+)\.$c+/;
1319
+            if ($j_clause =~ $join_re) {
1320
+                $table1 = $1;
1321
+                $table2 = $2;
1322
+            }
1323
+        }
1324
+        croak qq{join clause must have two table name after "on" keyword. } .
1325
+              qq{"$join_clause" is passed }  . _subname
1326
+          unless defined $table1 && defined $table2;
1327
+        croak qq{right side table of "$join_clause" must be unique }
1328
+            . _subname
1329
+          if exists $tree->{$table2};
1330
+        croak qq{Same table "$table1" is specified} . _subname
1331
+          if $table1 eq $table2;
1332
+        $tree->{$table2}
1333
+          = {position => $i, parent => $table1, join => $join_clause};
1334
+    }
1335
+    
1336
+    # Search need tables
1337
+    my $need_tables = {};
1338
+    $self->_need_tables($tree, $need_tables, $join_tables);
1339
+    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
1340
+    
1341
+    # Add join clause
1342
+    foreach my $need_table (@need_tables) {
1343
+        push @$sql, $tree->{$need_table}{join};
1344
+    }
1345
+}
1346
+
1347
+sub _quote {
1348
+    my $self = shift;
1349
+    
1350
+    return defined $self->reserved_word_quote ? $self->reserved_word_quote
1351
+         : defined $self->quote ? $self->quote
1352
+         : '';
1353
+}
1354
+
1355
+sub _q {
1356
+    my ($self, $value) = @_;
1357
+    
1358
+    my $quote = $self->_quote;
1359
+    my $q = substr($quote, 0, 1) || '';
1360
+    my $p;
1361
+    if (defined $quote && length $quote > 1) {
1362
+        $p = substr($quote, 1, 1);
1363
+    }
1364
+    else { $p = $q }
1365
+    
1366
+    return "$q$value$p";
1367
+}
1368
+
1369
+sub _remove_duplicate_table {
1370
+    my ($self, $tables, $main_table) = @_;
1371
+    
1372
+    # Remove duplicate table
1373
+    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1374
+    delete $tables{$main_table} if $main_table;
1375
+    
1376
+    my $new_tables = [keys %tables, $main_table ? $main_table : ()];
1377
+    if (my $q = $self->_quote) {
1378
+        $q = quotemeta($q);
1379
+        $_ =~ s/[$q]//g for @$new_tables;
1380
+    }
1381
+
1382
+    return $new_tables;
1383
+}
1384
+
1385
+sub _search_tables {
1386
+    my ($self, $source) = @_;
1387
+    
1388
+    # Search tables
1389
+    my $tables = [];
1390
+    my $safety_character = $self->safety_character;
1391
+    my $q = $self->_quote;
1392
+    my $q_re = quotemeta($q);
1393
+    my $quoted_safety_character_re = $self->_q("?([$safety_character]+)");
1394
+    my $table_re = $q ? qr/(?:^|[^$safety_character])$quoted_safety_character_re?\./
1395
+                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
1396
+    while ($source =~ /$table_re/g) {
1397
+        push @$tables, $1;
1398
+    }
1399
+    
1400
+    return $tables;
1401
+}
1402
+
1403
+sub _where_to_obj {
1404
+    my ($self, $where) = @_;
1405
+    
1406
+    my $obj;
1407
+    
1408
+    # Hash
1409
+    if (ref $where eq 'HASH') {
1410
+        my $clause = ['and'];
1411
+        my $q = $self->_quote;
1412
+        foreach my $column (keys %$where) {
1413
+            my $column_quote = $self->_q($column);
1414
+            $column_quote =~ s/\./$self->_q(".")/e;
1415
+            push @$clause, "$column_quote = :$column" for keys %$where;
1416
+        }
1417
+        $obj = $self->where(clause => $clause, param => $where);
1418
+    }
1419
+    
1420
+    # DBIx::Custom::Where object
1421
+    elsif (ref $where eq 'DBIx::Custom::Where') {
1422
+        $obj = $where;
1423
+    }
1424
+    
1425
+    # Array
1426
+    elsif (ref $where eq 'ARRAY') {
1427
+        $obj = $self->where(
1428
+            clause => $where->[0],
1429
+            param  => $where->[1]
1430
+        );
1431
+    }
1432
+    
1433
+    # Check where argument
1434
+    croak qq{"where" must be hash reference or DBIx::Custom::Where object}
1435
+        . qq{or array reference, which contains where clause and parameter}
1436
+        . _subname
1437
+      unless ref $obj eq 'DBIx::Custom::Where';
1438
+    
1439
+    return $obj;
1440
+}
1441
+
1442
+sub _apply_filter {
1443
+    my ($self, $table, @cinfos) = @_;
1444
+
1445
+    # Initialize filters
1446
+    $self->{filter} ||= {};
1447
+    $self->{filter}{on} = 1;
1448
+    $self->{filter}{out} ||= {};
1449
+    $self->{filter}{in} ||= {};
1450
+    $self->{filter}{end} ||= {};
1451
+    
1452
+    # Usage
1453
+    my $usage = "Usage: \$dbi->apply_filter(" .
1454
+                "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1, end => ENDFILTER1}, " .
1455
+                "COLUMN2, {in => INFILTER2, out => OUTFILTER2, end => ENDFILTER2}, ...)";
1456
+    
1457
+    # Apply filter
1458
+    for (my $i = 0; $i < @cinfos; $i += 2) {
1459
+        
1460
+        # Column
1461
+        my $column = $cinfos[$i];
1462
+        if (ref $column eq 'ARRAY') {
1463
+            foreach my $c (@$column) {
1464
+                push @cinfos, $c, $cinfos[$i + 1];
1465
+            }
1466
+            next;
1467
+        }
1468
+        
1469
+        # Filter infomation
1470
+        my $finfo = $cinfos[$i + 1] || {};
1471
+        croak "$usage (table: $table) " . _subname
1472
+          unless  ref $finfo eq 'HASH';
1473
+        foreach my $ftype (keys %$finfo) {
1474
+            croak "$usage (table: $table) " . _subname
1475
+              unless $ftype eq 'in' || $ftype eq 'out' || $ftype eq 'end'; 
1476
+        }
1477
+        
1478
+        # Set filters
1479
+        foreach my $way (qw/in out end/) {
1480
+        
1481
+            # Filter
1482
+            my $filter = $finfo->{$way};
1483
+            
1484
+            # Filter state
1485
+            my $state = !exists $finfo->{$way} ? 'not_exists'
1486
+                      : !defined $filter        ? 'not_defined'
1487
+                      : ref $filter eq 'CODE'   ? 'code'
1488
+                      : 'name';
1489
+            
1490
+            # Filter is not exists
1491
+            next if $state eq 'not_exists';
1492
+            
1493
+            # Check filter name
1494
+            croak qq{Filter "$filter" is not registered } . _subname
1495
+              if  $state eq 'name'
1496
+               && ! exists $self->filters->{$filter};
1497
+            
1498
+            # Set filter
1499
+            my $f = $state eq 'not_defined' ? undef
1500
+                  : $state eq 'code'        ? $filter
1501
+                  : $self->filters->{$filter};
1502
+            $self->{filter}{$way}{$table}{$column} = $f;
1503
+            $self->{filter}{$way}{$table}{"$table.$column"} = $f;
1504
+            $self->{filter}{$way}{$table}{"${table}__$column"} = $f;
1505
+            $self->{filter}{$way}{$table}{"${table}-$column"} = $f;
1506
+        }
1507
+    }
1508
+    
1509
+    return $self;
1510
+}
1511
+
1512
+# DEPRECATED!
1513
+sub create_query {
1514
+    warn "create_query is DEPRECATED! use query option of each method";
1515
+    shift->_create_query(@_);
1516
+}
1517
+
1518
+# DEPRECATED!
1519
+sub apply_filter {
1520
+    my $self = shift;
1521
+    
1522
+    warn "apply_filter is DEPRECATED!";
1523
+    return $self->_apply_filter(@_);
1524
+}
1525
+
1526
+# DEPRECATED!
1527
+our %SELECT_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1528
+sub select_at {
1529
+    my ($self, %args) = @_;
1530
+
1531
+    warn "select_at is DEPRECATED! use update and id option instead";
1532
+
1533
+    # Arguments
1534
+    my $primary_keys = delete $args{primary_key};
1535
+    $primary_keys = [$primary_keys] unless ref $primary_keys;
1536
+    my $where = delete $args{where};
1537
+    my $param = delete $args{param};
1538
+    
1539
+    # Check arguments
1540
+    foreach my $name (keys %args) {
1541
+        croak qq{"$name" is wrong option } . _subname
1542
+          unless $SELECT_AT_ARGS{$name};
1543
+    }
1544
+    
1545
+    # Table
1546
+    croak qq{"table" option must be specified } . _subname
1547
+      unless $args{table};
1548
+    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
1549
+    
1550
+    # Create where parameter
1551
+    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1552
+    
1553
+    return $self->select(where => $where_param, %args);
1554
+}
1555
+
1556
+# DEPRECATED!
1557
+our %DELETE_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1558
+sub delete_at {
1559
+    my ($self, %args) = @_;
1560
+
1561
+    warn "delete_at is DEPRECATED! use update and id option instead";
1562
+    
1563
+    # Arguments
1564
+    my $primary_keys = delete $args{primary_key};
1565
+    $primary_keys = [$primary_keys] unless ref $primary_keys;
1566
+    my $where = delete $args{where};
1567
+    
1568
+    # Check arguments
1569
+    foreach my $name (keys %args) {
1570
+        croak qq{"$name" is wrong option } . _subname
1571
+          unless $DELETE_AT_ARGS{$name};
1572
+    }
1573
+    
1574
+    # Create where parameter
1575
+    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1576
+    
1577
+    return $self->delete(where => $where_param, %args);
1578
+}
1579
+
1580
+# DEPRECATED!
1581
+our %UPDATE_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1582
+sub update_at {
1583
+    my $self = shift;
1584
+
1585
+    warn "update_at is DEPRECATED! use update and id option instead";
1586
+    
1587
+    # Arguments
1588
+    my $param;
1589
+    $param = shift if @_ % 2;
1590
+    my %args = @_;
1591
+    my $primary_keys = delete $args{primary_key};
1592
+    $primary_keys = [$primary_keys] unless ref $primary_keys;
1593
+    my $where = delete $args{where};
1594
+    my $p = delete $args{param} || {};
1595
+    $param  ||= $p;
1596
+    
1597
+    # Check arguments
1598
+    foreach my $name (keys %args) {
1599
+        croak qq{"$name" is wrong option } . _subname
1600
+          unless $UPDATE_AT_ARGS{$name};
1601
+    }
1602
+    
1603
+    # Create where parameter
1604
+    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1605
+    
1606
+    return $self->update(where => $where_param, param => $param, %args);
1607
+}
1608
+
1609
+# DEPRECATED!
1610
+our %INSERT_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1611
+sub insert_at {
1612
+    my $self = shift;
1613
+    
1614
+    warn "insert_at is DEPRECATED! use insert and id option instead";
1615
+    
1616
+    # Arguments
1617
+    my $param;
1618
+    $param = shift if @_ % 2;
1619
+    my %args = @_;
1620
+    my $primary_key = delete $args{primary_key};
1621
+    $primary_key = [$primary_key] unless ref $primary_key;
1622
+    my $where = delete $args{where};
1623
+    my $p = delete $args{param} || {};
1624
+    $param  ||= $p;
1625
+    
1626
+    # Check arguments
1627
+    foreach my $name (keys %args) {
1628
+        croak qq{"$name" is wrong option } . _subname
1629
+          unless $INSERT_AT_ARGS{$name};
1630
+    }
1631
+    
1632
+    # Create where parameter
1633
+    my $where_param = $self->_create_param_from_id($where, $primary_key);
1634
+    $param = $self->merge_param($where_param, $param);
1635
+    
1636
+    return $self->insert(param => $param, %args);
1637
+}
1638
+
1639
+# DEPRECATED!
1640
+sub register_tag {
1641
+    warn "register_tag is DEPRECATED!";
1642
+    shift->query_builder->register_tag(@_)
1643
+}
1644
+
1645
+# DEPRECATED!
1646
+has 'data_source';
1647
+has dbi_options => sub { {} };
1648
+has filter_check  => 1;
1649
+has 'reserved_word_quote';
1650
+
1651
+# DEPRECATED!
1652
+sub default_bind_filter {
1653
+    my $self = shift;
1654
+    
1655
+    warn "default_bind_filter is DEPRECATED!";
1656
+    
1657
+    if (@_) {
1658
+        my $fname = $_[0];
1659
+        
1660
+        if (@_ && !$fname) {
1661
+            $self->{default_out_filter} = undef;
1662
+        }
1663
+        else {
1664
+            croak qq{Filter "$fname" is not registered}
1665
+              unless exists $self->filters->{$fname};
1666
+        
1667
+            $self->{default_out_filter} = $self->filters->{$fname};
1668
+        }
1669
+        return $self;
1670
+    }
1671
+    
1672
+    return $self->{default_out_filter};
1673
+}
1674
+
1675
+# DEPRECATED!
1676
+sub default_fetch_filter {
1677
+    my $self = shift;
1678
+
1679
+    warn "default_fetch_filter is DEPRECATED!";
1680
+    
1681
+    if (@_) {
1682
+        my $fname = $_[0];
1683
+
1684
+        if (@_ && !$fname) {
1685
+            $self->{default_in_filter} = undef;
1686
+        }
1687
+        else {
1688
+            croak qq{Filter "$fname" is not registered}
1689
+              unless exists $self->filters->{$fname};
1690
+        
1691
+            $self->{default_in_filter} = $self->filters->{$fname};
1692
+        }
1693
+        
1694
+        return $self;
1695
+    }
1696
+    
1697
+    return $self->{default_in_filter};
1698
+}
1699
+
1700
+# DEPRECATED!
1701
+sub insert_param_tag {
1702
+    warn "insert_param_tag is DEPRECATED! " .
1703
+         "use insert_param instead!";
1704
+    return shift->insert_param(@_);
1705
+}
1706
+
1707
+# DEPRECATED!
1708
+sub register_tag_processor {
1709
+    warn "register_tag_processor is DEPRECATED!";
1710
+    return shift->query_builder->register_tag_processor(@_);
1711
+}
1712
+
1713
+# DEPRECATED!
1714
+sub update_param_tag {
1715
+    warn "update_param_tag is DEPRECATED! " .
1716
+         "use update_param instead";
1717
+    return shift->update_param(@_);
1718
+}
1719
+# DEPRECATED!
1720
+sub _push_relation {
1721
+    my ($self, $sql, $tables, $relation, $need_where) = @_;
1722
+    
1723
+    if (keys %{$relation || {}}) {
1724
+        push @$sql, $need_where ? 'where' : 'and';
1725
+        foreach my $rcolumn (keys %$relation) {
1726
+            my $table1 = (split (/\./, $rcolumn))[0];
1727
+            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1728
+            push @$tables, ($table1, $table2);
1729
+            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1730
+        }
1731
+    }
1732
+    pop @$sql if $sql->[-1] eq 'and';    
1733
+}
1734
+
1735
+# DEPRECATED!
1736
+sub _add_relation_table {
1737
+    my ($self, $tables, $relation) = @_;
1738
+    
1739
+    if (keys %{$relation || {}}) {
1740
+        foreach my $rcolumn (keys %$relation) {
1741
+            my $table1 = (split (/\./, $rcolumn))[0];
1742
+            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1743
+            my $table1_exists;
1744
+            my $table2_exists;
1745
+            foreach my $table (@$tables) {
1746
+                $table1_exists = 1 if $table eq $table1;
1747
+                $table2_exists = 1 if $table eq $table2;
1748
+            }
1749
+            unshift @$tables, $table1 unless $table1_exists;
1750
+            unshift @$tables, $table2 unless $table2_exists;
1751
+        }
1752
+    }
1753
+}
1754
+
1755
+1;
1756
+
1757
+=head1 NAME
1758
+
1759
+DBIx::Custom - Execute insert, update, delete, and select statement easily
1760
+
1761
+=head1 SYNOPSYS
1762
+
1763
+    use DBIx::Custom;
1764
+    
1765
+    # Connect
1766
+    my $dbi = DBIx::Custom->connect(
1767
+        dsn => "dbi:mysql:database=dbname",
1768
+        user => 'ken',
1769
+        password => '!LFKD%$&',
1770
+        dbi_option => {mysql_enable_utf8 => 1}
1771
+    );
1772
+
1773
+    # Insert 
1774
+    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
1775
+    
1776
+    # Update 
1777
+    $dbi->update({title => 'Perl', author => 'Ken'}, table  => 'book',
1778
+      where  => {id => 5});
1779
+    
1780
+    # Delete
1781
+    $dbi->delete(table  => 'book', where => {author => 'Ken'});
1782
+
1783
+    # Select
1784
+    my $result = $dbi->select(table  => 'book',
1785
+      column => ['title', 'author'], where  => {author => 'Ken'});
1786
+
1787
+    # Select, more complex
1788
+    my $result = $dbi->select(
1789
+        table  => 'book',
1790
+        column => [
1791
+            {book => [qw/title author/]},
1792
+            {company => ['name']}
1793
+        ],
1794
+        where  => {'book.author' => 'Ken'},
1795
+        join => ['left outer join company on book.company_id = company.id'],
1796
+        append => 'order by id limit 5'
1797
+    );
1798
+    
1799
+    # Fetch
1800
+    while (my $row = $result->fetch) {
1801
+        
1802
+    }
1803
+    
1804
+    # Fetch as hash
1805
+    while (my $row = $result->fetch_hash) {
1806
+        
1807
+    }
1808
+    
1809
+    # Execute SQL with parameter.
1810
+    $dbi->execute(
1811
+        "select id from book where author = :author and title like :title",
1812
+        {author => 'ken', title => '%Perl%'}
1813
+    );
1814
+    
1815
+=head1 DESCRIPTIONS
1816
+
1817
+L<DBIx::Custom> is L<DBI> wrapper module to execute SQL easily.
1818
+This module have the following features.
1819
+
1820
+=over 4
1821
+
1822
+=item *
1823
+
1824
+Execute C<insert>, C<update>, C<delete>, or C<select> statement easily
1825
+
1826
+=item *
1827
+
1828
+Create C<where> clause flexibly
1829
+
1830
+=item *
1831
+
1832
+Named place holder support
1833
+
1834
+=item *
1835
+
1836
+Model support
1837
+
1838
+=item *
1839
+
1840
+Connection manager support
1841
+
1842
+=item *
1843
+
1844
+Choice your favorite relational database management system,
1845
+C<MySQL>, C<SQLite>, C<PostgreSQL>, C<Oracle>,
1846
+C<Microsoft SQL Server>, C<Microsoft Access>, C<DB2> or anything, 
1847
+
1848
+=item *
1849
+
1850
+Filtering by data type or column name(EXPERIMENTAL)
1851
+
1852
+=item *
1853
+
1854
+Create C<order by> clause flexibly(EXPERIMENTAL)
1855
+
1856
+=back
1857
+
1858
+=head1 DOCUMENTATIONS
1859
+
1860
+L<DBIx::Custom::Guide> - How to use L<DBIx::Custom>
1861
+
1862
+L<DBIx::Custom Wiki|https://github.com/yuki-kimoto/DBIx-Custom/wiki>
1863
+- Theare are various examples.
1864
+
1865
+Module documentations - 
1866
+L<DBIx::Custom::Result>,
1867
+L<DBIx::Custom::Query>,
1868
+L<DBIx::Custom::Where>,
1869
+L<DBIx::Custom::Model>,
1870
+L<DBIx::Custom::Order>
1871
+
1872
+=head1 ATTRIBUTES
1873
+
1874
+=head2 C<connector>
1875
+
1876
+    my $connector = $dbi->connector;
1877
+    $dbi = $dbi->connector($connector);
1878
+
1879
+Connection manager object. if C<connector> is set, you can get C<dbh>
1880
+through connection manager. Conection manager object must have C<dbh> mehtod.
1881
+
1882
+This is L<DBIx::Connector> example. Please pass
1883
+C<default_dbi_option> to L<DBIx::Connector> C<new> method.
1884
+
1885
+    my $connector = DBIx::Connector->new(
1886
+        "dbi:mysql:database=$DATABASE",
1887
+        $USER,
1888
+        $PASSWORD,
1889
+        DBIx::Custom->new->default_dbi_option
1890
+    );
1891
+    
1892
+    my $dbi = DBIx::Custom->connect(connector => $connector);
1893
+
1894
+=head2 C<dsn>
1895
+
1896
+    my $dsn = $dbi->dsn;
1897
+    $dbi = $dbi->dsn("DBI:mysql:database=dbname");
1898
+
1899
+Data source name, used when C<connect> method is executed.
1900
+
1901
+=head2 C<dbi_option>
1902
+
1903
+    my $dbi_option = $dbi->dbi_option;
1904
+    $dbi = $dbi->dbi_option($dbi_option);
1905
+
1906
+L<DBI> option, used when C<connect> method is executed.
1907
+Each value in option override the value of C<default_dbi_option>.
1908
+
1909
+=head2 C<default_dbi_option>
1910
+
1911
+    my $default_dbi_option = $dbi->default_dbi_option;
1912
+    $dbi = $dbi->default_dbi_option($default_dbi_option);
1913
+
1914
+L<DBI> default option, used when C<connect> method is executed,
1915
+default to the following values.
1916
+
1917
+    {
1918
+        RaiseError => 1,
1919
+        PrintError => 0,
1920
+        AutoCommit => 1,
1921
+    }
1922
+
1923
+=head2 C<filters>
1924
+
1925
+    my $filters = $dbi->filters;
1926
+    $dbi = $dbi->filters(\%filters);
1927
+
1928
+Filters, registered by C<register_filter> method.
1929
+
1930
+=head2 C<last_sql>
1931
+
1932
+    my $last_sql = $dbi->last_sql;
1933
+    $dbi = $dbi->last_sql($last_sql);
1934
+
1935
+Get last successed SQL executed by C<execute> method.
1936
+
1937
+=head2 C<models>
1938
+
1939
+    my $models = $dbi->models;
1940
+    $dbi = $dbi->models(\%models);
1941
+
1942
+Models, included by C<include_model> method.
1943
+
1944
+=head2 C<password>
1945
+
1946
+    my $password = $dbi->password;
1947
+    $dbi = $dbi->password('lkj&le`@s');
1948
+
1949
+Password, used when C<connect> method is executed.
1950
+
1951
+=head2 C<query_builder>
1952
+
1953
+    my $sql_class = $dbi->query_builder;
1954
+    $dbi = $dbi->query_builder(DBIx::Custom::QueryBuilder->new);
1955
+
1956
+Query builder, default to L<DBIx::Custom::QueryBuilder> object.
1957
+
1958
+=head2 C<quote>
1959
+
1960
+     my quote = $dbi->quote;
1961
+     $dbi = $dbi->quote('"');
1962
+
1963
+Reserved word quote.
1964
+Default to double quote '"' except for mysql.
1965
+In mysql, default to back quote '`'
1966
+
1967
+You can set quote pair.
1968
+
1969
+    $dbi->quote('[]');
1970
+
1971
+=head2 C<result_class>
1972
+
1973
+    my $result_class = $dbi->result_class;
1974
+    $dbi = $dbi->result_class('DBIx::Custom::Result');
1975
+
1976
+Result class, default to L<DBIx::Custom::Result>.
1977
+
1978
+=head2 C<safety_character>
1979
+
1980
+    my $safety_character = $self->safety_character;
1981
+    $dbi = $self->safety_character($character);
1982
+
1983
+Regex of safety character for table and column name, default to '\w'.
1984
+Note that you don't have to specify like '[\w]'.
1985
+
1986
+=head2 C<tag_parse>
1987
+
1988
+    my $tag_parse = $dbi->tag_parse(0);
1989
+    $dbi = $dbi->tag_parse;
1990
+
1991
+Enable DEPRECATED tag parsing functionality, default to 1.
1992
+If you want to disable tag parsing functionality, set to 0.
1993
+
1994
+=head2 C<user>
1995
+
1996
+    my $user = $dbi->user;
1997
+    $dbi = $dbi->user('Ken');
1998
+
1999
+User name, used when C<connect> method is executed.
2000
+
2001
+=head1 METHODS
2002
+
2003
+L<DBIx::Custom> inherits all methods from L<Object::Simple>
2004
+and use all methods of L<DBI>
2005
+and implements the following new ones.
2006
+
2007
+=head2 C<available_data_type> EXPERIMENTAL
2008
+
2009
+    print $dbi->available_data_type;
2010
+
2011
+Get available data types. You can use these data types
2012
+in C<type rule>'s C<from1> and C<from2> section.
2013
+
2014
+=head2 C<available_type_name> EXPERIMENTAL
2015
+
2016
+    print $dbi->available_type_name;
2017
+
2018
+Get available type names. You can use these type names in
2019
+C<type_rule>'s C<into1> and C<into2> section.
2020
+
2021
+=head2 C<assign_param> EXPERIMENTAL
2022
+
2023
+    my $assign_param = $dbi->assign_param({title => 'a', age => 2});
2024
+
2025
+Create assign parameter.
2026
+
2027
+    title = :title, author = :author
2028
+
2029
+This is equal to C<update_param> exept that set is not added.
2030
+
2031
+=head2 C<column>
2032
+
2033
+    my $column = $dbi->column(book => ['author', 'title']);
2034
+
2035
+Create column clause. The follwoing column clause is created.
2036
+
2037
+    book.author as "book.author",
2038
+    book.title as "book.title"
2039
+
2040
+You can change separator by C<separator> method.
2041
+
2042
+    # Separator is double underbar
2043
+    $dbi->separator('__');
2044
+    
2045
+    book.author as "book__author",
2046
+    book.title as "book__title"
2047
+
2048
+    # Separator is hyphen
2049
+    $dbi->separator('-');
2050
+    
2051
+    book.author as "book-author",
2052
+    book.title as "book-title"
2053
+    
2054
+=head2 C<connect>
2055
+
2056
+    my $dbi = DBIx::Custom->connect(
2057
+        dsn => "dbi:mysql:database=dbname",
2058
+        user => 'ken',
2059
+        password => '!LFKD%$&',
2060
+        dbi_option => {mysql_enable_utf8 => 1}
2061
+    );
2062
+
2063
+Connect to the database and create a new L<DBIx::Custom> object.
2064
+
2065
+L<DBIx::Custom> is a wrapper of L<DBI>.
2066
+C<AutoCommit> and C<RaiseError> options are true, 
2067
+and C<PrintError> option is false by default.
2068
+
2069
+=head2 create_model
2070
+
2071
+    my $model = $dbi->create_model(
2072
+        table => 'book',
2073
+        primary_key => 'id',
2074
+        join => [
2075
+            'inner join company on book.comparny_id = company.id'
2076
+        ],
2077
+    );
2078
+
2079
+Create L<DBIx::Custom::Model> object and initialize model.
2080
+the module is also used from C<model> method.
2081
+
2082
+   $dbi->model('book')->select(...);
2083
+
2084
+=head2 C<dbh>
2085
+
2086
+    my $dbh = $dbi->dbh;
2087
+
2088
+Get L<DBI> database handle. if C<connector> is set, you can get
2089
+database handle through C<connector> object.
2090
+
2091
+=head2 C<each_column>
2092
+
2093
+    $dbi->each_column(
2094
+        sub {
2095
+            my ($dbi, $table, $column, $column_info) = @_;
2096
+            
2097
+            my $type = $column_info->{TYPE_NAME};
2098
+            
2099
+            if ($type eq 'DATE') {
2100
+                # ...
2101
+            }
2102
+        }
2103
+    );
2104
+
2105
+Iterate all column informations of all table from database.
2106
+Argument is callback when one column is found.
2107
+Callback receive four arguments, dbi object, table name,
2108
+column name and column information.
2109
+
2110
+=head2 C<each_table>
2111
+
2112
+    $dbi->each_table(
2113
+        sub {
2114
+            my ($dbi, $table, $table_info) = @_;
2115
+            
2116
+            my $table_name = $table_info->{TABLE_NAME};
2117
+        }
2118
+    );
2119
+
2120
+Iterate all table informationsfrom database.
2121
+Argument is callback when one table is found.
2122
+Callback receive three arguments, dbi object, table name,
2123
+table information.
2124
+
2125
+=head2 C<execute>
2126
+
2127
+    my $result = $dbi->execute(
2128
+      "select * from book where title = :title and author like :author",
2129
+      {title => 'Perl', author => '%Ken%'}
2130
+    );
2131
+
2132
+    my $result = $dbi->execute(
2133
+      "select * from book where title = :book.title and author like :book.author",
2134
+      {'book.title' => 'Perl', 'book.author' => '%Ken%'}
2135
+    );
2136
+
2137
+Execute SQL. SQL can contain column parameter such as :author and :title.
2138
+You can append table name to column name such as :book.title and :book.author.
2139
+Second argunet is data, embedded into column parameter.
2140
+Return value is L<DBIx::Custom::Result> object when select statement is executed,
2141
+or the count of affected rows when insert, update, delete statement is executed.
2142
+
2143
+Named placeholder such as C<:title> is replaced by placeholder C<?>.
2144
+    
2145
+    # Original
2146
+    select * from book where title = :title and author like :author
2147
+    
2148
+    # Replaced
2149
+    select * from where title = ? and author like ?;
2150
+
2151
+You can specify operator with named placeholder
2152
+ by C<name{operator}> syntax.
2153
+
2154
+    # Original
2155
+    select * from book where :title{=} and :author{like}
2156
+    
2157
+    # Replaced
2158
+    select * from where title = ? and author like ?;
2159
+
2160
+Note that colons in time format such as 12:13:15 is exeption,
2161
+it is not parsed as named placeholder.
2162
+If you want to use colon generally, you must escape it by C<\\>
2163
+
2164
+    select * from where title = "aa\\:bb";
2165
+
2166
+The following opitons are available.
2167
+
2168
+=over 4
2169
+
2170
+=item C<filter>
2171
+    
2172
+    filter => {
2173
+        title  => sub { uc $_[0] }
2174
+        author => sub { uc $_[0] }
2175
+    }
2176
+
2177
+    # Filter name
2178
+    filter => {
2179
+        title  => 'upper_case',
2180
+        author => 'upper_case'
2181
+    }
2182
+        
2183
+    # At once
2184
+    filter => [
2185
+        [qw/title author/]  => sub { uc $_[0] }
2186
+    ]
2187
+
2188
+Filter. You can set subroutine or filter name
2189
+registered by by C<register_filter>.
2190
+This filter is executed before data is saved into database.
2191
+and before type rule filter is executed.
2192
+
2193
+=item C<query>
2194
+
2195
+    query => 1
2196
+
2197
+C<execute> method return L<DBIx::Custom::Query> object, not executing SQL.
2198
+You can check SQL or get statment handle.
2199
+
2200
+    my $sql = $query->sql;
2201
+    my $sth = $query->sth;
2202
+    my $columns = $query->columns;
2203
+    
2204
+If you want to execute SQL fast, you can do the following way.
2205
+
2206
+    my $query;
2207
+    foreach my $row (@$rows) {
2208
+      $query ||= $dbi->insert($row, table => 'table1', query => 1);
2209
+      $dbi->execute($query, $row, filter => {ab => sub { $_[0] * 2 }});
2210
+    }
2211
+
2212
+Statement handle is reused and SQL parsing is finished,
2213
+so you can get more performance than normal way.
2214
+
2215
+If you want to execute SQL as possible as fast and don't need filtering.
2216
+You can do the following way.
2217
+    
2218
+    my $query;
2219
+    my $sth;
2220
+    foreach my $row (@$rows) {
2221
+      $query ||= $dbi->insert($row, table => 'book', query => 1);
2222
+      $sth ||= $query->sth;
2223
+      $sth->execute(map { $row->{$_} } sort keys %$row);
2224
+    }
2225
+
2226
+Note that $row must be simple hash reference, such as
2227
+{title => 'Perl', author => 'Ken'}.
2228
+and don't forget to sort $row values by $row key asc order.
2229
+
2230
+=item C<table>
2231
+    
2232
+    table => 'author'
2233
+
2234
+If you want to omit table name in column name
2235
+and enable C<into1> and C<into2> type filter,
2236
+You must set C<table> option.
2237
+
2238
+    $dbi->execute("select * from book where title = :title and author = :author",
2239
+        {title => 'Perl', author => 'Ken', table => 'book');
2240
+
2241
+    # Same
2242
+    $dbi->execute(
2243
+      "select * from book where title = :book.title and author = :book.author",
2244
+      {title => 'Perl', author => 'Ken');
2245
+
2246
+=item C<bind_type>
2247
+
2248
+Specify database bind data type.
2249
+
2250
+    bind_type => [image => DBI::SQL_BLOB]
2251
+    bind_type => [[qw/image audio/] => DBI::SQL_BLOB]
2252
+
2253
+This is used to bind parameter by C<bind_param> of statment handle.
2254
+
2255
+    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2256
+
2257
+=item C<table_alias> EXPERIMENTAL
2258
+
2259
+    table_alias => {user => 'hiker'}
2260
+
2261
+Table alias. Key is real table name, value is alias table name.
2262
+If you set C<table_alias>, you can enable C<into1> and C<into2> type rule
2263
+on alias table name.
2264
+
2265
+=item C<type_rule_off> EXPERIMENTAL
2266
+
2267
+    type_rule_off => 1
2268
+
2269
+Turn C<into1> and C<into2> type rule off.
2270
+
2271
+=item C<type_rule1_off> EXPERIMENTAL
2272
+
2273
+    type_rule1_off => 1
2274
+
2275
+Turn C<into1> type rule off.
2276
+
2277
+=item C<type_rule2_off> EXPERIMENTAL
2278
+
2279
+    type_rule2_off => 1
2280
+
2281
+Turn C<into2> type rule off.
2282
+
2283
+=back
2284
+
2285
+=head2 C<delete>
2286
+
2287
+    $dbi->delete(table => 'book', where => {title => 'Perl'});
2288
+
2289
+Execute delete statement.
2290
+
2291
+The following opitons are available.
2292
+
2293
+=over 4
2294
+
2295
+=item C<append>
2296
+
2297
+Same as C<select> method's C<append> option.
2298
+
2299
+=item C<filter>
2300
+
2301
+Same as C<execute> method's C<filter> option.
2302
+
2303
+=item C<id>
2304
+
2305
+    id => 4
2306
+    id => [4, 5]
2307
+
2308
+ID corresponding to C<primary_key>.
2309
+You can delete rows by C<id> and C<primary_key>.
2310
+
2311
+    $dbi->delete(
2312
+        parimary_key => ['id1', 'id2'],
2313
+        id => [4, 5],
2314
+        table => 'book',
2315
+    );
2316
+
2317
+The above is same as the followin one.
2318
+
2319
+    $dbi->delete(where => {id1 => 4, id2 => 5}, table => 'book');
2320
+
2321
+=item C<prefix>
2322
+
2323
+    prefix => 'some'
2324
+
2325
+prefix before table name section.
2326
+
2327
+    delete some from book
2328
+
2329
+=item C<query>
2330
+
2331
+Same as C<execute> method's C<query> option.
2332
+
2333
+=item C<table>
2334
+
2335
+    table => 'book'
2336
+
2337
+Table name.
2338
+
2339
+=item C<where>
2340
+
2341
+Same as C<select> method's C<where> option.
2342
+
2343
+=item C<primary_key>
2344
+
2345
+See C<id> option.
2346
+
2347
+=item C<bind_type>
2348
+
2349
+Same as C<execute> method's C<bind_type> option.
2350
+
2351
+=item C<type_rule_off> EXPERIMENTAL
2352
+
2353
+Same as C<execute> method's C<type_rule_off> option.
2354
+
2355
+=item C<type_rule1_off> EXPERIMENTAL
2356
+
2357
+    type_rule1_off => 1
2358
+
2359
+Same as C<execute> method's C<type_rule1_off> option.
2360
+
2361
+=item C<type_rule2_off> EXPERIMENTAL
2362
+
2363
+    type_rule2_off => 1
2364
+
2365
+Same as C<execute> method's C<type_rule2_off> option.
2366
+
2367
+=back
2368
+
2369
+=head2 C<delete_all>
2370
+
2371
+    $dbi->delete_all(table => $table);
2372
+
2373
+Execute delete statement for all rows.
2374
+Options is same as C<delete>.
2375
+
2376
+=head2 C<insert>
2377
+
2378
+    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
2379
+
2380
+Execute insert statement. First argument is row data. Return value is
2381
+affected row count.
2382
+
2383
+If you want to set constant value to row data, use scalar reference
2384
+as parameter value.
2385
+
2386
+    {date => \"NOW()"}
2387
+
2388
+The following opitons are available.
2389
+
2390
+=over 4
2391
+
2392
+=item C<append>
2393
+
2394
+Same as C<select> method's C<append> option.
2395
+
2396
+=item C<filter>
2397
+
2398
+Same as C<execute> method's C<filter> option.
2399
+
2400
+=item C<id>
2401
+
2402
+    id => 4
2403
+    id => [4, 5]
2404
+
2405
+ID corresponding to C<primary_key>.
2406
+You can insert a row by C<id> and C<primary_key>.
2407
+
2408
+    $dbi->insert(
2409
+        {title => 'Perl', author => 'Ken'}
2410
+        parimary_key => ['id1', 'id2'],
2411
+        id => [4, 5],
2412
+        table => 'book'
2413
+    );
2414
+
2415
+The above is same as the followin one.
2416
+
2417
+    $dbi->insert(
2418
+        {id1 => 4, id2 => 5, title => 'Perl', author => 'Ken'},
2419
+        table => 'book'
2420
+    );
2421
+
2422
+=item C<prefix>
2423
+
2424
+    prefix => 'or replace'
2425
+
2426
+prefix before table name section
2427
+
2428
+    insert or replace into book
2429
+
2430
+=item C<primary_key>
2431
+
2432
+    primary_key => 'id'
2433
+    primary_key => ['id1', 'id2']
2434
+
2435
+Primary key. This is used by C<id> option.
2436
+
2437
+=item C<query>
2438
+
2439
+Same as C<execute> method's C<query> option.
2440
+
2441
+=item C<table>
2442
+
2443
+    table => 'book'
2444
+
2445
+Table name.
2446
+
2447
+=item C<bind_type>
2448
+
2449
+Same as C<execute> method's C<bind_type> option.
2450
+
2451
+=item C<type_rule_off> EXPERIMENTAL
2452
+
2453
+Same as C<execute> method's C<type_rule_off> option.
2454
+
2455
+=item C<type_rule1_off> EXPERIMENTAL
2456
+
2457
+    type_rule1_off => 1
2458
+
2459
+Same as C<execute> method's C<type_rule1_off> option.
2460
+
2461
+=item C<type_rule2_off> EXPERIMENTAL
2462
+
2463
+    type_rule2_off => 1
2464
+
2465
+Same as C<execute> method's C<type_rule2_off> option.
2466
+
2467
+=back
2468
+
2469
+=over 4
2470
+
2471
+=head2 C<insert_param>
2472
+
2473
+    my $insert_param = $dbi->insert_param({title => 'a', age => 2});
2474
+
2475
+Create insert parameters.
2476
+
2477
+    (title, author) values (title = :title, age = :age);
2478
+
2479
+=head2 C<include_model>
2480
+
2481
+    $dbi->include_model('MyModel');
2482
+
2483
+Include models from specified namespace,
2484
+the following layout is needed to include models.
2485
+
2486
+    lib / MyModel.pm
2487
+        / MyModel / book.pm
2488
+                  / company.pm
2489
+
2490
+Name space module, extending L<DBIx::Custom::Model>.
2491
+
2492
+B<MyModel.pm>
2493
+
2494
+    package MyModel;
2495
+    use DBIx::Custom::Model -base;
2496
+    
2497
+    1;
2498
+
2499
+Model modules, extending name space module.
2500
+
2501
+B<MyModel/book.pm>
2502
+
2503
+    package MyModel::book;
2504
+    use MyModel -base;
2505
+    
2506
+    1;
2507
+
2508
+B<MyModel/company.pm>
2509
+
2510
+    package MyModel::company;
2511
+    use MyModel -base;
2512
+    
2513
+    1;
2514
+    
2515
+MyModel::book and MyModel::company is included by C<include_model>.
2516
+
2517
+You can get model object by C<model>.
2518
+
2519
+    my $book_model = $dbi->model('book');
2520
+    my $company_model = $dbi->model('company');
2521
+
2522
+See L<DBIx::Custom::Model> to know model features.
2523
+
2524
+=head2 C<map_param> EXPERIMENTAL
2525
+
2526
+    my $map_param = $dbi->map_param(
2527
+        {id => 1, authro => 'Ken', price => 1900},
2528
+        'id' => 'book.id',
2529
+        'author' => ['book.author' => sub { '%' . $_[0] . '%' }],
2530
+        'price' => [
2531
+            'book.price', {if => sub { length $_[0] }}
2532
+        ]
2533
+    );
2534
+
2535
+Map paramters to other key and value. First argument is original
2536
+parameter. this is hash reference. Rest argument is mapping.
2537
+By default, Mapping is done if the value length is not zero.
2538
+
2539
+=over 4
2540
+
2541
+=item Key mapping
2542
+
2543
+    'id' => 'book.id'
2544
+
2545
+This is only key mapping. Value is same as original one.
2546
+
2547
+    (id => 1) is mapped to ('book.id' => 1) if value length is not zero.
2548
+
2549
+=item Key and value mapping
2550
+
2551
+    'author' => ['book.author' => sub { '%' . $_[0] . '%' }]
2552
+
2553
+This is key and value mapping. Frist element of array reference
2554
+is mapped key name, second element is code reference to map the value.
2555
+
2556
+    (author => 'Ken') is mapped to ('book.author' => '%Ken%')
2557
+      if value length is not zero.
2558
+
2559
+=item Condition
2560
+
2561
+    'price' => ['book.price', {if => 'exists'}]
2562
+    'price' => ['book.price', sub { '%' . $_[0] . '%' }, {if => 'exists'}]
2563
+    'price' => ['book.price', {if => sub { defined shift }}]
2564
+
2565
+If you need condition, you can sepecify it. this is code reference
2566
+or 'exists'. By default, condition is the following one.
2567
+
2568
+    sub { defined $_[0] && length $_[0] }
2569
+
2570
+=back
2571
+
2572
+=head2 C<merge_param>
2573
+
2574
+    my $param = $dbi->merge_param({key1 => 1}, {key1 => 1, key2 => 2});
2575
+
2576
+Merge parameters.
2577
+
2578
+    {key1 => [1, 1], key2 => 2}
2579
+
2580
+=head2 C<method>
2581
+
2582
+    $dbi->method(
2583
+        update_or_insert => sub {
2584
+            my $self = shift;
2585
+            
2586
+            # Process
2587
+        },
2588
+        find_or_create   => sub {
2589
+            my $self = shift;
2590
+            
2591
+            # Process
2592
+        }
2593
+    );
2594
+
2595
+Register method. These method is called directly from L<DBIx::Custom> object.
2596
+
2597
+    $dbi->update_or_insert;
2598
+    $dbi->find_or_create;
2599
+
2600
+=head2 C<model>
2601
+
2602
+    my $model = $dbi->model('book');
2603
+
2604
+Get a L<DBIx::Custom::Model> object,
2605
+
2606
+=head2 C<mycolumn>
2607
+
2608
+    my $column = $self->mycolumn(book => ['author', 'title']);
2609
+
2610
+Create column clause for myself. The follwoing column clause is created.
2611
+
2612
+    book.author as author,
2613
+    book.title as title
2614
+
2615
+=head2 C<new>
2616
+
2617
+    my $dbi = DBIx::Custom->new(
2618
+        dsn => "dbi:mysql:database=dbname",
2619
+        user => 'ken',
2620
+        password => '!LFKD%$&',
2621
+        dbi_option => {mysql_enable_utf8 => 1}
2622
+    );
2623
+
2624
+Create a new L<DBIx::Custom> object.
2625
+
2626
+=head2 C<not_exists>
2627
+
2628
+    my $not_exists = $dbi->not_exists;
2629
+
2630
+DBIx::Custom::NotExists object, indicating the column is not exists.
2631
+This is used by C<clause> of L<DBIx::Custom::Where> .
2632
+
2633
+=head2 C<order> EXPERIMENTAL
2634
+
2635
+    my $order = $dbi->order;
2636
+
2637
+Create a new L<DBIx::Custom::Order> object.
2638
+
2639
+=head2 C<register_filter>
2640
+
2641
+    $dbi->register_filter(
2642
+        # Time::Piece object to database DATE format
2643
+        tp_to_date => sub {
2644
+            my $tp = shift;
2645
+            return $tp->strftime('%Y-%m-%d');
2646
+        },
2647
+        # database DATE format to Time::Piece object
2648
+        date_to_tp => sub {
2649
+           my $date = shift;
2650
+           return Time::Piece->strptime($date, '%Y-%m-%d');
2651
+        }
2652
+    );
2653
+    
2654
+Register filters, used by C<filter> option of many methods.
2655
+
2656
+=head2 C<type_rule> EXPERIMENTAL
2657
+
2658
+    $dbi->type_rule(
2659
+        into1 => {
2660
+            date => sub { ... },
2661
+            datetime => sub { ... }
2662
+        },
2663
+        into2 => {
2664
+            date => sub { ... },
2665
+            datetime => sub { ... }
2666
+        },
2667
+        from1 => {
2668
+            # DATE
2669
+            9 => sub { ... },
2670
+            # DATETIME or TIMESTAMP
2671
+            11 => sub { ... },
2672
+        }
2673
+        from2 => {
2674
+            # DATE
2675
+            9 => sub { ... },
2676
+            # DATETIME or TIMESTAMP
2677
+            11 => sub { ... },
2678
+        }
2679
+    );
2680
+
2681
+Filtering rule when data is send into and get from database.
2682
+This has a little complex problem.
2683
+
2684
+In C<into1> and C<into2> you can specify
2685
+type name as same as type name defined
2686
+by create table, such as C<DATETIME> or C<DATE>.
2687
+
2688
+Note that type name and data type don't contain upper case.
2689
+If these contain upper case charactor, you convert it to lower case.
2690
+
2691
+C<into2> is executed after C<into1>.
2692
+
2693
+Type rule of C<into1> and C<into2> is enabled on the following
2694
+column name.
2695
+
2696
+=over 4
2697
+
2698
+=item 1. column name
2699
+
2700
+    issue_date
2701
+    issue_datetime
2702
+
2703
+This need C<table> option in each method.
2704
+
2705
+=item 2. table name and column name, separator is dot
2706
+
2707
+    book.issue_date
2708
+    book.issue_datetime
2709
+
2710
+=back
2711
+
2712
+You get all type name used in database by C<available_type_name>.
2713
+
2714
+    print $dbi->available_type_name;
2715
+
2716
+In C<from1> and C<from2> you specify data type, not type name.
2717
+C<from2> is executed after C<from1>.
2718
+You get all data type by C<available_data_type>.
2719
+
2720
+    print $dbi->available_data_type;
2721
+
2722
+You can also specify multiple types at once.
2723
+
2724
+    $dbi->type_rule(
2725
+        into1 => [
2726
+            [qw/DATE DATETIME/] => sub { ... },
2727
+        ],
2728
+    );
2729
+
2730
+=head2 C<select>
2731
+
2732
+    my $result = $dbi->select(
2733
+        table  => 'book',
2734
+        column => ['author', 'title'],
2735
+        where  => {author => 'Ken'},
2736
+    );
2737
+    
2738
+Execute select statement.
2739
+
2740
+The following opitons are available.
2741
+
2742
+=over 4
2743
+
2744
+=item C<append>
2745
+
2746
+    append => 'order by title'
2747
+
2748
+Append statement to last of SQL.
2749
+    
2750
+=item C<column>
2751
+    
2752
+    column => 'author'
2753
+    column => ['author', 'title']
2754
+
2755
+Column clause.
2756
+    
2757
+if C<column> is not specified, '*' is set.
2758
+
2759
+    column => '*'
2760
+
2761
+You can specify hash of array reference.
2762
+
2763
+    column => [
2764
+        {book => [qw/author title/]},
2765
+        {person => [qw/name age/]}
2766
+    ]
2767
+
2768
+This is expanded to the following one by using C<colomn> method.
2769
+
2770
+    book.author as "book.author",
2771
+    book.title as "book.title",
2772
+    person.name as "person.name",
2773
+    person.age as "person.age"
2774
+
2775
+You can specify array of array reference, first argument is
2776
+column name, second argument is alias.
2777
+
2778
+    column => [
2779
+        ['date(book.register_datetime)' => 'book.register_date']
2780
+    ];
2781
+
2782
+Alias is quoted properly and joined.
2783
+
2784
+    date(book.register_datetime) as "book.register_date"
2785
+
2786
+=item C<filter>
2787
+
2788
+Same as C<execute> method's C<filter> option.
2789
+
2790
+=item C<id>
2791
+
2792
+    id => 4
2793
+    id => [4, 5]
2794
+
2795
+ID corresponding to C<primary_key>.
2796
+You can select rows by C<id> and C<primary_key>.
2797
+
2798
+    $dbi->select(
2799
+        parimary_key => ['id1', 'id2'],
2800
+        id => [4, 5],
2801
+        table => 'book'
2802
+    );
2803
+
2804
+The above is same as the followin one.
2805
+
2806
+    $dbi->select(
2807
+        where => {id1 => 4, id2 => 5},
2808
+        table => 'book'
2809
+    );
2810
+    
2811
+=item C<param> EXPERIMETNAL
2812
+
2813
+    param => {'table2.key3' => 5}
2814
+
2815
+Parameter shown before where clause.
2816
+    
2817
+For example, if you want to contain tag in join clause, 
2818
+you can pass parameter by C<param> option.
2819
+
2820
+    join  => ['inner join (select * from table2 where table2.key3 = :table2.key3)' . 
2821
+              ' as table2 on table1.key1 = table2.key1']
2822
+
2823
+=itme C<prefix>
2824
+
2825
+    prefix => 'SQL_CALC_FOUND_ROWS'
2826
+
2827
+Prefix of column cluase
2828
+
2829
+    select SQL_CALC_FOUND_ROWS title, author from book;
2830
+
2831
+=item C<join>
2832
+
2833
+    join => [
2834
+        'left outer join company on book.company_id = company_id',
2835
+        'left outer join location on company.location_id = location.id'
2836
+    ]
2837
+        
2838
+Join clause. If column cluase or where clause contain table name like "company.name",
2839
+join clausees needed when SQL is created is used automatically.
2840
+
2841
+    $dbi->select(
2842
+        table => 'book',
2843
+        column => ['company.location_id as location_id'],
2844
+        where => {'company.name' => 'Orange'},
2845
+        join => [
2846
+            'left outer join company on book.company_id = company.id',
2847
+            'left outer join location on company.location_id = location.id'
2848
+        ]
2849
+    );
2850
+
2851
+In above select, column and where clause contain "company" table,
2852
+the following SQL is created
2853
+
2854
+    select company.location_id as location_id
2855
+    from book
2856
+      left outer join company on book.company_id = company.id
2857
+    where company.name = ?;
2858
+
2859
+You can specify two table by yourself. This is useful when join parser can't parse
2860
+the join clause correctly. This is EXPERIMENTAL.
2861
+
2862
+    $dbi->select(
2863
+        table => 'book',
2864
+        column => ['company.location_id as location_id'],
2865
+        where => {'company.name' => 'Orange'},
2866
+        join => [
2867
+            {
2868
+                clause => 'left outer join location on company.location_id = location.id',
2869
+                table => ['company', 'location']
2870
+            }
2871
+        ]
2872
+    );
2873
+
2874
+=item C<primary_key>
2875
+
2876
+    primary_key => 'id'
2877
+    primary_key => ['id1', 'id2']
2878
+
2879
+Primary key. This is used by C<id> option.
2880
+
2881
+=item C<query>
2882
+
2883
+Same as C<execute> method's C<query> option.
2884
+
2885
+=item C<bind_type>
2886
+
2887
+Same as C<execute> method's C<bind_type> option.
2888
+
2889
+=item C<table>
2890
+
2891
+    table => 'book'
2892
+
2893
+Table name.
2894
+
2895
+=item C<type_rule_off> EXPERIMENTAL
2896
+
2897
+Same as C<execute> method's C<type_rule_off> option.
2898
+
2899
+=item C<type_rule1_off> EXPERIMENTAL
2900
+
2901
+    type_rule1_off => 1
2902
+
2903
+Same as C<execute> method's C<type_rule1_off> option.
2904
+
2905
+=item C<type_rule2_off> EXPERIMENTAL
2906
+
2907
+    type_rule2_off => 1
2908
+
2909
+Same as C<execute> method's C<type_rule2_off> option.
2910
+
2911
+=item C<where>
2912
+    
2913
+    # Hash refrence
2914
+    where => {author => 'Ken', 'title' => 'Perl'}
2915
+    
2916
+    # DBIx::Custom::Where object
2917
+    where => $dbi->where(
2918
+        clause => ['and', 'author = :author', 'title like :title'],
2919
+        param  => {author => 'Ken', title => '%Perl%'}
2920
+    );
2921
+    
2922
+    # Array reference 1 (array reference, hash referenc). same as above
2923
+    where => [
2924
+        ['and', 'author = :author', 'title like :title'],
2925
+        {author => 'Ken', title => '%Perl%'}
2926
+    ];    
2927
+    
2928
+    # Array reference 2 (String, hash reference)
2929
+    where => [
2930
+        'title like :title',
2931
+        {title => '%Perl%'}
2932
+    ]
2933
+    
2934
+    # String
2935
+    where => 'title is null'
2936
+
2937
+Where clause.
2938
+    
2939
+=item C<wrap> EXPERIMENTAL
2940
+
2941
+Wrap statement. This is array reference.
2942
+
2943
+    $dbi->select(wrap => ['select * from (', ') as t where ROWNUM < 10']);
2944
+
2945
+This option is for Oracle and SQL Server paging process.
2946
+
2947
+=back
2948
+
2949
+=head2 C<update>
2950
+
2951
+    $dbi->update({title => 'Perl'}, table  => 'book', where  => {id => 4});
2952
+
2953
+Execute update statement. First argument is update row data.
2954
+
2955
+If you want to set constant value to row data, use scalar reference
2956
+as parameter value.
2957
+
2958
+    {date => \"NOW()"}
2959
+
2960
+The following opitons are available.
2961
+
2962
+=over 4
2963
+
2964
+=item C<append>
2965
+
2966
+Same as C<select> method's C<append> option.
2967
+
2968
+=item C<filter>
2969
+
2970
+Same as C<execute> method's C<filter> option.
2971
+
2972
+=item C<id>
2973
+
2974
+    id => 4
2975
+    id => [4, 5]
2976
+
2977
+ID corresponding to C<primary_key>.
2978
+You can update rows by C<id> and C<primary_key>.
2979
+
2980
+    $dbi->update(
2981
+        {title => 'Perl', author => 'Ken'}
2982
+        parimary_key => ['id1', 'id2'],
2983
+        id => [4, 5],
2984
+        table => 'book'
2985
+    );
2986
+
2987
+The above is same as the followin one.
2988
+
2989
+    $dbi->update(
2990
+        {title => 'Perl', author => 'Ken'}
2991
+        where => {id1 => 4, id2 => 5},
2992
+        table => 'book'
2993
+    );
2994
+
2995
+=item C<prefix>
2996
+
2997
+    prefix => 'or replace'
2998
+
2999
+prefix before table name section
3000
+
3001
+    update or replace book
3002
+
3003
+=item C<primary_key>
3004
+
3005
+    primary_key => 'id'
3006
+    primary_key => ['id1', 'id2']
3007
+
3008
+Primary key. This is used by C<id> option.
3009
+
3010
+=item C<query>
3011
+
3012
+Same as C<execute> method's C<query> option.
3013
+
3014
+=item C<table>
3015
+
3016
+    table => 'book'
3017
+
3018
+Table name.
3019
+
3020
+=item C<where>
3021
+
3022
+Same as C<select> method's C<where> option.
3023
+
3024
+=item C<bind_type>
3025
+
3026
+Same as C<execute> method's C<bind_type> option.
3027
+
3028
+=item C<type_rule_off> EXPERIMENTAL
3029
+
3030
+Same as C<execute> method's C<type_rule_off> option.
3031
+
3032
+=item C<type_rule1_off> EXPERIMENTAL
3033
+
3034
+    type_rule1_off => 1
3035
+
3036
+Same as C<execute> method's C<type_rule1_off> option.
3037
+
3038
+=item C<type_rule2_off> EXPERIMENTAL
3039
+
3040
+    type_rule2_off => 1
3041
+
3042
+Same as C<execute> method's C<type_rule2_off> option.
3043
+
3044
+=back
3045
+
3046
+=head2 C<update_all>
3047
+
3048
+    $dbi->update_all({title => 'Perl'}, table => 'book', );
3049
+
3050
+Execute update statement for all rows.
3051
+Options is same as C<update> method.
3052
+
3053
+=head2 C<update_param>
3054
+
3055
+    my $update_param = $dbi->update_param({title => 'a', age => 2});
3056
+
3057
+Create update parameter tag.
3058
+
3059
+    set title = :title, author = :author
3060
+
3061
+=head2 C<where>
3062
+
3063
+    my $where = $dbi->where(
3064
+        clause => ['and', 'title = :title', 'author = :author'],
3065
+        param => {title => 'Perl', author => 'Ken'}
3066
+    );
3067
+
3068
+Create a new L<DBIx::Custom::Where> object.
3069
+
3070
+=head2 C<setup_model>
3071
+
3072
+    $dbi->setup_model;
3073
+
3074
+Setup all model objects.
3075
+C<columns> of model object is automatically set, parsing database information.
3076
+
3077
+=head1 ENVIRONMENT VARIABLE
3078
+
3079
+=head2 C<DBIX_CUSTOM_DEBUG>
3080
+
3081
+If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
3082
+executed SQL and bind values are printed to STDERR.
3083
+
3084
+=head2 C<DBIX_CUSTOM_DEBUG_ENCODING>
3085
+
3086
+DEBUG output encoding. Default to UTF-8.
3087
+
3088
+=head1 DEPRECATED FUNCTIONALITIES
3089
+
3090
+L<DBIx::Custom>
3091
+
3092
+    # Attribute methods
3093
+    data_source # will be removed at 2017/1/1
3094
+    dbi_options # will be removed at 2017/1/1
3095
+    filter_check # will be removed at 2017/1/1
3096
+    reserved_word_quote # will be removed at 2017/1/1
3097
+    cache_method # will be removed at 2017/1/1
3098
+    
3099
+    # Methods
3100
+    create_query # will be removed at 2017/1/1
3101
+    apply_filter # will be removed at 2017/1/1
3102
+    select_at # will be removed at 2017/1/1
3103
+    delete_at # will be removed at 2017/1/1
3104
+    update_at # will be removed at 2017/1/1
3105
+    insert_at # will be removed at 2017/1/1
3106
+    register_tag # will be removed at 2017/1/1
3107
+    default_bind_filter # will be removed at 2017/1/1
3108
+    default_fetch_filter # will be removed at 2017/1/1
3109
+    insert_param_tag # will be removed at 2017/1/1
3110
+    register_tag_processor # will be removed at 2017/1/1
3111
+    update_param_tag # will be removed at 2017/1/1
3112
+    
3113
+    # Options
3114
+    select method relation option # will be removed at 2017/1/1
3115
+    select method param option # will be removed at 2017/1/1
3116
+    select method column option [COLUMN, as => ALIAS] format
3117
+      # will be removed at 2017/1/1
3118
+    
3119
+    # Others
3120
+    execute("select * from {= title}"); # execute method's
3121
+                                        # tag parsing functionality
3122
+                                        # will be removed at 2017/1/1
3123
+    Query caching # will be removed at 2017/1/1
3124
+
3125
+L<DBIx::Custom::Model>
3126
+
3127
+    # Attribute methods
3128
+    filter # will be removed at 2017/1/1
3129
+    name # will be removed at 2017/1/1
3130
+    type # will be removed at 2017/1/1
3131
+
3132
+L<DBIx::Custom::Query>
3133
+    
3134
+    # Attribute methods
3135
+    default_filter # will be removed at 2017/1/1
3136
+    table # will be removed at 2017/1/1
3137
+    filters # will be removed at 2017/1/1
3138
+    
3139
+    # Methods
3140
+    filter # will be removed at 2017/1/1
3141
+
3142
+L<DBIx::Custom::QueryBuilder>
3143
+    
3144
+    # Attribute methods
3145
+    tags # will be removed at 2017/1/1
3146
+    tag_processors # will be removed at 2017/1/1
3147
+    
3148
+    # Methods
3149
+    register_tag # will be removed at 2017/1/1
3150
+    register_tag_processor # will be removed at 2017/1/1
3151
+    
3152
+    # Others
3153
+    build_query("select * from {= title}"); # tag parsing functionality
3154
+                                            # will be removed at 2017/1/1
3155
+
3156
+L<DBIx::Custom::Result>
3157
+    
3158
+    # Attribute methods
3159
+    filter_check # will be removed at 2017/1/1
3160
+    
3161
+    # Methods
3162
+    end_filter # will be removed at 2017/1/1
3163
+    remove_end_filter # will be removed at 2017/1/1
3164
+    remove_filter # will be removed at 2017/1/1
3165
+    default_filter # will be removed at 2017/1/1
3166
+
3167
+L<DBIx::Custom::Tag>
3168
+
3169
+    This module is DEPRECATED! # will be removed at 2017/1/1
3170
+
3171
+=head1 BACKWORD COMPATIBLE POLICY
3172
+
3173
+If a functionality is DEPRECATED, you can know it by DEPRECATED warnings
3174
+except for attribute method.
3175
+You can check all DEPRECATED functionalities by document.
3176
+DEPRECATED functionality is removed after five years,
3177
+but if at least one person use the functionality and tell me that thing
3178
+I extend one year each time he tell me it.
3179
+
3180
+EXPERIMENTAL functionality will be changed without warnings.
3181
+
3182
+This policy was changed at 2011/6/28
3183
+
3184
+=head1 BUGS
3185
+
3186
+Please tell me bugs if found.
3187
+
3188
+C<< <kimoto.yuki at gmail.com> >>
3189
+
3190
+L<http://github.com/yuki-kimoto/DBIx-Custom>
3191
+
3192
+=head1 AUTHOR
3193
+
3194
+Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
3195
+
3196
+=head1 COPYRIGHT & LICENSE
3197
+
3198
+Copyright 2009-2011 Yuki Kimoto, all rights reserved.
3199
+
3200
+This program is free software; you can redistribute it and/or modify it
3201
+under the same terms as Perl itself.
3202
+
3203
+=cut
+603
DBIx-Custom-0.1711/DBIx-Custom-0.1711/lib/DBIx/Custom/Guide.pod
... ...
@@ -0,0 +1,603 @@
1
+=encoding utf8
2
+
3
+=head1 NAME
4
+
5
+DBIx::Custom::Guide - DBIx::Custom Guide
6
+
7
+=head1 FEATURES
8
+
9
+L<DBIx::Custom> is the wrapper class of L<DBI> to execute SQL easily.
10
+This module have the following features.
11
+
12
+=over 4
13
+
14
+=item * Execute INSERT, UPDATE, DELETE, SELECT statement easily
15
+
16
+=item * You can specify bind values by hash reference
17
+
18
+=item * Filtering by data type. and you can set filter to any column
19
+
20
+=item * Creating where clause and order by clause flexibly
21
+
22
+=item * Support model
23
+
24
+=back
25
+
26
+=head1 GUIDE
27
+
28
+=head2 Connect to database
29
+
30
+    use DBIx::Custom;
31
+    my $dbi = DBIx::Custom->connect(
32
+        dsn => "dbi:mysql:database=bookshop",
33
+        user => 'ken',
34
+        password => '!LFKD%$&',
35
+        dbi_option => {mysql_enable_utf8 => 1}
36
+    );
37
+
38
+You can connect to database by C<connect> method.
39
+C<dsn> is data source name, C<user> is user name, C<password> is password.
40
+
41
+C<dbi_option> is L<DBI> option.
42
+By default, the following option is set.
43
+Exeption is thrown when fatal error occur and commit mode is auto commit.
44
+
45
+    {
46
+        RaiseError  =>  1
47
+        PrintError  =>  0
48
+        AutoCommit  =>  1
49
+    }
50
+
51
+=head2 Execute query
52
+
53
+=head3 Insert Statement : C<insert>
54
+
55
+If you want to execute insert statement, use C<insert> method.
56
+
57
+    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
58
+
59
+First argument is insert row data, C<table>  is table name.
60
+
61
+=head3 Update Statement : C<update>
62
+
63
+If you want to execute update stateimuse, use C<update> method.
64
+
65
+    $dbi->update(
66
+        {title => 'Perl', author => 'Ken'},
67
+        table  => 'book', 
68
+        where  => {id => 5}
69
+    );
70
+
71
+First argument is update row data, C<table> is table name, C<where> is condition.
72
+
73
+Note that you can't execute C<update> method without C<where>.
74
+If you want to update all rows, use update_all.
75
+
76
+    $dbi->update_all({title => 'Perl', author => 'Ken'}, table  => 'book');
77
+
78
+=head3 Delete Statement : C<delete>
79
+
80
+If you want to execute delete statement, use C<delete> method.
81
+
82
+    $dbi->delete(table  => 'book', where  => {author => 'Ken'});
83
+
84
+C<table> is table name, C<where> is condition.
85
+
86
+Note that you can't execute C<delete> method without C<where>.
87
+If you want to delete all rows, use C<delete_all> method.
88
+
89
+    $dbi->delete_all(table  => 'book');
90
+
91
+=head3 Select Statement : C<select>
92
+
93
+If you want to execute select statement, use C<select> method.
94
+
95
+    my $result = $dbi->select(table => 'book');
96
+
97
+Return value is L<DBIx::Custom::Result> object.
98
+You can fetch rows by C<fetch> method.
99
+
100
+    while (my $row = $result->fetch) {
101
+        my $title  = $row->[0];
102
+        my $author = $row->[1];
103
+    }
104
+
105
+See also L<Fetch row/"Fetch row"> about L<DBIx::Custom::Result>.
106
+
107
+You can specify column names by C<column> option
108
+and condition by C<where> option.
109
+
110
+    my $result = $dbi->select(
111
+        table  => 'book',
112
+        column => ['author',  'title'],
113
+        where  => {author => 'Ken'}
114
+    );
115
+
116
+You can specify join clause by C<join> option.
117
+
118
+    my $result = $dbi->select(
119
+        table  => 'book',
120
+        column => ['company.name as company_name']
121
+        where  => {'book.name' => 'Perl'},
122
+        join   => ['left outer join company on book.company_id = company.id]
123
+    );
124
+
125
+Note that join clause is joined only when C<where> or C<column> option contains table name,
126
+such as book.name.
127
+
128
+You can append statement to the end of whole statement by C<append> option.
129
+
130
+    my $result = $dbi->select(
131
+        table  => 'book',
132
+        where  => {author => 'Ken'},
133
+        append => 'for update',
134
+    );
135
+
136
+=head3 C<execute>
137
+
138
+If you want to execute SQL, use C<execute> method.
139
+
140
+    $dbi->execute("select * from book;");
141
+
142
+You can specify named placeholder.
143
+
144
+    $dbi->execute(
145
+        "select * from book title = :title and author = :author;"
146
+        {title => 'Perl', author => 'Ken'}
147
+    );
148
+
149
+:title and :author is named placeholder, which is replaced to placeholers.
150
+
151
+    select * from book title = ? and author = ?;
152
+
153
+=head3 C<dbh>
154
+
155
+    my $dbh = $dbi->dbh;
156
+
157
+Get get database handle object of L<DBI>.
158
+
159
+=head3 C<DBI> methods
160
+
161
+    $dbi->do(...);
162
+    $dbi->begin_work;
163
+
164
+You can call all methods of L<DBI> from L<DBIx::Custom> object.
165
+
166
+=head2 Fetch Rows
167
+
168
+C<select> method return value is L<DBIx::Custom::Result> object.
169
+You can fetch a row or rows by various methods.
170
+
171
+=head3 Fetch a row (array) : C<fetch>
172
+
173
+    my $row = $result->fetch;
174
+
175
+C<fetch> method fetch a row and put it into array reference.
176
+You can continue to fetch 
177
+
178
+    while (my $row = $result->fetch) {
179
+        my $title  = $row->[0];
180
+        my $author = $row->[1];
181
+    }
182
+
183
+=head3 Fetch only first row (array) : C<fetch_first>
184
+
185
+    my $row = $result->fetch_first;
186
+
187
+C<fetch_first> fetch a only first row and finish statment handle,
188
+and put it into array refrence.
189
+
190
+=head3 Fetch all rows (array) : C<fetch_all>
191
+
192
+    my $rows = $result->fetch_all;
193
+
194
+C<fetch_all> fetch all rows and put them into array of array reference.
195
+
196
+=head3 Fetch a row (hash) : C<fetch_hash>
197
+
198
+    my $row = $result->fetch_hash;
199
+
200
+C<fetch_hash> fetch a row and put it into hash reference.
201
+You can fetch a row while row exists.
202
+
203
+    while (my $row = $result->fetch_hash) {
204
+        my $title  = $row->{title};
205
+        my $author = $row->{author};
206
+    }
207
+
208
+=head3 Fetch only a first row (hash) : C<fetch_hash_first>
209
+
210
+    my $row = $result->fetch_hash_first;
211
+
212
+C<fetch_hash_first> fetch only a first row and finish statement handle,
213
+and put them into hash refrence.
214
+
215
+C<one> is C<fetch_hash_first> synonym to save word typing.
216
+
217
+    my $row = $result->one;
218
+
219
+=head3 Fetch all rows (hash) : C<fetch_hash_all>
220
+
221
+    my $rows = $result->fetch_hash_all;
222
+
223
+C<fetch_hash_all> fetch all rows and put them into array of hash reference.
224
+
225
+=head3 Statement Handle : C<sth>
226
+
227
+    my $sth = $result->sth;
228
+
229
+If you want to get statment handle, use <sth> method.
230
+
231
+=head2 Named placeholder
232
+
233
+=head3 Basic of Parameter
234
+
235
+You can embedd named placeholder into SQL.
236
+
237
+    select * from book where title = :title and author like :author;
238
+
239
+:title and :author is named placeholder
240
+
241
+Named placeholder is replaced by place holder.
242
+
243
+    select * from book where title = ? and author like ?;
244
+
245
+use C<execute> to execute SQL.
246
+
247
+    my $sql = "select * from book where title = :title and author like :author;"
248
+    $dbi->execute($sql, {title => 'Perl', author => '%Ken%'});
249
+
250
+You can specify C<filter> at C<execute>.
251
+
252
+    $dbi->execute($sql, {title => 'Perl', author => '%Ken%'}
253
+                  filter => {title => 'to_something');
254
+
255
+=head3 Manipulate same name's columns
256
+
257
+It is ok if there are same name's columns.
258
+Let's think two date comparison.
259
+
260
+    my $sql = "select * from table where date > :date and date < :date;";
261
+
262
+In this case, You specify parameter values as array reference.
263
+
264
+    my $dbi->execute($sql, {date => ['2010-10-01', '2012-02-10']});
265
+
266
+=head2 Create where clause
267
+
268
+=head3 Dinamically create where clause : where
269
+
270
+You want to search multiple conditions in many times.
271
+Let's think the following three cases.
272
+
273
+Case1: Search only C<title>
274
+
275
+    where title = :title
276
+
277
+Case2: Search only C<author>
278
+
279
+    where author = :author
280
+
281
+Case3: Search C<title> and C<author>
282
+
283
+    where title = :title and author = :author
284
+
285
+L<DBIx::Custom> support dinamic where clause creating.
286
+At first, create L<DBIx::Custom::Where> object by C<where>.
287
+
288
+    my $where = $dbi->where;
289
+
290
+Set clause by C<clause>
291
+
292
+    $where->clause(
293
+        ['and', 'title = :title, 'author = :author']
294
+    );
295
+
296
+C<clause> is the following format.
297
+
298
+    ['or' or 'and', PART1, PART1, PART1]
299
+
300
+First argument is 'or' or 'and'.
301
+Later than first argument are part which contains named placeholder.
302
+
303
+You can write more complex format.
304
+
305
+    ['and', 
306
+      'title = :title', 
307
+      ['or', 'author = :author', 'date like :date']
308
+    ]
309
+
310
+This mean "title = :title and ( author = :author or date like :date )".
311
+
312
+After setting C<clause>, set C<param>.
313
+    
314
+    $where->param({title => 'Perl'});
315
+
316
+In this example, parameter contains only title.
317
+
318
+If you execute C<string_to>, you can get where clause
319
+which contain only named placeholder.
320
+
321
+    my $where_clause = $where->to_string;
322
+
323
+Parameter name is only title, the following where clause is created.
324
+
325
+    where title = :title
326
+
327
+You can also create where clause by stringification.
328
+
329
+    my $where_clause = "$where";
330
+
331
+This is useful to embbed it into SQL. 
332
+
333
+=head3 In case where clause contains same name columns
334
+
335
+Even if same name parameters exists, you can create where clause.
336
+Let's think that there are starting date and ending date.
337
+
338
+    my $param = {start_date => '2010-11-15', end_date => '2011-11-21'};
339
+
340
+In this case, you set parameter value as array reference.
341
+
342
+    my $p = {date => ['2010-11-15', '2011-11-21']};
343
+
344
+You can embbed these values into same name parameters.
345
+
346
+    $where->clause(
347
+        ['and', 'date > :date', 'date < :date']
348
+    );
349
+    $where->param($p);
350
+
351
+If starting date isn't exists, create the following parameter.
352
+
353
+    my $p = {date => [$dbi->not_exists, '2011-11-21']};
354
+
355
+You can get DBIx::Custom::NotExists object by C<not_exists>
356
+This mean correnspondinf value isn't exists.
357
+
358
+If ending date isn't exists, create the following parameter.
359
+
360
+    my $p = {date => ['2010-11-15']};
361
+
362
+If both date isn't exists, create the following parameter.
363
+
364
+    my $p = {date => []};
365
+
366
+This logic is a little difficut. See the following ones.
367
+
368
+    my @date;
369
+    push @date, exists $param->{start_date} ? $param->{start_date}
370
+                                            : $dbi->not_exists;
371
+    push @date, $param->{end_date} if exists $param->{end_date};
372
+    my $p = {date => \@date};
373
+
374
+=head3 With C<select>
375
+
376
+You can pass L<DBIx::Custom::Where> object to C<where> of C<select>.
377
+    
378
+    my $where = $dbi->where;
379
+    $where->clause(['and', 'title = :title', 'author = :author']);
380
+    $where->param({title => 'Perl'});
381
+    my $result = $dbi->select(table => 'book', where => $where);
382
+
383
+You can also pass it to C<where> of C<update>AC<delete>
384
+
385
+=head3 With C<execute>
386
+
387
+L<DBIx::Custom::Where> object is embedded into SQL.
388
+
389
+    my $where = $dbi->where;
390
+    $where->clause(['and', 'title = :title', 'author = :author']);
391
+    $where->param({title => 'Perl'});
392
+
393
+    my $sql = <<"EOS";
394
+    select * from book;
395
+    $where
396
+    EOS
397
+
398
+    $dbi->execute($sql, $param, table => 'book');
399
+
400
+=head2 Filtering
401
+
402
+=head3 Register filter : C<register_filter>
403
+
404
+If you want to register filter, use C<register_filter>.
405
+
406
+    $dbi->register_filter(
407
+        # Time::Piece object to DATE format
408
+        tp_to_date => sub {
409
+            my $date = shift;
410
+            return $tp->strftime('%Y-%m-%d');
411
+        },
412
+        
413
+        # DATE to Time::Piece object
414
+        date_to_tp => sub {
415
+            my $date = shift;
416
+            return Time::Piece->strptime($date, '%Y-%m-%d');
417
+        },
418
+    );
419
+
420
+=head3 Filter before sending data into database : C<filter> option
421
+
422
+If you filter sending data, use C<filter> option.
423
+
424
+    $dbi->execute(
425
+        'insert into book (date) values (:date)',
426
+        {date => $tp},
427
+        filter => {date => 'tp_to_date'}
428
+    );
429
+
430
+You can use C<filter> option in C<insert>, C<update>, C<delete>, C<select> method.
431
+
432
+    $dbi->insert(
433
+        {date => $tp},
434
+        table => 'book',
435
+        filter => {date => 'tp_to_date'}
436
+    );
437
+
438
+=head3 Filter after fetching data from database.
439
+
440
+If you filter fetch data, use L<DBIx::Custom::Result>'s C<filter> method.
441
+
442
+    my $result = $dbi->select(column => 'date', table => 'book');
443
+    $result->filter(date => 'date_to_tp');
444
+    my $row = $result->one;
445
+
446
+=head2 7. Model
447
+
448
+=head3 Model
449
+
450
+you can define model extending L<DBIx::Custom::Model>
451
+to improve source code view.
452
+
453
+At first, you create basic model class extending <DBIx::Custom::Model>.
454
+Each L<DBIx::Custom> class inherit L<Object::Simple>.
455
+so you can inherit the following way.
456
+
457
+    package MyModel;
458
+    use DBIx::Custom::Model -base;
459
+
460
+Next, you create each model classes.
461
+
462
+MyModel::book
463
+
464
+    package MyModel::book;
465
+    use MyModel -base;
466
+    
467
+    sub insert { ... }
468
+    sub list { ... }
469
+
470
+MyModel::company
471
+
472
+    package MyModel::company;
473
+    use MyModel -base;
474
+    
475
+    sub insert { ... }
476
+    sub list { ... }
477
+
478
+The follwoing modules location is needed.
479
+
480
+    MyModel.pm
481
+    MyModel / book.pm
482
+            / company.pm
483
+
484
+You can include these models by C<include_model>
485
+
486
+    $dbi->include_model('MyModel');
487
+
488
+First argument is name space of model.
489
+
490
+You can use model like this.
491
+
492
+    my $result = $dbi->model('book')->list;
493
+
494
+In mode, You can use such as methods,
495
+C<insert>, C<update>, C<update_all>,
496
+C<delete>, C<delete_all>, C<select>
497
+without C<table> option.
498
+
499
+    $dbi->model('book')->insert($param);
500
+
501
+Model is L<DBIx::Custom::Model>.
502
+
503
+If you need table nameAyou can get it by C<table>.
504
+
505
+    my $table = $model->table;
506
+
507
+You can get L<DBIx::Custom>.
508
+
509
+    my $dbi = $model->dbi;
510
+
511
+You can also call all methods of L<DBIx::Custom> and L<DBI>. 
512
+
513
+    # DBIx::Custom method
514
+    $model->execute($sql);
515
+    
516
+    # DBI method
517
+    $model->begin_work;
518
+    $model->commit;
519
+
520
+If you want to get all models, you can get them by keys of C<models>.
521
+
522
+    my @models = keys %{$self->models};
523
+
524
+You can set primary key to model.
525
+
526
+   $model->primary_key(['id', 'number_id']);
527
+
528
+Primary key is used by C<insert>, C<update>, C<delete>,
529
+and C<select> methods.
530
+
531
+You can set column names
532
+
533
+    $model->columns(['id', 'number_id']);
534
+
535
+Column names is automarically set by C<setup_model>.
536
+This method is needed to be call after C<include_model>.
537
+
538
+    $dbi->setup_model;
539
+
540
+You can set C<join>
541
+
542
+    $model->join(['left outer join company on book.company_id = company.id']);
543
+
544
+C<join> is used by C<select> method.
545
+
546
+=head2 Create column clause automatically : mycolumn, column
547
+
548
+To create column clause automatically, use C<mycolumn>.
549
+Valude of C<table> and C<columns> is used.
550
+
551
+    my $mycolumns = $model->mycolumn;
552
+
553
+If C<table> is 'book'AC<column> is ['id', 'name'],
554
+the following clause is created.
555
+
556
+    book.id as id, book.name as name
557
+
558
+These column name is for removing column name ambiguities.
559
+
560
+You can create column clause from columns of other table.
561
+
562
+    my $columns = $model->column('company');
563
+
564
+If C<table> is "company", C<column> return ['id', 'name'],
565
+the following clause is created.
566
+
567
+    company.id as "company.id", company.name as "company.name"
568
+
569
+=head2 Model Examples
570
+
571
+Model examples
572
+
573
+    package MyDBI;
574
+    use DBIx::Custom -base;
575
+    
576
+    sub connect {
577
+        my $self = shift->SUPER::connect(@_);
578
+        
579
+        $self->include_model(
580
+            MyModel => [
581
+                'book',
582
+                'company'
583
+            ]
584
+        );
585
+    }
586
+    
587
+    package MyModel::book;
588
+    use DBIx::Custom::Model -base;
589
+    
590
+    has primary_key => sub { ['id'] };
591
+    
592
+    sub insert { ... }
593
+    sub list { ... }
594
+    
595
+    package MyModel::company;
596
+    use DBIx::Custom::Model -base;
597
+
598
+    has primary_key => sub { ['id'] };
599
+    
600
+    sub insert { ... }
601
+    sub list { ... }
602
+
603
+=cut
+13
DBIx-Custom-0.1711/DBIx-Custom-0.1711/lib/DBIx/Custom/Guide/Ja.pod
... ...
@@ -0,0 +1,13 @@
1
+=encoding utf8
2
+
3
+=head1 NAME
4
+
5
+DBIx::Custom::Guide - DBIx::Customガイド
6
+
7
+=head1 LINK
8
+
9
+ドキュメントは以下のリンクに移動しました。
10
+
11
+L<http://d.hatena.ne.jp/perlcodesample/20110401/1305597081>
12
+
13
+=cut
+116
DBIx-Custom-0.1711/DBIx-Custom-0.1711/lib/DBIx/Custom/Query.pm
... ...
@@ -0,0 +1,116 @@
1
+package DBIx::Custom::Query;
2
+use Object::Simple -base;
3
+
4
+use Carp 'croak';
5
+use DBIx::Custom::Util '_subname';
6
+
7
+has 'sth',
8
+    sql => '',
9
+    columns => sub { [] };
10
+
11
+# DEPRECATED!
12
+has 'default_filter';
13
+sub filters {
14
+    warn "DBIx::Custom::Query filters attribute method is DEPRECATED!";
15
+    my $self = shift;
16
+    if (@_) {
17
+        $self->{filters} = $_[0];
18
+        return $self;
19
+    }
20
+    return $self->{filters};
21
+}
22
+
23
+# DEPRECATED!
24
+sub tables {
25
+    warn "DBIx::Custom::Query tables attribute method is DEPRECATED!";
26
+    my $self = shift;
27
+    if (@_) {
28
+        $self->{tables} = $_[0];
29
+        return $self;
30
+    }
31
+    return $self->{tables} ||= [];
32
+}
33
+
34
+#DEPRECATED!
35
+sub filter {
36
+    Carp::carp "DBIx::Custom::Query filter method is DEPRECATED!";
37
+    my $self = shift;
38
+    if (@_) {
39
+        my $filter = {};
40
+        if (ref $_[0] eq 'HASH') {
41
+            $filter = $_[0];
42
+        }
43
+        else {
44
+            my $ef = @_ > 1 ? [@_] : $_[0];
45
+            for (my $i = 0; $i < @$ef; $i += 2) {
46
+                my $column = $ef->[$i];
47
+                my $f = $ef->[$i + 1];
48
+                if (ref $column eq 'ARRAY') {
49
+                    foreach my $c (@$column) {
50
+                        $filter->{$c} = $f;
51
+                    }
52
+                }
53
+                else {
54
+                    $filter->{$column} = $f;
55
+                }
56
+            }
57
+        }
58
+        foreach my $column (keys %$filter) {
59
+            my $fname = $filter->{$column};
60
+            if  (exists $filter->{$column}
61
+              && defined $fname
62
+              && ref $fname ne 'CODE') 
63
+            {
64
+                my $filters = $self->{filters} || {};
65
+                croak qq{Filter "$fname" is not registered" } . _subname
66
+                  unless exists $filters->{$fname};
67
+                $filter->{$column} = $filters->{$fname};
68
+            }
69
+        }
70
+        $self->{filter} = {%{$self->{filter} || {}}, %$filter};
71
+        return $self;
72
+    }
73
+    return $self->{filter} ||= {};
74
+}
75
+
76
+1;
77
+
78
+=head1 NAME
79
+
80
+DBIx::Custom::Query - Query
81
+
82
+=head1 SYNOPSIS
83
+    
84
+    my $query = DBIx::Custom::Query->new;
85
+    my $sth = $query->sth;
86
+    my $sql = $query->sql;
87
+    my $columns = $query->columns;
88
+    
89
+=head1 ATTRIBUTES
90
+
91
+=head2 C<columns>
92
+
93
+    my $columns = $query->columns;
94
+    $query      = $query->columns(['auhtor', 'title']);
95
+
96
+Column names.
97
+
98
+=head2 C<sql>
99
+
100
+    my $sql = $query->sql;
101
+    $query  = $query->sql('select * from books where author = ?;');
102
+
103
+SQL statement.
104
+
105
+=head2 C<sth>
106
+
107
+    my $sth = $query->sth;
108
+    $query  = $query->sth($sth);
109
+
110
+Statement handle of L<DBI>
111
+
112
+=head1 METHODS
113
+
114
+L<DBIx::Custom::Query> inherits all methods from L<Object::Simple>.
115
+
116
+=cut
+329
DBIx-Custom-0.1711/DBIx-Custom-0.1711/lib/DBIx/Custom/QueryBuilder.pm
... ...
@@ -0,0 +1,329 @@
1
+package DBIx::Custom::QueryBuilder;
2
+
3
+use Object::Simple -base;
4
+
5
+use Carp 'croak';
6
+use DBIx::Custom::Query;
7
+use DBIx::Custom::Util '_subname';
8
+
9
+# Carp trust relationship
10
+push @DBIx::Custom::CARP_NOT, __PACKAGE__;
11
+push @DBIx::Custom::Where::CARP_NOT, __PACKAGE__;
12
+
13
+has 'dbi';
14
+
15
+sub build_query {
16
+    my ($self, $source) = @_;
17
+    
18
+    my $query;
19
+    
20
+    # Parse tag. tag is DEPRECATED!
21
+    if ($self->dbi->tag_parse && $source =~ /(\s|^)\{/) {
22
+        $query = $self->_parse_tag($source);
23
+        my $tag_count = delete $query->{tag_count};
24
+        warn qq/Tag system such as {? name} is DEPRECATED! / .
25
+             qq/use parameter system such as :name instead/
26
+          if $tag_count;
27
+        my $query2 = $self->_parse_parameter($query->sql);
28
+        $query->sql($query2->sql);
29
+        for (my $i =0; $i < @{$query->columns}; $i++) {
30
+            my $column = $query->columns->[$i];
31
+            if ($column eq 'RESERVED_PARAMETER') {
32
+                my $column2 = shift @{$query2->columns};
33
+                croak ":name syntax is wrong"
34
+                  unless defined $column2;
35
+                $query->columns->[$i] = $column2;
36
+            }
37
+        }
38
+    }
39
+    
40
+    # Parse parameter
41
+    else { $query = $self->_parse_parameter($source) }
42
+    
43
+    my $sql = $query->sql;
44
+    $sql .= ';' unless $source =~ /;$/;
45
+    $query->sql($sql);
46
+
47
+    # Check placeholder count
48
+    croak qq{Placeholder count in "$sql" must be same as column count}
49
+        . _subname
50
+      unless $self->_placeholder_count($sql) eq @{$query->columns};
51
+        
52
+    return $query;
53
+}
54
+
55
+sub _placeholder_count {
56
+    my ($self, $sql) = @_;
57
+    
58
+    # Count
59
+    $sql ||= '';
60
+    my $count = 0;
61
+    my $pos   = -1;
62
+    while (($pos = index($sql, '?', $pos + 1)) != -1) {
63
+        $count++;
64
+    }
65
+    return $count;
66
+}
67
+
68
+sub _parse_parameter {
69
+    my ($self, $source) = @_;
70
+    
71
+    # Get and replace parameters
72
+    my $sql = $source || '';
73
+    my $columns = [];
74
+    my $c = $self->dbi->safety_character;
75
+    # Parameter regex
76
+    $sql =~ s/([^:]):(\d+):([^:])/$1\\:$2\\:$3/g;
77
+    my $re = qr/(^|.*?[^\\]):([$c\.]+)(?:\{(.*?)\})?(.*)/s;
78
+    while ($sql =~ /$re/g) {
79
+        push @$columns, $2;
80
+        $sql = defined $3 ? "$1$2 $3 ?$4" : "$1?$4";
81
+    }
82
+    $sql =~ s/\\:/:/g;
83
+
84
+    # Create query
85
+    my $query = DBIx::Custom::Query->new(
86
+        sql => $sql,
87
+        columns => $columns
88
+    );
89
+    
90
+    return $query;
91
+}
92
+    
93
+# DEPRECATED!
94
+has tags => sub { {} };
95
+
96
+# DEPRECATED!
97
+sub register_tag {
98
+    my $self = shift;
99
+    
100
+    warn "register_tag is DEPRECATED!";
101
+    
102
+    # Merge tag
103
+    my $tags = ref $_[0] eq 'HASH' ? $_[0] : {@_};
104
+    $self->tags({%{$self->tags}, %$tags});
105
+    
106
+    return $self;
107
+}
108
+
109
+# DEPRECATED!
110
+sub _parse_tag {
111
+    my ($self, $source) = @_;
112
+    # Source
113
+    $source ||= '';
114
+    # Tree
115
+    my @tree;
116
+    # Value
117
+    my $value = '';
118
+    # State
119
+    my $state = 'text';
120
+    # Before charactor
121
+    my $before = '';
122
+    # Position
123
+    my $pos = 0;
124
+    # Parse
125
+    my $original = $source;
126
+    my $tag_count = 0;
127
+    while (defined(my $c = substr($source, $pos, 1))) {
128
+        # Last
129
+        last unless length $c;
130
+        # Parameter
131
+        if ($c eq ':' && (substr($source, $pos + 1, 1) || '') =~ /\w/) {
132
+            push @tree, {type => 'param'};;
133
+        }
134
+        # State is text
135
+        if ($state eq 'text') {
136
+            # Tag start charactor
137
+            if ($c eq '{') {
138
+                # Escaped charactor
139
+                if ($before eq "\\") {
140
+                    substr($value, -1, 1, '');
141
+                    $value .= $c;
142
+                }
143
+                # Tag start
144
+                else {
145
+                    # Change state
146
+                    $state = 'tag';
147
+                    # Add text
148
+                    push @tree, {type => 'text', value => $value}
149
+                      if $value;
150
+                    # Clear
151
+                    $value = '';
152
+                }
153
+            }
154
+            # Tag end charactor
155
+            elsif ($c eq '}') {
156
+                # Escaped charactor
157
+                if ($before eq "\\") {
158
+                    substr($value, -1, 1, '');
159
+                    $value .= $c;
160
+                }
161
+                # Unexpected
162
+                else {
163
+                    croak qq{Parsing error. unexpected "\}". }
164
+                        . qq{pos $pos of "$original" } . _subname
165
+                }
166
+            }
167
+            # Normal charactor
168
+            else { $value .= $c }
169
+        }
170
+        # State is tags
171
+        else {
172
+            # Tag start charactor
173
+            if ($c eq '{') {
174
+                # Escaped charactor
175
+                if ($before eq "\\") {
176
+                    substr($value, -1, 1, '');
177
+                    $value .= $c;
178
+                }
179
+                # Unexpected
180
+                else {
181
+                    croak qq{Parsing error. unexpected "\{". }
182
+                        . qq{pos $pos of "$original" } . _subname
183
+                }
184
+            }
185
+            # Tag end charactor
186
+            elsif ($c eq '}') {
187
+                # Escaped charactor
188
+                if ($before eq "\\") {
189
+                    substr($value, -1, 1, '');
190
+                    $value .= $c;
191
+                }
192
+                # Tag end
193
+                else {
194
+                    # Change state
195
+                    $state = 'text';
196
+                    # Add tag
197
+                    my ($tag_name, @tag_args) = split /\s+/, $value;
198
+                    push @tree, {type => 'tag', tag_name => $tag_name, 
199
+                                 tag_args => \@tag_args};
200
+                    # Clear
201
+                    $value = '';
202
+                    # Countup
203
+                    $tag_count++;
204
+                }
205
+            }
206
+            # Normal charactor
207
+            else { $value .= $c }
208
+        }
209
+        # Save before charactor
210
+        $before = $c;
211
+        # increment position
212
+        $pos++;
213
+    }
214
+    # Tag not finished
215
+    croak qq{Tag not finished. "$original" } . _subname
216
+      if $state eq 'tag';
217
+    # Not contains tag
218
+    return DBIx::Custom::Query->new(sql => $source, tag_count => $tag_count)
219
+      if $tag_count == 0;
220
+    # Add rest text
221
+    push @tree, {type => 'text', value => $value}
222
+      if $value;
223
+    # SQL
224
+    my $sql = '';
225
+    # All Columns
226
+    my $all_columns = [];
227
+    # Tables
228
+    my $tables = [];
229
+    # Build SQL 
230
+    foreach my $node (@tree) {
231
+        # Text
232
+        if ($node->{type} eq 'text') { $sql .= $node->{value} }
233
+        # Parameter
234
+        elsif ($node->{type} eq 'param') {
235
+            push @$all_columns, 'RESERVED_PARAMETER';
236
+        }
237
+        # Tag
238
+        else {
239
+            # Tag name
240
+            my $tag_name = $node->{tag_name};
241
+            # Tag arguments
242
+            my $tag_args = $node->{tag_args};
243
+            # Table
244
+            if ($tag_name eq 'table') {
245
+                my $table = $tag_args->[0];
246
+                push @$tables, $table;
247
+                $sql .= $table;
248
+                next;
249
+            }
250
+            # Get tag
251
+            my $tag = $self->tag_processors->{$tag_name}
252
+                             || $self->tags->{$tag_name};
253
+            # Tag is not registered
254
+            croak qq{Tag "$tag_name" is not registered } . _subname
255
+              unless $tag;
256
+            # Tag not sub reference
257
+            croak qq{Tag "$tag_name" must be sub reference } . _subname
258
+              unless ref $tag eq 'CODE';
259
+            # Execute tag
260
+            my $r = $tag->(@$tag_args);
261
+            # Check tag return value
262
+            croak qq{Tag "$tag_name" must return [STRING, ARRAY_REFERENCE] }
263
+                . _subname
264
+              unless ref $r eq 'ARRAY' && defined $r->[0] && ref $r->[1] eq 'ARRAY';
265
+            # Part of SQL statement and colum names
266
+            my ($part, $columns) = @$r;
267
+            # Add columns
268
+            push @$all_columns, @$columns;
269
+            # Join part tag to SQL
270
+            $sql .= $part;
271
+        }
272
+    }
273
+    # Query
274
+    my $query = DBIx::Custom::Query->new(
275
+        sql => $sql,
276
+        columns => $all_columns,
277
+        tables => $tables,
278
+        tag_count => $tag_count
279
+    );
280
+    return $query;
281
+}
282
+
283
+# DEPRECATED!
284
+has tag_processors => sub { {} };
285
+
286
+# DEPRECATED!
287
+sub register_tag_processor {
288
+    my $self = shift;
289
+    warn "register_tag_processor is DEPRECATED!";
290
+    # Merge tag
291
+    my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
292
+    $self->tag_processors({%{$self->tag_processors}, %{$tag_processors}});
293
+    return $self;
294
+}
295
+
296
+1;
297
+
298
+=head1 NAME
299
+
300
+DBIx::Custom::QueryBuilder - Query builder
301
+
302
+=head1 SYNOPSIS
303
+    
304
+    my $builder = DBIx::Custom::QueryBuilder->new;
305
+    my $query = $builder->build_query(
306
+        "select from table title = :title and author = :author"
307
+    );
308
+
309
+=head1 ATTRIBUTES
310
+
311
+=head2 C<dbi>
312
+
313
+    my $dbi = $builder->dbi;
314
+    $builder = $builder->dbi($dbi);
315
+
316
+L<DBIx::Custom> object.
317
+
318
+=head1 METHODS
319
+
320
+L<DBIx::Custom::QueryBuilder> inherits all methods from L<Object::Simple>
321
+and implements the following new ones.
322
+
323
+=head2 C<build_query>
324
+    
325
+    my $query = $builder->build_query($source);
326
+
327
+Create a new L<DBIx::Custom::Query> object from SQL source.
328
+
329
+=cut
+41
DBIx-Custom-0.1711/DBIx-Custom-0.1711/lib/DBIx/Custom/Util.pm
... ...
@@ -0,0 +1,41 @@
1
+package DBIx::Custom::Util;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use base 'Exporter';
7
+
8
+our @EXPORT_OK = qw/_array_to_hash _subname/;
9
+
10
+sub _array_to_hash {
11
+    my $array = shift;
12
+    
13
+    return $array if ref $array eq 'HASH';
14
+    return unless $array;
15
+    
16
+    my $hash = {};
17
+    
18
+    for (my $i = 0; $i < @$array; $i += 2) {
19
+        my $key = $array->[$i];
20
+        my $f = $array->[$i + 1];
21
+        
22
+        if (ref $key eq 'ARRAY') {
23
+            foreach my $k (@$key) {
24
+                $hash->{$k} = $f;
25
+            }
26
+        }
27
+        else {
28
+            $hash->{$key} = $f;
29
+        }
30
+    }
31
+    return $hash;
32
+}
33
+
34
+sub _subname { '(' . (caller 1)[3] . ')' }
35
+
36
+1;
37
+
38
+=head1 NAME
39
+
40
+DBIx::Custom::Util - Utility class
41
+
+11
DBIx-Custom-0.1711/DBIx-Custom-0.1711/t/basic-quote.t
... ...
@@ -0,0 +1,11 @@
1
+# Change quote for tests
2
+use DBIx::Custom;
3
+{
4
+    package DBIx::Custom;
5
+    no warnings 'redefine';
6
+    sub quote { '""' }
7
+}
8
+
9
+use FindBin;
10
+
11
+require "$FindBin::Bin/basic.t";
+19
DBIx-Custom-0.1711/DBIx-Custom-0.1711/t/basic/MyDBI1.pm
... ...
@@ -0,0 +1,19 @@
1
+package MyDBI1;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use base 'DBIx::Custom';
7
+
8
+sub connect {
9
+    my $self = shift->SUPER::connect(@_);
10
+    
11
+    $self->include_model(
12
+        MyModel1 => [
13
+            'book',
14
+            {class => 'Company', name => 'company'}
15
+        ]
16
+    );
17
+}
18
+
19
+1;
+13
DBIx-Custom-0.1711/DBIx-Custom-0.1711/t/basic/MyModel1/book.pm
... ...
@@ -0,0 +1,13 @@
1
+package MyModel1::book;
2
+
3
+use DBIx::Custom::Model -base;
4
+
5
+sub insert {
6
+    my ($self, $param) = @_;
7
+    
8
+    return $self->SUPER::insert(param => $param);
9
+}
10
+
11
+sub list { shift->select; }
12
+
13
+1;
+8
DBIx-Custom-0.1711/DBIx-Custom-0.1711/t/basic/MyModel4/company.pm
... ...
@@ -0,0 +1,8 @@
1
+package MyModel4::company;
2
+
3
+use base 'MyModel4';
4
+
5
+sub insert { shift->SUPER::insert(param => $_[0]) }
6
+sub list { shift->select }
7
+
8
+1;
+5
DBIx-Custom-0.1711/DBIx-Custom-0.1711/t/basic/MyModel5.pm
... ...
@@ -0,0 +1,5 @@
1
+package MyModel5;
2
+
3
+use base 'DBIx::Custom::Model';
4
+
5
+1;
+7
DBIx-Custom-0.1711/DBIx-Custom-0.1711/t/basic/MyModel5/table1.pm
... ...
@@ -0,0 +1,7 @@
1
+package MyModel5::table1;
2
+
3
+use MyModel5 -base;
4
+
5
+has primary_key => sub { ['key1', 'key2'] };
6
+
7
+1;
+12
DBIx-Custom-0.1711/DBIx-Custom-0.1711/t/basic/MyModel5/table1_1.pm
... ...
@@ -0,0 +1,12 @@
1
+package MyModel5::table1_1;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use base 'MyModel5';
7
+
8
+__PACKAGE__->attr(table => 'table2');
9
+
10
+__PACKAGE__->attr('primary_key' => sub { ['key1', 'key2'] });
11
+
12
+1;
+5
DBIx-Custom-0.1711/DBIx-Custom-0.1711/t/basic/MyModel6.pm
... ...
@@ -0,0 +1,5 @@
1
+package MyModel6;
2
+
3
+use base 'DBIx::Custom::Model';
4
+
5
+1;
+14
DBIx-Custom-0.1711/DBIx-Custom-0.1711/t/basic/MyModel6/table1.pm
... ...
@@ -0,0 +1,14 @@
1
+package MyModel6::table1;
2
+
3
+use base 'MyModel6';
4
+
5
+__PACKAGE__->attr(
6
+    join => sub {
7
+        [
8
+            'left outer join table2 on table1.key1 = table2.key1'
9
+        ]
10
+    },
11
+    primary_key => sub { ['key1'] }
12
+);
13
+
14
+1;
+5
DBIx-Custom-0.1711/DBIx-Custom-0.1711/t/basic/MyModel7.pm
... ...
@@ -0,0 +1,5 @@
1
+package MyModel7;
2
+
3
+use base 'DBIx::Custom::Model';
4
+
5
+1;
+14
DBIx-Custom-0.1711/DBIx-Custom-0.1711/t/basic/MyModel7/table1.pm
... ...
@@ -0,0 +1,14 @@
1
+package MyModel7::table1;
2
+
3
+use base 'MyModel7';
4
+
5
+__PACKAGE__->attr(
6
+    primary_key => sub { ['key1'] },
7
+    join => sub {
8
+        [
9
+            'left outer join table2 on table1.key1 = table2.key1'
10
+        ]
11
+    },
12
+);
13
+
14
+1;
+5
DBIx-Custom-0.1711/DBIx-Custom-0.1711/t/basic/MyModel7/table2.pm
... ...
@@ -0,0 +1,5 @@
1
+package MyModel7::table2;
2
+
3
+use base 'MyModel7';
4
+
5
+1;
+11
DBIx-Custom-0.1711/DBIx-Custom-0.1711/xt/pod.t
... ...
@@ -0,0 +1,11 @@
1
+
2
+use strict;
3
+use warnings;
4
+use Test::More;
5
+
6
+# Ensure a recent version of Test::Pod
7
+my $min_tp = 1.22;
8
+eval "use Test::Pod $min_tp";
9
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
10
+
11
+all_pod_files_ok();
+22
DBIx-Custom-0.1711/Makefile.PL
... ...
@@ -0,0 +1,22 @@
1
+use strict;
2
+use warnings;
3
+use ExtUtils::MakeMaker;
4
+
5
+WriteMakefile(
6
+    NAME                => 'DBIx::Custom',
7
+    AUTHOR              => 'Yuki Kimoto <kimoto.yuki@gmail.com>',
8
+    VERSION_FROM        => 'lib/DBIx/Custom.pm',
9
+    ABSTRACT_FROM       => 'lib/DBIx/Custom.pm',
10
+    ($ExtUtils::MakeMaker::VERSION >= 6.3002
11
+      ? ('LICENSE'=> 'perl')
12
+      : ()),
13
+    PL_FILES            => {},
14
+      PREREQ_PM => {
15
+        'Test::More' => 0,
16
+        'Object::Simple' => 3.0621,
17
+        'DBD::SQLite' => '1.25',
18
+        'DBI' => '1.605'
19
+    },
20
+    dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
21
+    clean               => { FILES => 'DBIx-Custom-*' },
22
+);
+15
DBIx-Custom-0.1711/README
... ...
@@ -0,0 +1,15 @@
1
+DBIx-Custom
2
+
3
+DBI interface, having hash parameter binding and filtering system
4
+
5
+INSTALLATION
6
+
7
+cpan DBIx::Custom
8
+
9
+COPYRIGHT AND LICENCE
10
+
11
+Copyright (C) 2009 Yuki Kimoto
12
+
13
+This program is free software; you can redistribute it and/or modify it
14
+under the same terms as Perl itself.
15
+
DBIx-Custom-0.1711/blib/arch/.exists
No changes.
DBIx-Custom-0.1711/blib/arch/auto/DBIx/Custom/.exists
No changes.
DBIx-Custom-0.1711/blib/bin/.exists
No changes.
DBIx-Custom-0.1711/blib/lib/DBIx/.exists
No changes.
+3203
DBIx-Custom-0.1711/blib/lib/DBIx/Custom.pm
... ...
@@ -0,0 +1,3203 @@
1
+package DBIx::Custom;
2
+use Object::Simple -base;
3
+
4
+our $VERSION = '0.1711';
5
+use 5.008001;
6
+
7
+use Carp 'croak';
8
+use DBI;
9
+use DBIx::Custom::Result;
10
+use DBIx::Custom::Query;
11
+use DBIx::Custom::QueryBuilder;
12
+use DBIx::Custom::Where;
13
+use DBIx::Custom::Model;
14
+use DBIx::Custom::Tag;
15
+use DBIx::Custom::Order;
16
+use DBIx::Custom::Util qw/_array_to_hash _subname/;
17
+use Encode qw/encode encode_utf8 decode_utf8/;
18
+
19
+use constant DEBUG => $ENV{DBIX_CUSTOM_DEBUG} || 0;
20
+use constant DEBUG_ENCODING => $ENV{DBIX_CUSTOM_DEBUG_ENCODING} || 'UTF-8';
21
+
22
+has [qw/connector dsn password quote user/],
23
+    cache => 0,
24
+    cache_method => sub {
25
+        sub {
26
+            my $self = shift;
27
+            
28
+            $self->{_cached} ||= {};
29
+            
30
+            if (@_ > 1) {
31
+                $self->{_cached}{$_[0]} = $_[1];
32
+            }
33
+            else {
34
+                return $self->{_cached}{$_[0]};
35
+            }
36
+        }
37
+    },
38
+    dbi_option => sub { {} },
39
+    default_dbi_option => sub {
40
+        {
41
+            RaiseError => 1,
42
+            PrintError => 0,
43
+            AutoCommit => 1
44
+        }
45
+    },
46
+    filters => sub {
47
+        {
48
+            encode_utf8 => sub { encode_utf8($_[0]) },
49
+            decode_utf8 => sub { decode_utf8($_[0]) }
50
+        }
51
+    },
52
+    last_sql => '',
53
+    models => sub { {} },
54
+    query_builder => sub { DBIx::Custom::QueryBuilder->new(dbi => shift) },
55
+    result_class  => 'DBIx::Custom::Result',
56
+    safety_character => '\w',
57
+    stash => sub { {} },
58
+    tag_parse => 1;
59
+
60
+our $AUTOLOAD;
61
+sub AUTOLOAD {
62
+    my $self = shift;
63
+
64
+    # Method name
65
+    my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
66
+
67
+    # Call method
68
+    $self->{_methods} ||= {};
69
+    if (my $method = $self->{_methods}->{$mname}) {
70
+        return $self->$method(@_)
71
+    }
72
+    elsif ($self->{dbh} && (my $dbh_method = $self->dbh->can($mname))) {
73
+        $self->dbh->$dbh_method(@_);
74
+    }
75
+    else {
76
+        croak qq{Can't locate object method "$mname" via "$package" }
77
+            . _subname;
78
+    }
79
+}
80
+
81
+sub assign_param {
82
+    my ($self, $param) = @_;
83
+    
84
+    # Create set tag
85
+    my @params;
86
+    my $safety = $self->safety_character;
87
+    foreach my $column (sort keys %$param) {
88
+        croak qq{"$column" is not safety column name } . _subname
89
+          unless $column =~ /^[$safety\.]+$/;
90
+        my $column_quote = $self->_q($column);
91
+        $column_quote =~ s/\./$self->_q(".")/e;
92
+        push @params, ref $param->{$column} eq 'SCALAR'
93
+          ? "$column_quote = " . ${$param->{$column}}
94
+          : "$column_quote = :$column";
95
+
96
+    }
97
+    my $tag = join(', ', @params);
98
+    
99
+    return $tag;
100
+}
101
+
102
+sub column {
103
+    my $self = shift;
104
+    my $option = pop if ref $_[-1] eq 'HASH';
105
+    my $real_table = shift;
106
+    my $columns = shift;
107
+    my $table = $option->{alias} || $real_table;
108
+    
109
+    # Columns
110
+    unless ($columns) {
111
+        $columns ||= $self->model($real_table)->columns;
112
+    }
113
+    
114
+    # Separator
115
+    my $separator = $self->separator;
116
+    
117
+    # Column clause
118
+    my @column;
119
+    $columns ||= [];
120
+    push @column, $self->_q($table) . "." . $self->_q($_) .
121
+      " as " . $self->_q("${table}${separator}$_")
122
+      for @$columns;
123
+    
124
+    return join (', ', @column);
125
+}
126
+
127
+sub connect {
128
+    my $self = ref $_[0] ? shift : shift->new(@_);;
129
+    
130
+    # Connect
131
+    $self->dbh;
132
+    
133
+    return $self;
134
+}
135
+
136
+sub dbh {
137
+    my $self = shift;
138
+    
139
+    # Set
140
+    if (@_) {
141
+        $self->{dbh} = $_[0];
142
+        
143
+        return $self;
144
+    }
145
+    
146
+    # Get
147
+    else {
148
+        # From Connction manager
149
+        if (my $connector = $self->connector) {
150
+            croak "connector must have dbh() method " . _subname
151
+              unless ref $connector && $connector->can('dbh');
152
+              
153
+            $self->{dbh} = $connector->dbh;
154
+        }
155
+        
156
+        # Connect
157
+        $self->{dbh} ||= $self->_connect;
158
+        
159
+        # Quote
160
+        if (!defined $self->reserved_word_quote && !defined $self->quote) {
161
+            my $driver = $self->{dbh}->{Driver}->{Name};
162
+            my $quote = $driver eq 'mysql' ? '`' : '"';
163
+            $self->quote($quote);
164
+        }
165
+        
166
+        return $self->{dbh};
167
+    }
168
+}
169
+
170
+sub delete {
171
+    my ($self, %args) = @_;
172
+
173
+    # Arguments
174
+    my $table = $args{table} || '';
175
+    croak qq{"table" option must be specified. } . _subname
176
+      unless $table;
177
+    my $where            = delete $args{where} || {};
178
+    my $append           = delete $args{append};
179
+    my $allow_delete_all = delete $args{allow_delete_all};
180
+    my $where_param      = delete $args{where_param} || {};
181
+    my $id = delete $args{id};
182
+    my $primary_key = delete $args{primary_key};
183
+    croak "update method primary_key option " .
184
+          "must be specified when id is specified " . _subname
185
+      if defined $id && !defined $primary_key;
186
+    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
187
+    my $prefix = delete $args{prefix};
188
+    
189
+    # Where
190
+    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
191
+    my $where_clause = '';
192
+    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
193
+        $where_clause = "where " . $where->[0];
194
+        $where_param = $where->[1];
195
+    }
196
+    elsif (ref $where) {
197
+        $where = $self->_where_to_obj($where);
198
+        $where_param = keys %$where_param
199
+                     ? $self->merge_param($where_param, $where->param)
200
+                     : $where->param;
201
+        
202
+        # String where
203
+        $where_clause = $where->to_string;
204
+    }
205
+    elsif ($where) { $where_clause = "where $where" }
206
+    croak qq{"where" must be specified } . _subname
207
+      if $where_clause eq '' && !$allow_delete_all;
208
+
209
+    # Delete statement
210
+    my @sql;
211
+    push @sql, "delete";
212
+    push @sql, $prefix if defined $prefix;
213
+    push @sql, "from " . $self->_q($table) . " $where_clause";
214
+    push @sql, $append if defined $append;
215
+    my $sql = join(' ', @sql);
216
+    
217
+    # Execute query
218
+    return $self->execute($sql, $where_param, table => $table, %args);
219
+}
220
+
221
+sub delete_all { shift->delete(allow_delete_all => 1, @_) }
222
+
223
+sub DESTROY { }
224
+
225
+sub create_model {
226
+    my $self = shift;
227
+    
228
+    # Arguments
229
+    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
230
+    $args->{dbi} = $self;
231
+    my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
232
+    my $model_name  = delete $args->{name};
233
+    my $model_table = delete $args->{table};
234
+    $model_name ||= $model_table;
235
+    
236
+    # Create model
237
+    my $model = $model_class->new($args);
238
+    $model->name($model_name) unless $model->name;
239
+    $model->table($model_table) unless $model->table;
240
+    
241
+    # Apply filter(DEPRECATED logic)
242
+    if ($model->{filter}) {
243
+        my $filter = ref $model->filter eq 'HASH'
244
+                   ? [%{$model->filter}]
245
+                   : $model->filter;
246
+        $filter ||= [];
247
+        warn "DBIx::Custom::Model filter method is DEPRECATED!"
248
+          if @$filter;
249
+        $self->_apply_filter($model->table, @$filter);
250
+    }
251
+    
252
+    # Set model
253
+    $self->model($model->name, $model);
254
+    
255
+    return $self->model($model->name);
256
+}
257
+
258
+sub each_column {
259
+    my ($self, $cb) = @_;
260
+    
261
+    # Iterate all tables
262
+    my $sth_tables = $self->dbh->table_info;
263
+    while (my $table_info = $sth_tables->fetchrow_hashref) {
264
+        
265
+        # Table
266
+        my $table = $table_info->{TABLE_NAME};
267
+        
268
+        # Iterate all columns
269
+        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
270
+        while (my $column_info = $sth_columns->fetchrow_hashref) {
271
+            my $column = $column_info->{COLUMN_NAME};
272
+            $self->$cb($table, $column, $column_info);
273
+        }
274
+    }
275
+}
276
+
277
+sub each_table {
278
+    my ($self, $cb) = @_;
279
+    
280
+    # Iterate all tables
281
+    my $sth_tables = $self->dbh->table_info;
282
+    while (my $table_info = $sth_tables->fetchrow_hashref) {
283
+        
284
+        # Table
285
+        my $table = $table_info->{TABLE_NAME};
286
+        $self->$cb($table, $table_info);
287
+    }
288
+}
289
+
290
+our %VALID_ARGS = map { $_ => 1 } qw/append allow_delete_all
291
+  allow_update_all bind_type column filter id join param prefix primary_key
292
+  query relation table table_alias type type_rule_off type_rule1_off
293
+  type_rule2_off wrap/;
294
+
295
+sub execute {
296
+    my $self = shift;
297
+    my $query = shift;
298
+    my $param;
299
+    $param = shift if @_ % 2;
300
+    my %args = @_;
301
+    
302
+    # Arguments
303
+    my $p = delete $args{param} || {};
304
+    $param ||= $p;
305
+    my $tables = delete $args{table} || [];
306
+    $tables = [$tables] unless ref $tables eq 'ARRAY';
307
+    my $filter = delete $args{filter};
308
+    $filter = _array_to_hash($filter);
309
+    my $bind_type = delete $args{bind_type} || delete $args{type};
310
+    $bind_type = _array_to_hash($bind_type);
311
+    my $type_rule_off = delete $args{type_rule_off};
312
+    my $type_rule_off_parts = {
313
+        1 => delete $args{type_rule1_off},
314
+        2 => delete $args{type_rule2_off}
315
+    };
316
+    my $query_return = delete $args{query};
317
+    my $table_alias = delete $args{table_alias} || {};
318
+    
319
+    # Check argument names
320
+    foreach my $name (keys %args) {
321
+        croak qq{"$name" is wrong option } . _subname
322
+          unless $VALID_ARGS{$name};
323
+    }
324
+    
325
+    # Create query
326
+    $query = $self->_create_query($query) unless ref $query;
327
+    
328
+    # Save query
329
+    $self->last_sql($query->sql);
330
+
331
+    return $query if $query_return;
332
+    
333
+    # DEPRECATED! Merge query filter
334
+    $filter ||= $query->{filter} || {};
335
+    
336
+    # Tables
337
+    unshift @$tables, @{$query->{tables} || []};
338
+    my $main_table = @{$tables}[-1];
339
+    
340
+    # DEPRECATED! Cleanup tables
341
+    $tables = $self->_remove_duplicate_table($tables, $main_table)
342
+      if @$tables > 1;
343
+    
344
+    # Type rule
345
+    my $type_filters = {};
346
+    unless ($type_rule_off) {
347
+        foreach my $i (1, 2) {
348
+            unless ($type_rule_off_parts->{$i}) {
349
+                $type_filters->{$i} = {};
350
+                foreach my $alias (keys %$table_alias) {
351
+                    my $table = $table_alias->{$alias};
352
+                    
353
+                    foreach my $column (keys %{$self->{"_into$i"}{key}{$table} || {}}) {
354
+                        $type_filters->{$i}->{"$alias.$column"} = $self->{"_into$i"}{key}{$table}{$column};
355
+                    }
356
+                }
357
+                $type_filters->{$i} = {%{$type_filters->{$i}}, %{$self->{"_into$i"}{key}{$main_table} || {}}}
358
+                  if $main_table;
359
+            }
360
+        }
361
+    }
362
+    
363
+    # DEPRECATED! Applied filter
364
+    if ($self->{filter}{on}) {
365
+        my $applied_filter = {};
366
+        foreach my $table (@$tables) {
367
+            $applied_filter = {
368
+                %$applied_filter,
369
+                %{$self->{filter}{out}->{$table} || {}}
370
+            }
371
+        }
372
+        $filter = {%$applied_filter, %$filter};
373
+    }
374
+    
375
+    # Replace filter name to code
376
+    foreach my $column (keys %$filter) {
377
+        my $name = $filter->{$column};
378
+        if (!defined $name) {
379
+            $filter->{$column} = undef;
380
+        }
381
+        elsif (ref $name ne 'CODE') {
382
+          croak qq{Filter "$name" is not registered" } . _subname
383
+            unless exists $self->filters->{$name};
384
+          $filter->{$column} = $self->filters->{$name};
385
+        }
386
+    }
387
+    
388
+    # Create bind values
389
+    my $bind = $self->_create_bind_values(
390
+        $param,
391
+        $query->columns,
392
+        $filter,
393
+        $type_filters,
394
+        $bind_type
395
+    );
396
+    
397
+    # Execute
398
+    my $sth = $query->sth;
399
+    my $affected;
400
+    eval {
401
+        for (my $i = 0; $i < @$bind; $i++) {
402
+            my $bind_type = $bind->[$i]->{bind_type};
403
+            $sth->bind_param(
404
+                $i + 1,
405
+                $bind->[$i]->{value},
406
+                $bind_type ? $bind_type : ()
407
+            );
408
+        }
409
+        $affected = $sth->execute;
410
+    };
411
+    
412
+    $self->_croak($@, qq{. Following SQL is executed.\n}
413
+      . qq{$query->{sql}\n} . _subname) if $@;
414
+    
415
+    # DEBUG message
416
+    if (DEBUG) {
417
+        print STDERR "SQL:\n" . $query->sql . "\n";
418
+        my @output;
419
+        foreach my $b (@$bind) {
420
+            my $value = $b->{value};
421
+            $value = 'undef' unless defined $value;
422
+            $value = encode(DEBUG_ENCODING(), $value)
423
+              if utf8::is_utf8($value);
424
+            push @output, $value;
425
+        }
426
+        print STDERR "Bind values: " . join(', ', @output) . "\n\n";
427
+    }
428
+    
429
+    # Select statement
430
+    if ($sth->{NUM_OF_FIELDS}) {
431
+        
432
+        # DEPRECATED! Filter
433
+        my $filter = {};
434
+        if ($self->{filter}{on}) {
435
+            $filter->{in}  = {};
436
+            $filter->{end} = {};
437
+            push @$tables, $main_table if $main_table;
438
+            foreach my $table (@$tables) {
439
+                foreach my $way (qw/in end/) {
440
+                    $filter->{$way} = {
441
+                        %{$filter->{$way}},
442
+                        %{$self->{filter}{$way}{$table} || {}}
443
+                    };
444
+                }
445
+            }
446
+        }
447
+        
448
+        # Result
449
+        my $result = $self->result_class->new(
450
+            sth => $sth,
451
+            dbi => $self,
452
+            default_filter => $self->{default_in_filter},
453
+            filter => $filter->{in} || {},
454
+            end_filter => $filter->{end} || {},
455
+            type_rule => {
456
+                from1 => $self->type_rule->{from1},
457
+                from2 => $self->type_rule->{from2}
458
+            },
459
+        );
460
+
461
+        return $result;
462
+    }
463
+    
464
+    # Not select statement
465
+    else { return $affected }
466
+}
467
+
468
+sub insert {
469
+    my $self = shift;
470
+    
471
+    # Arguments
472
+    my $param;
473
+    $param = shift if @_ % 2;
474
+    my %args = @_;
475
+    my $table  = delete $args{table};
476
+    croak qq{"table" option must be specified } . _subname
477
+      unless defined $table;
478
+    my $p = delete $args{param} || {};
479
+    $param  ||= $p;
480
+    my $append = delete $args{append} || '';
481
+    my $id = delete $args{id};
482
+    my $primary_key = delete $args{primary_key};
483
+    croak "insert method primary_key option " .
484
+          "must be specified when id is specified " . _subname
485
+      if defined $id && !defined $primary_key;
486
+    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
487
+    my $prefix = delete $args{prefix};
488
+
489
+    # Merge parameter
490
+    if (defined $id) {
491
+        my $id_param = $self->_create_param_from_id($id, $primary_key);
492
+        $param = $self->merge_param($id_param, $param);
493
+    }
494
+
495
+    # Insert statement
496
+    my @sql;
497
+    push @sql, "insert";
498
+    push @sql, $prefix if defined $prefix;
499
+    push @sql, "into " . $self->_q($table) . " " . $self->insert_param($param);
500
+    push @sql, $append if defined $append;
501
+    my $sql = join (' ', @sql);
502
+    
503
+    # Execute query
504
+    return $self->execute($sql, $param, table => $table, %args);
505
+}
506
+
507
+sub insert_param {
508
+    my ($self, $param) = @_;
509
+    
510
+    # Create insert parameter tag
511
+    my $safety = $self->safety_character;
512
+    my @columns;
513
+    my @placeholders;
514
+    foreach my $column (sort keys %$param) {
515
+        croak qq{"$column" is not safety column name } . _subname
516
+          unless $column =~ /^[$safety\.]+$/;
517
+        my $column_quote = $self->_q($column);
518
+        $column_quote =~ s/\./$self->_q(".")/e;
519
+        push @columns, $column_quote;
520
+        push @placeholders, ref $param->{$column} eq 'SCALAR'
521
+          ? ${$param->{$column}} : ":$column";
522
+    }
523
+    
524
+    return '(' . join(', ', @columns) . ') ' . 'values ' .
525
+           '(' . join(', ', @placeholders) . ')'
526
+}
527
+
528
+sub include_model {
529
+    my ($self, $name_space, $model_infos) = @_;
530
+    
531
+    # Name space
532
+    $name_space ||= '';
533
+    
534
+    # Get Model infomations
535
+    unless ($model_infos) {
536
+
537
+        # Load name space module
538
+        croak qq{"$name_space" is invalid class name } . _subname
539
+          if $name_space =~ /[^\w:]/;
540
+        eval "use $name_space";
541
+        croak qq{Name space module "$name_space.pm" is needed. $@ }
542
+            . _subname
543
+          if $@;
544
+        
545
+        # Search model modules
546
+        my $path = $INC{"$name_space.pm"};
547
+        $path =~ s/\.pm$//;
548
+        opendir my $dh, $path
549
+          or croak qq{Can't open directory "$path": $! } . _subname
550
+        $model_infos = [];
551
+        while (my $module = readdir $dh) {
552
+            push @$model_infos, $module
553
+              if $module =~ s/\.pm$//;
554
+        }
555
+        close $dh;
556
+    }
557
+    
558
+    # Include models
559
+    foreach my $model_info (@$model_infos) {
560
+        
561
+        # Load model
562
+        my $model_class;
563
+        my $model_name;
564
+        my $model_table;
565
+        if (ref $model_info eq 'HASH') {
566
+            $model_class = $model_info->{class};
567
+            $model_name  = $model_info->{name};
568
+            $model_table = $model_info->{table};
569
+            
570
+            $model_name  ||= $model_class;
571
+            $model_table ||= $model_name;
572
+        }
573
+        else { $model_class = $model_name = $model_table = $model_info }
574
+        my $mclass = "${name_space}::$model_class";
575
+        croak qq{"$mclass" is invalid class name } . _subname
576
+          if $mclass =~ /[^\w:]/;
577
+        unless ($mclass->can('isa')) {
578
+            eval "use $mclass";
579
+            croak "$@ " . _subname if $@;
580
+        }
581
+        
582
+        # Create model
583
+        my $args = {};
584
+        $args->{model_class} = $mclass if $mclass;
585
+        $args->{name}        = $model_name if $model_name;
586
+        $args->{table}       = $model_table if $model_table;
587
+        $self->create_model($args);
588
+    }
589
+    
590
+    return $self;
591
+}
592
+
593
+sub map_param {
594
+    my $self = shift;
595
+    my $param = shift;
596
+    my %map = @_;
597
+    
598
+    # Mapping
599
+    my $map_param = {};
600
+    foreach my $key (keys %map) {
601
+        my $value_cb;
602
+        my $condition;
603
+        my $map_key;
604
+        
605
+        # Get mapping information
606
+        if (ref $map{$key} eq 'ARRAY') {
607
+            foreach my $some (@{$map{$key}}) {
608
+                $map_key = $some unless ref $some;
609
+                $condition = $some->{if} if ref $some eq 'HASH';
610
+                $value_cb = $some if ref $some eq 'CODE';
611
+            }
612
+        }
613
+        else {
614
+            $map_key = $map{$key};
615
+        }
616
+        $value_cb ||= sub { $_[0] };
617
+        $condition ||= sub { defined $_[0] && length $_[0] };
618
+
619
+        # Map parameter
620
+        my $value;
621
+        if (ref $condition eq 'CODE') {
622
+            $map_param->{$map_key} = $value_cb->($param->{$key})
623
+              if $condition->($param->{$key});
624
+        }
625
+        elsif ($condition eq 'exists') {
626
+            $map_param->{$map_key} = $value_cb->($param->{$key})
627
+              if exists $param->{$key};
628
+        }
629
+        else { croak qq/Condition must be code reference or "exists" / . _subname }
630
+    }
631
+    
632
+    return $map_param;
633
+}
634
+
635
+sub merge_param {
636
+    my ($self, @params) = @_;
637
+    
638
+    # Merge parameters
639
+    my $merge = {};
640
+    foreach my $param (@params) {
641
+        foreach my $column (keys %$param) {
642
+            my $param_is_array = ref $param->{$column} eq 'ARRAY' ? 1 : 0;
643
+            
644
+            if (exists $merge->{$column}) {
645
+                $merge->{$column} = [$merge->{$column}]
646
+                  unless ref $merge->{$column} eq 'ARRAY';
647
+                push @{$merge->{$column}},
648
+                  ref $param->{$column} ? @{$param->{$column}} : $param->{$column};
649
+            }
650
+            else {
651
+                $merge->{$column} = $param->{$column};
652
+            }
653
+        }
654
+    }
655
+    
656
+    return $merge;
657
+}
658
+
659
+sub method {
660
+    my $self = shift;
661
+    
662
+    # Register method
663
+    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
664
+    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
665
+    
666
+    return $self;
667
+}
668
+
669
+sub model {
670
+    my ($self, $name, $model) = @_;
671
+    
672
+    # Set model
673
+    if ($model) {
674
+        $self->models->{$name} = $model;
675
+        return $self;
676
+    }
677
+    
678
+    # Check model existance
679
+    croak qq{Model "$name" is not included } . _subname
680
+      unless $self->models->{$name};
681
+    
682
+    # Get model
683
+    return $self->models->{$name};
684
+}
685
+
686
+sub mycolumn {
687
+    my ($self, $table, $columns) = @_;
688
+    
689
+    # Create column clause
690
+    my @column;
691
+    $columns ||= [];
692
+    push @column, $self->_q($table) . "." . $self->_q($_) .
693
+      " as " . $self->_q($_)
694
+      for @$columns;
695
+    
696
+    return join (', ', @column);
697
+}
698
+
699
+sub new {
700
+    my $self = shift->SUPER::new(@_);
701
+    
702
+    # Check attributes
703
+    my @attrs = keys %$self;
704
+    foreach my $attr (@attrs) {
705
+        croak qq{"$attr" is wrong name } . _subname
706
+          unless $self->can($attr);
707
+    }
708
+    
709
+    # DEPRECATED!
710
+    $self->query_builder->{tags} = {
711
+        '?'     => \&DBIx::Custom::Tag::placeholder,
712
+        '='     => \&DBIx::Custom::Tag::equal,
713
+        '<>'    => \&DBIx::Custom::Tag::not_equal,
714
+        '>'     => \&DBIx::Custom::Tag::greater_than,
715
+        '<'     => \&DBIx::Custom::Tag::lower_than,
716
+        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
717
+        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
718
+        'like'  => \&DBIx::Custom::Tag::like,
719
+        'in'    => \&DBIx::Custom::Tag::in,
720
+        'insert_param' => \&DBIx::Custom::Tag::insert_param,
721
+        'update_param' => \&DBIx::Custom::Tag::update_param
722
+    };
723
+    
724
+    return $self;
725
+}
726
+
727
+sub not_exists { bless {}, 'DBIx::Custom::NotExists' }
728
+
729
+sub order {
730
+    my $self = shift;
731
+    return DBIx::Custom::Order->new(dbi => $self, @_);
732
+}
733
+
734
+sub register_filter {
735
+    my $self = shift;
736
+    
737
+    # Register filter
738
+    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
739
+    $self->filters({%{$self->filters}, %$filters});
740
+    
741
+    return $self;
742
+}
743
+
744
+sub select {
745
+    my ($self, %args) = @_;
746
+
747
+    # Arguments
748
+    my $table = delete $args{table};
749
+    my $tables = ref $table eq 'ARRAY' ? $table
750
+               : defined $table ? [$table]
751
+               : [];
752
+    my $columns   = delete $args{column};
753
+    my $where     = delete $args{where} || {};
754
+    my $append    = delete $args{append};
755
+    my $join      = delete $args{join} || [];
756
+    croak qq{"join" must be array reference } . _subname
757
+      unless ref $join eq 'ARRAY';
758
+    my $relation = delete $args{relation};
759
+    warn "select() relation option is DEPRECATED!"
760
+      if $relation;
761
+    my $param = delete $args{param} || {}; # DEPRECATED!
762
+    warn "select() param option is DEPRECATED!"
763
+      if keys %$param;
764
+    my $where_param = delete $args{where_param} || $param || {};
765
+    my $wrap = delete $args{wrap};
766
+    my $id = delete $args{id};
767
+    my $primary_key = delete $args{primary_key};
768
+    croak "update method primary_key option " .
769
+          "must be specified when id is specified " . _subname
770
+      if defined $id && !defined $primary_key;
771
+    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
772
+    my $prefix = delete $args{prefix};
773
+    
774
+    # Add relation tables(DEPRECATED!);
775
+    $self->_add_relation_table($tables, $relation);
776
+    
777
+    # Select statement
778
+    my @sql;
779
+    push @sql, 'select';
780
+    
781
+    # Prefix
782
+    push @sql, $prefix if defined $prefix;
783
+    
784
+    # Column clause
785
+    if ($columns) {
786
+        $columns = [$columns] unless ref $columns eq 'ARRAY';
787
+        foreach my $column (@$columns) {
788
+            if (ref $column eq 'HASH') {
789
+                $column = $self->column(%$column) if ref $column eq 'HASH';
790
+            }
791
+            elsif (ref $column eq 'ARRAY') {
792
+                if (@$column == 3 && $column->[1] eq 'as') {
793
+                    warn "[COLUMN, as => ALIAS] is DEPRECATED! use [COLUMN => ALIAS]";
794
+                    splice @$column, 1, 1;
795
+                }
796
+                
797
+                $column = join(' ', $column->[0], 'as', $self->_q($column->[1]));
798
+            }
799
+            unshift @$tables, @{$self->_search_tables($column)};
800
+            push @sql, ($column, ',');
801
+        }
802
+        pop @sql if $sql[-1] eq ',';
803
+    }
804
+    else { push @sql, '*' }
805
+    
806
+    # Table
807
+    push @sql, 'from';
808
+    if ($relation) {
809
+        my $found = {};
810
+        foreach my $table (@$tables) {
811
+            push @sql, ($self->_q($table), ',') unless $found->{$table};
812
+            $found->{$table} = 1;
813
+        }
814
+    }
815
+    else {
816
+        my $main_table = $tables->[-1] || '';
817
+        push @sql, $self->_q($main_table);
818
+    }
819
+    pop @sql if ($sql[-1] || '') eq ',';
820
+    croak "Not found table name " . _subname
821
+      unless $tables->[-1];
822
+
823
+    # Add tables in parameter
824
+    unshift @$tables,
825
+            @{$self->_search_tables(join(' ', keys %$where_param) || '')};
826
+    
827
+    # Where
828
+    my $where_clause = '';
829
+    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
830
+    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
831
+        $where_clause = "where " . $where->[0];
832
+        $where_param = $where->[1];
833
+    }
834
+    elsif (ref $where) {
835
+        $where = $self->_where_to_obj($where);
836
+        $where_param = keys %$where_param
837
+                     ? $self->merge_param($where_param, $where->param)
838
+                     : $where->param;
839
+        
840
+        # String where
841
+        $where_clause = $where->to_string;
842
+    }
843
+    elsif ($where) { $where_clause = "where $where" }
844
+    
845
+    # Add table names in where clause
846
+    unshift @$tables, @{$self->_search_tables($where_clause)};
847
+    
848
+    # Push join
849
+    $self->_push_join(\@sql, $join, $tables);
850
+    
851
+    # Add where clause
852
+    push @sql, $where_clause;
853
+    
854
+    # Relation(DEPRECATED!);
855
+    $self->_push_relation(\@sql, $tables, $relation, $where_clause eq '' ? 1 : 0);
856
+    
857
+    # Append
858
+    push @sql, $append if defined $append;
859
+    
860
+    # Wrap
861
+    if ($wrap) {
862
+        croak "wrap option must be array refrence " . _subname
863
+          unless ref $wrap eq 'ARRAY';
864
+        unshift @sql, $wrap->[0];
865
+        push @sql, $wrap->[1];
866
+    }
867
+    
868
+    # SQL
869
+    my $sql = join (' ', @sql);
870
+    
871
+    # Execute query
872
+    my $result = $self->execute($sql, $where_param, table => $tables, %args);
873
+    
874
+    return $result;
875
+}
876
+
877
+sub separator {
878
+    my $self = shift;
879
+    
880
+    if (@_) {
881
+        my $separator = $_[0] || '';
882
+        croak qq{Separator must be "." or "__" or "-" } . _subname
883
+          unless $separator eq '.' || $separator eq '__'
884
+              || $separator eq '-';
885
+        
886
+        $self->{separator} = $separator;
887
+    
888
+        return $self;
889
+    }
890
+    return $self->{separator} ||= '.';
891
+}
892
+
893
+sub setup_model {
894
+    my $self = shift;
895
+    
896
+    # Setup model
897
+    $self->each_column(
898
+        sub {
899
+            my ($self, $table, $column, $column_info) = @_;
900
+            if (my $model = $self->models->{$table}) {
901
+                push @{$model->columns}, $column;
902
+            }
903
+        }
904
+    );
905
+    return $self;
906
+}
907
+
908
+sub available_data_type {
909
+    my $self = shift;
910
+    
911
+    my $data_types = '';
912
+    foreach my $i (-1000 .. 1000) {
913
+         my $type_info = $self->dbh->type_info($i);
914
+         my $data_type = $type_info->{DATA_TYPE};
915
+         my $type_name = $type_info->{TYPE_NAME};
916
+         $data_types .= "$data_type ($type_name)\n"
917
+           if defined $data_type;
918
+    }
919
+    return "Data Type maybe equal to Type Name" unless $data_types;
920
+    $data_types = "Data Type (Type name)\n" . $data_types;
921
+    return $data_types;
922
+}
923
+
924
+sub available_type_name {
925
+    my $self = shift;
926
+    
927
+    # Type Names
928
+    my $type_names = {};
929
+    $self->each_column(sub {
930
+        my ($self, $table, $column, $column_info) = @_;
931
+        $type_names->{$column_info->{TYPE_NAME}} = 1
932
+          if $column_info->{TYPE_NAME};
933
+    });
934
+    my @output = sort keys %$type_names;
935
+    unshift @output, "Type Name";
936
+    return join "\n", @output;
937
+}
938
+
939
+sub type_rule {
940
+    my $self = shift;
941
+    
942
+    if (@_) {
943
+        my $type_rule = ref $_[0] eq 'HASH' ? $_[0] : {@_};
944
+        
945
+        # Into
946
+        foreach my $i (1 .. 2) {
947
+            my $into = "into$i";
948
+            $type_rule->{$into} = _array_to_hash($type_rule->{$into});
949
+            $self->{type_rule} = $type_rule;
950
+            $self->{"_$into"} = {};
951
+            foreach my $type_name (keys %{$type_rule->{$into} || {}}) {
952
+                croak qq{type name of $into section must be lower case}
953
+                  if $type_name =~ /[A-Z]/;
954
+            }
955
+            $self->each_column(sub {
956
+                my ($dbi, $table, $column, $column_info) = @_;
957
+                
958
+                my $type_name = lc $column_info->{TYPE_NAME};
959
+                if ($type_rule->{$into} &&
960
+                    (my $filter = $type_rule->{$into}->{$type_name}))
961
+                {
962
+                    return unless exists $type_rule->{$into}->{$type_name};
963
+                    if  (defined $filter && ref $filter ne 'CODE') 
964
+                    {
965
+                        my $fname = $filter;
966
+                        croak qq{Filter "$fname" is not registered" } . _subname
967
+                          unless exists $self->filters->{$fname};
968
+                        
969
+                        $filter = $self->filters->{$fname};
970
+                    }
971
+
972
+                    $self->{"_$into"}{key}{$table}{$column} = $filter;
973
+                    $self->{"_$into"}{dot}{"$table.$column"} = $filter;
974
+                }
975
+            });
976
+        }
977
+
978
+        # From
979
+        foreach my $i (1 .. 2) {
980
+            $type_rule->{"from$i"} = _array_to_hash($type_rule->{"from$i"});
981
+            foreach my $data_type (keys %{$type_rule->{"from$i"} || {}}) {
982
+                croak qq{data type of from$i section must be lower case or number}
983
+                  if $data_type =~ /[A-Z]/;
984
+                my $fname = $type_rule->{"from$i"}{$data_type};
985
+                if (defined $fname && ref $fname ne 'CODE') {
986
+                    croak qq{Filter "$fname" is not registered" } . _subname
987
+                      unless exists $self->filters->{$fname};
988
+                    
989
+                    $type_rule->{"from$i"}{$data_type} = $self->filters->{$fname};
990
+                }
991
+            }
992
+        }
993
+        
994
+        return $self;
995
+    }
996
+    
997
+    return $self->{type_rule} || {};
998
+}
999
+
1000
+sub update {
1001
+    my $self = shift;
1002
+
1003
+    # Arguments
1004
+    my $param;
1005
+    $param = shift if @_ % 2;
1006
+    my %args = @_;
1007
+    my $table = delete $args{table} || '';
1008
+    croak qq{"table" option must be specified } . _subname
1009
+      unless $table;
1010
+    my $p = delete $args{param} || {};
1011
+    $param  ||= $p;
1012
+    my $where = delete $args{where} || {};
1013
+    my $where_param = delete $args{where_param} || {};
1014
+    my $append = delete $args{append} || '';
1015
+    my $allow_update_all = delete $args{allow_update_all};
1016
+    my $id = delete $args{id};
1017
+    my $primary_key = delete $args{primary_key};
1018
+    croak "update method primary_key option " .
1019
+          "must be specified when id is specified " . _subname
1020
+      if defined $id && !defined $primary_key;
1021
+    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
1022
+    my $prefix = delete $args{prefix};
1023
+
1024
+    # Update clause
1025
+    my $update_clause = $self->update_param($param);
1026
+
1027
+    # Where
1028
+    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
1029
+    my $where_clause = '';
1030
+    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
1031
+        $where_clause = "where " . $where->[0];
1032
+        $where_param = $where->[1];
1033
+    }
1034
+    elsif (ref $where) {
1035
+        $where = $self->_where_to_obj($where);
1036
+        $where_param = keys %$where_param
1037
+                     ? $self->merge_param($where_param, $where->param)
1038
+                     : $where->param;
1039
+        
1040
+        # String where
1041
+        $where_clause = $where->to_string;
1042
+    }
1043
+    elsif ($where) { $where_clause = "where $where" }
1044
+    croak qq{"where" must be specified } . _subname
1045
+      if "$where_clause" eq '' && !$allow_update_all;
1046
+    
1047
+    # Merge param
1048
+    $param = $self->merge_param($param, $where_param) if keys %$where_param;
1049
+    
1050
+    # Update statement
1051
+    my @sql;
1052
+    push @sql, "update";
1053
+    push @sql, $prefix if defined $prefix;
1054
+    push @sql, $self->_q($table) . " $update_clause $where_clause";
1055
+    push @sql, $append if defined $append;
1056
+    
1057
+    # SQL
1058
+    my $sql = join(' ', @sql);
1059
+    
1060
+    # Execute query
1061
+    return $self->execute($sql, $param, table => $table, %args);
1062
+}
1063
+
1064
+sub update_all { shift->update(allow_update_all => 1, @_) };
1065
+
1066
+sub update_param {
1067
+    my ($self, $param, $opt) = @_;
1068
+    
1069
+    # Create update parameter tag
1070
+    my $tag = $self->assign_param($param);
1071
+    $tag = "set $tag" unless $opt->{no_set};
1072
+
1073
+    return $tag;
1074
+}
1075
+
1076
+sub where { DBIx::Custom::Where->new(dbi => shift, @_) }
1077
+
1078
+sub _create_query {
1079
+    
1080
+    my ($self, $source) = @_;
1081
+    
1082
+    # Cache
1083
+    my $cache = $self->cache;
1084
+    
1085
+    # Query
1086
+    my $query;
1087
+    
1088
+    # Get cached query
1089
+    if ($cache) {
1090
+        
1091
+        # Get query
1092
+        my $q = $self->cache_method->($self, $source);
1093
+        
1094
+        # Create query
1095
+        if ($q) {
1096
+            $query = DBIx::Custom::Query->new($q);
1097
+            $query->{filters} = $self->filters;
1098
+        }
1099
+    }
1100
+    
1101
+    # Create query
1102
+    unless ($query) {
1103
+
1104
+        # Create query
1105
+        my $builder = $self->query_builder;
1106
+        $query = $builder->build_query($source);
1107
+
1108
+        # Remove reserved word quote
1109
+        if (my $q = $self->_quote) {
1110
+            $q = quotemeta($q);
1111
+            $_ =~ s/[$q]//g for @{$query->columns}
1112
+        }
1113
+
1114
+        # Save query to cache
1115
+        $self->cache_method->(
1116
+            $self, $source,
1117
+            {
1118
+                sql     => $query->sql, 
1119
+                columns => $query->columns,
1120
+                tables  => $query->{tables} || []
1121
+            }
1122
+        ) if $cache;
1123
+    }
1124
+    
1125
+    # Save sql
1126
+    $self->last_sql($query->sql);
1127
+    
1128
+    # Prepare statement handle
1129
+    my $sth;
1130
+    eval { $sth = $self->dbh->prepare($query->{sql})};
1131
+    
1132
+    if ($@) {
1133
+        $self->_croak($@, qq{. Following SQL is executed.\n}
1134
+                        . qq{$query->{sql}\n} . _subname);
1135
+    }
1136
+    
1137
+    # Set statement handle
1138
+    $query->sth($sth);
1139
+    
1140
+    # Set filters
1141
+    $query->{filters} = $self->filters;
1142
+    
1143
+    return $query;
1144
+}
1145
+
1146
+sub _create_bind_values {
1147
+    my ($self, $params, $columns, $filter, $type_filters, $bind_type) = @_;
1148
+    
1149
+    # Create bind values
1150
+    my $bind = [];
1151
+    my $count = {};
1152
+    my $not_exists = {};
1153
+    foreach my $column (@$columns) {
1154
+        
1155
+        # Value
1156
+        my $value;
1157
+        if(ref $params->{$column} eq 'ARRAY') {
1158
+            my $i = $count->{$column} || 0;
1159
+            $i += $not_exists->{$column} || 0;
1160
+            my $found;
1161
+            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1162
+                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1163
+                    $not_exists->{$column}++;
1164
+                }
1165
+                else  {
1166
+                    $value = $params->{$column}->[$k];
1167
+                    $found = 1;
1168
+                    last
1169
+                }
1170
+            }
1171
+            next unless $found;
1172
+        }
1173
+        else { $value = $params->{$column} }
1174
+        
1175
+        # Filter
1176
+        my $f = $filter->{$column} || $self->{default_out_filter} || '';
1177
+        $value = $f->($value) if $f;
1178
+        
1179
+        # Type rule
1180
+        foreach my $i (1 .. 2) {
1181
+            my $type_filter = $type_filters->{$i};
1182
+            my $tf = $self->{"_into$i"}->{dot}->{$column} || $type_filter->{$column};
1183
+            $value = $tf->($value) if $tf;
1184
+        }
1185
+        
1186
+        # Bind values
1187
+        push @$bind, {value => $value, bind_type => $bind_type->{$column}};
1188
+        
1189
+        # Count up 
1190
+        $count->{$column}++;
1191
+    }
1192
+    
1193
+    return $bind;
1194
+}
1195
+
1196
+sub _create_param_from_id {
1197
+    my ($self, $id, $primary_keys) = @_;
1198
+    
1199
+    # Create parameter
1200
+    my $param = {};
1201
+    if (defined $id) {
1202
+        $id = [$id] unless ref $id;
1203
+        croak qq{"id" must be constant value or array reference}
1204
+            . " (" . (caller 1)[3] . ")"
1205
+          unless !ref $id || ref $id eq 'ARRAY';
1206
+        croak qq{"id" must contain values same count as primary key}
1207
+            . " (" . (caller 1)[3] . ")"
1208
+          unless @$primary_keys eq @$id;
1209
+        for(my $i = 0; $i < @$primary_keys; $i ++) {
1210
+           $param->{$primary_keys->[$i]} = $id->[$i];
1211
+        }
1212
+    }
1213
+    
1214
+    return $param;
1215
+}
1216
+
1217
+sub _connect {
1218
+    my $self = shift;
1219
+    
1220
+    # Attributes
1221
+    my $dsn = $self->data_source;
1222
+    warn "data_source is DEPRECATED!\n"
1223
+      if $dsn;
1224
+    $dsn ||= $self->dsn;
1225
+    croak qq{"dsn" must be specified } . _subname
1226
+      unless $dsn;
1227
+    my $user        = $self->user;
1228
+    my $password    = $self->password;
1229
+    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1230
+    warn "dbi_options is DEPRECATED! use dbi_option instead\n"
1231
+      if keys %{$self->dbi_options};
1232
+    
1233
+    # Connect
1234
+    my $dbh = eval {DBI->connect(
1235
+        $dsn,
1236
+        $user,
1237
+        $password,
1238
+        {
1239
+            %{$self->default_dbi_option},
1240
+            %$dbi_option
1241
+        }
1242
+    )};
1243
+    
1244
+    # Connect error
1245
+    croak "$@ " . _subname if $@;
1246
+    
1247
+    return $dbh;
1248
+}
1249
+
1250
+sub _croak {
1251
+    my ($self, $error, $append) = @_;
1252
+    
1253
+    # Append
1254
+    $append ||= "";
1255
+    
1256
+    # Verbose
1257
+    if ($Carp::Verbose) { croak $error }
1258
+    
1259
+    # Not verbose
1260
+    else {
1261
+        
1262
+        # Remove line and module infromation
1263
+        my $at_pos = rindex($error, ' at ');
1264
+        $error = substr($error, 0, $at_pos);
1265
+        $error =~ s/\s+$//;
1266
+        croak "$error$append";
1267
+    }
1268
+}
1269
+
1270
+sub _need_tables {
1271
+    my ($self, $tree, $need_tables, $tables) = @_;
1272
+    
1273
+    # Get needed tables
1274
+    foreach my $table (@$tables) {
1275
+        if ($tree->{$table}) {
1276
+            $need_tables->{$table} = 1;
1277
+            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1278
+        }
1279
+    }
1280
+}
1281
+
1282
+sub _push_join {
1283
+    my ($self, $sql, $join, $join_tables) = @_;
1284
+    
1285
+    # No join
1286
+    return unless @$join;
1287
+    
1288
+    # Push join clause
1289
+    my $tree = {};
1290
+    for (my $i = 0; $i < @$join; $i++) {
1291
+        
1292
+        # Arrange
1293
+        my $join_clause;;
1294
+        my $option;
1295
+        if (ref $join->[$i] eq 'HASH') {
1296
+            $join_clause = $join->[$i]->{clause};
1297
+            $option = {table => $join->[$i]->{table}};
1298
+        }
1299
+        else {
1300
+            $join_clause = $join->[$i];
1301
+            $option = {};
1302
+        };
1303
+
1304
+        # Find tables in join clause
1305
+        my $table1;
1306
+        my $table2;
1307
+        if (my $table = $option->{table}) {
1308
+            $table1 = $table->[0];
1309
+            $table2 = $table->[1];
1310
+        }
1311
+        else {
1312
+            my $q = $self->_quote;
1313
+            my $j_clause = (split /\s+on\s+/, $join_clause)[-1];
1314
+            $j_clause =~ s/'.+?'//g;
1315
+            my $q_re = quotemeta($q);
1316
+            $j_clause =~ s/[$q_re]//g;
1317
+            my $c = $self->safety_character;
1318
+            my $join_re = qr/(?:^|\s)($c+)\.$c+\s+=\s+($c+)\.$c+/;
1319
+            if ($j_clause =~ $join_re) {
1320
+                $table1 = $1;
1321
+                $table2 = $2;
1322
+            }
1323
+        }
1324
+        croak qq{join clause must have two table name after "on" keyword. } .
1325
+              qq{"$join_clause" is passed }  . _subname
1326
+          unless defined $table1 && defined $table2;
1327
+        croak qq{right side table of "$join_clause" must be unique }
1328
+            . _subname
1329
+          if exists $tree->{$table2};
1330
+        croak qq{Same table "$table1" is specified} . _subname
1331
+          if $table1 eq $table2;
1332
+        $tree->{$table2}
1333
+          = {position => $i, parent => $table1, join => $join_clause};
1334
+    }
1335
+    
1336
+    # Search need tables
1337
+    my $need_tables = {};
1338
+    $self->_need_tables($tree, $need_tables, $join_tables);
1339
+    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
1340
+    
1341
+    # Add join clause
1342
+    foreach my $need_table (@need_tables) {
1343
+        push @$sql, $tree->{$need_table}{join};
1344
+    }
1345
+}
1346
+
1347
+sub _quote {
1348
+    my $self = shift;
1349
+    
1350
+    return defined $self->reserved_word_quote ? $self->reserved_word_quote
1351
+         : defined $self->quote ? $self->quote
1352
+         : '';
1353
+}
1354
+
1355
+sub _q {
1356
+    my ($self, $value) = @_;
1357
+    
1358
+    my $quote = $self->_quote;
1359
+    my $q = substr($quote, 0, 1) || '';
1360
+    my $p;
1361
+    if (defined $quote && length $quote > 1) {
1362
+        $p = substr($quote, 1, 1);
1363
+    }
1364
+    else { $p = $q }
1365
+    
1366
+    return "$q$value$p";
1367
+}
1368
+
1369
+sub _remove_duplicate_table {
1370
+    my ($self, $tables, $main_table) = @_;
1371
+    
1372
+    # Remove duplicate table
1373
+    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1374
+    delete $tables{$main_table} if $main_table;
1375
+    
1376
+    my $new_tables = [keys %tables, $main_table ? $main_table : ()];
1377
+    if (my $q = $self->_quote) {
1378
+        $q = quotemeta($q);
1379
+        $_ =~ s/[$q]//g for @$new_tables;
1380
+    }
1381
+
1382
+    return $new_tables;
1383
+}
1384
+
1385
+sub _search_tables {
1386
+    my ($self, $source) = @_;
1387
+    
1388
+    # Search tables
1389
+    my $tables = [];
1390
+    my $safety_character = $self->safety_character;
1391
+    my $q = $self->_quote;
1392
+    my $q_re = quotemeta($q);
1393
+    my $quoted_safety_character_re = $self->_q("?([$safety_character]+)");
1394
+    my $table_re = $q ? qr/(?:^|[^$safety_character])$quoted_safety_character_re?\./
1395
+                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
1396
+    while ($source =~ /$table_re/g) {
1397
+        push @$tables, $1;
1398
+    }
1399
+    
1400
+    return $tables;
1401
+}
1402
+
1403
+sub _where_to_obj {
1404
+    my ($self, $where) = @_;
1405
+    
1406
+    my $obj;
1407
+    
1408
+    # Hash
1409
+    if (ref $where eq 'HASH') {
1410
+        my $clause = ['and'];
1411
+        my $q = $self->_quote;
1412
+        foreach my $column (keys %$where) {
1413
+            my $column_quote = $self->_q($column);
1414
+            $column_quote =~ s/\./$self->_q(".")/e;
1415
+            push @$clause, "$column_quote = :$column" for keys %$where;
1416
+        }
1417
+        $obj = $self->where(clause => $clause, param => $where);
1418
+    }
1419
+    
1420
+    # DBIx::Custom::Where object
1421
+    elsif (ref $where eq 'DBIx::Custom::Where') {
1422
+        $obj = $where;
1423
+    }
1424
+    
1425
+    # Array
1426
+    elsif (ref $where eq 'ARRAY') {
1427
+        $obj = $self->where(
1428
+            clause => $where->[0],
1429
+            param  => $where->[1]
1430
+        );
1431
+    }
1432
+    
1433
+    # Check where argument
1434
+    croak qq{"where" must be hash reference or DBIx::Custom::Where object}
1435
+        . qq{or array reference, which contains where clause and parameter}
1436
+        . _subname
1437
+      unless ref $obj eq 'DBIx::Custom::Where';
1438
+    
1439
+    return $obj;
1440
+}
1441
+
1442
+sub _apply_filter {
1443
+    my ($self, $table, @cinfos) = @_;
1444
+
1445
+    # Initialize filters
1446
+    $self->{filter} ||= {};
1447
+    $self->{filter}{on} = 1;
1448
+    $self->{filter}{out} ||= {};
1449
+    $self->{filter}{in} ||= {};
1450
+    $self->{filter}{end} ||= {};
1451
+    
1452
+    # Usage
1453
+    my $usage = "Usage: \$dbi->apply_filter(" .
1454
+                "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1, end => ENDFILTER1}, " .
1455
+                "COLUMN2, {in => INFILTER2, out => OUTFILTER2, end => ENDFILTER2}, ...)";
1456
+    
1457
+    # Apply filter
1458
+    for (my $i = 0; $i < @cinfos; $i += 2) {
1459
+        
1460
+        # Column
1461
+        my $column = $cinfos[$i];
1462
+        if (ref $column eq 'ARRAY') {
1463
+            foreach my $c (@$column) {
1464
+                push @cinfos, $c, $cinfos[$i + 1];
1465
+            }
1466
+            next;
1467
+        }
1468
+        
1469
+        # Filter infomation
1470
+        my $finfo = $cinfos[$i + 1] || {};
1471
+        croak "$usage (table: $table) " . _subname
1472
+          unless  ref $finfo eq 'HASH';
1473
+        foreach my $ftype (keys %$finfo) {
1474
+            croak "$usage (table: $table) " . _subname
1475
+              unless $ftype eq 'in' || $ftype eq 'out' || $ftype eq 'end'; 
1476
+        }
1477
+        
1478
+        # Set filters
1479
+        foreach my $way (qw/in out end/) {
1480
+        
1481
+            # Filter
1482
+            my $filter = $finfo->{$way};
1483
+            
1484
+            # Filter state
1485
+            my $state = !exists $finfo->{$way} ? 'not_exists'
1486
+                      : !defined $filter        ? 'not_defined'
1487
+                      : ref $filter eq 'CODE'   ? 'code'
1488
+                      : 'name';
1489
+            
1490
+            # Filter is not exists
1491
+            next if $state eq 'not_exists';
1492
+            
1493
+            # Check filter name
1494
+            croak qq{Filter "$filter" is not registered } . _subname
1495
+              if  $state eq 'name'
1496
+               && ! exists $self->filters->{$filter};
1497
+            
1498
+            # Set filter
1499
+            my $f = $state eq 'not_defined' ? undef
1500
+                  : $state eq 'code'        ? $filter
1501
+                  : $self->filters->{$filter};
1502
+            $self->{filter}{$way}{$table}{$column} = $f;
1503
+            $self->{filter}{$way}{$table}{"$table.$column"} = $f;
1504
+            $self->{filter}{$way}{$table}{"${table}__$column"} = $f;
1505
+            $self->{filter}{$way}{$table}{"${table}-$column"} = $f;
1506
+        }
1507
+    }
1508
+    
1509
+    return $self;
1510
+}
1511
+
1512
+# DEPRECATED!
1513
+sub create_query {
1514
+    warn "create_query is DEPRECATED! use query option of each method";
1515
+    shift->_create_query(@_);
1516
+}
1517
+
1518
+# DEPRECATED!
1519
+sub apply_filter {
1520
+    my $self = shift;
1521
+    
1522
+    warn "apply_filter is DEPRECATED!";
1523
+    return $self->_apply_filter(@_);
1524
+}
1525
+
1526
+# DEPRECATED!
1527
+our %SELECT_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1528
+sub select_at {
1529
+    my ($self, %args) = @_;
1530
+
1531
+    warn "select_at is DEPRECATED! use update and id option instead";
1532
+
1533
+    # Arguments
1534
+    my $primary_keys = delete $args{primary_key};
1535
+    $primary_keys = [$primary_keys] unless ref $primary_keys;
1536
+    my $where = delete $args{where};
1537
+    my $param = delete $args{param};
1538
+    
1539
+    # Check arguments
1540
+    foreach my $name (keys %args) {
1541
+        croak qq{"$name" is wrong option } . _subname
1542
+          unless $SELECT_AT_ARGS{$name};
1543
+    }
1544
+    
1545
+    # Table
1546
+    croak qq{"table" option must be specified } . _subname
1547
+      unless $args{table};
1548
+    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
1549
+    
1550
+    # Create where parameter
1551
+    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1552
+    
1553
+    return $self->select(where => $where_param, %args);
1554
+}
1555
+
1556
+# DEPRECATED!
1557
+our %DELETE_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1558
+sub delete_at {
1559
+    my ($self, %args) = @_;
1560
+
1561
+    warn "delete_at is DEPRECATED! use update and id option instead";
1562
+    
1563
+    # Arguments
1564
+    my $primary_keys = delete $args{primary_key};
1565
+    $primary_keys = [$primary_keys] unless ref $primary_keys;
1566
+    my $where = delete $args{where};
1567
+    
1568
+    # Check arguments
1569
+    foreach my $name (keys %args) {
1570
+        croak qq{"$name" is wrong option } . _subname
1571
+          unless $DELETE_AT_ARGS{$name};
1572
+    }
1573
+    
1574
+    # Create where parameter
1575
+    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1576
+    
1577
+    return $self->delete(where => $where_param, %args);
1578
+}
1579
+
1580
+# DEPRECATED!
1581
+our %UPDATE_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1582
+sub update_at {
1583
+    my $self = shift;
1584
+
1585
+    warn "update_at is DEPRECATED! use update and id option instead";
1586
+    
1587
+    # Arguments
1588
+    my $param;
1589
+    $param = shift if @_ % 2;
1590
+    my %args = @_;
1591
+    my $primary_keys = delete $args{primary_key};
1592
+    $primary_keys = [$primary_keys] unless ref $primary_keys;
1593
+    my $where = delete $args{where};
1594
+    my $p = delete $args{param} || {};
1595
+    $param  ||= $p;
1596
+    
1597
+    # Check arguments
1598
+    foreach my $name (keys %args) {
1599
+        croak qq{"$name" is wrong option } . _subname
1600
+          unless $UPDATE_AT_ARGS{$name};
1601
+    }
1602
+    
1603
+    # Create where parameter
1604
+    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1605
+    
1606
+    return $self->update(where => $where_param, param => $param, %args);
1607
+}
1608
+
1609
+# DEPRECATED!
1610
+our %INSERT_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1611
+sub insert_at {
1612
+    my $self = shift;
1613
+    
1614
+    warn "insert_at is DEPRECATED! use insert and id option instead";
1615
+    
1616
+    # Arguments
1617
+    my $param;
1618
+    $param = shift if @_ % 2;
1619
+    my %args = @_;
1620
+    my $primary_key = delete $args{primary_key};
1621
+    $primary_key = [$primary_key] unless ref $primary_key;
1622
+    my $where = delete $args{where};
1623
+    my $p = delete $args{param} || {};
1624
+    $param  ||= $p;
1625
+    
1626
+    # Check arguments
1627
+    foreach my $name (keys %args) {
1628
+        croak qq{"$name" is wrong option } . _subname
1629
+          unless $INSERT_AT_ARGS{$name};
1630
+    }
1631
+    
1632
+    # Create where parameter
1633
+    my $where_param = $self->_create_param_from_id($where, $primary_key);
1634
+    $param = $self->merge_param($where_param, $param);
1635
+    
1636
+    return $self->insert(param => $param, %args);
1637
+}
1638
+
1639
+# DEPRECATED!
1640
+sub register_tag {
1641
+    warn "register_tag is DEPRECATED!";
1642
+    shift->query_builder->register_tag(@_)
1643
+}
1644
+
1645
+# DEPRECATED!
1646
+has 'data_source';
1647
+has dbi_options => sub { {} };
1648
+has filter_check  => 1;
1649
+has 'reserved_word_quote';
1650
+
1651
+# DEPRECATED!
1652
+sub default_bind_filter {
1653
+    my $self = shift;
1654
+    
1655
+    warn "default_bind_filter is DEPRECATED!";
1656
+    
1657
+    if (@_) {
1658
+        my $fname = $_[0];
1659
+        
1660
+        if (@_ && !$fname) {
1661
+            $self->{default_out_filter} = undef;
1662
+        }
1663
+        else {
1664
+            croak qq{Filter "$fname" is not registered}
1665
+              unless exists $self->filters->{$fname};
1666
+        
1667
+            $self->{default_out_filter} = $self->filters->{$fname};
1668
+        }
1669
+        return $self;
1670
+    }
1671
+    
1672
+    return $self->{default_out_filter};
1673
+}
1674
+
1675
+# DEPRECATED!
1676
+sub default_fetch_filter {
1677
+    my $self = shift;
1678
+
1679
+    warn "default_fetch_filter is DEPRECATED!";
1680
+    
1681
+    if (@_) {
1682
+        my $fname = $_[0];
1683
+
1684
+        if (@_ && !$fname) {
1685
+            $self->{default_in_filter} = undef;
1686
+        }
1687
+        else {
1688
+            croak qq{Filter "$fname" is not registered}
1689
+              unless exists $self->filters->{$fname};
1690
+        
1691
+            $self->{default_in_filter} = $self->filters->{$fname};
1692
+        }
1693
+        
1694
+        return $self;
1695
+    }
1696
+    
1697
+    return $self->{default_in_filter};
1698
+}
1699
+
1700
+# DEPRECATED!
1701
+sub insert_param_tag {
1702
+    warn "insert_param_tag is DEPRECATED! " .
1703
+         "use insert_param instead!";
1704
+    return shift->insert_param(@_);
1705
+}
1706
+
1707
+# DEPRECATED!
1708
+sub register_tag_processor {
1709
+    warn "register_tag_processor is DEPRECATED!";
1710
+    return shift->query_builder->register_tag_processor(@_);
1711
+}
1712
+
1713
+# DEPRECATED!
1714
+sub update_param_tag {
1715
+    warn "update_param_tag is DEPRECATED! " .
1716
+         "use update_param instead";
1717
+    return shift->update_param(@_);
1718
+}
1719
+# DEPRECATED!
1720
+sub _push_relation {
1721
+    my ($self, $sql, $tables, $relation, $need_where) = @_;
1722
+    
1723
+    if (keys %{$relation || {}}) {
1724
+        push @$sql, $need_where ? 'where' : 'and';
1725
+        foreach my $rcolumn (keys %$relation) {
1726
+            my $table1 = (split (/\./, $rcolumn))[0];
1727
+            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1728
+            push @$tables, ($table1, $table2);
1729
+            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1730
+        }
1731
+    }
1732
+    pop @$sql if $sql->[-1] eq 'and';    
1733
+}
1734
+
1735
+# DEPRECATED!
1736
+sub _add_relation_table {
1737
+    my ($self, $tables, $relation) = @_;
1738
+    
1739
+    if (keys %{$relation || {}}) {
1740
+        foreach my $rcolumn (keys %$relation) {
1741
+            my $table1 = (split (/\./, $rcolumn))[0];
1742
+            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1743
+            my $table1_exists;
1744
+            my $table2_exists;
1745
+            foreach my $table (@$tables) {
1746
+                $table1_exists = 1 if $table eq $table1;
1747
+                $table2_exists = 1 if $table eq $table2;
1748
+            }
1749
+            unshift @$tables, $table1 unless $table1_exists;
1750
+            unshift @$tables, $table2 unless $table2_exists;
1751
+        }
1752
+    }
1753
+}
1754
+
1755
+1;
1756
+
1757
+=head1 NAME
1758
+
1759
+DBIx::Custom - Execute insert, update, delete, and select statement easily
1760
+
1761
+=head1 SYNOPSYS
1762
+
1763
+    use DBIx::Custom;
1764
+    
1765
+    # Connect
1766
+    my $dbi = DBIx::Custom->connect(
1767
+        dsn => "dbi:mysql:database=dbname",
1768
+        user => 'ken',
1769
+        password => '!LFKD%$&',
1770
+        dbi_option => {mysql_enable_utf8 => 1}
1771
+    );
1772
+
1773
+    # Insert 
1774
+    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
1775
+    
1776
+    # Update 
1777
+    $dbi->update({title => 'Perl', author => 'Ken'}, table  => 'book',
1778
+      where  => {id => 5});
1779
+    
1780
+    # Delete
1781
+    $dbi->delete(table  => 'book', where => {author => 'Ken'});
1782
+
1783
+    # Select
1784
+    my $result = $dbi->select(table  => 'book',
1785
+      column => ['title', 'author'], where  => {author => 'Ken'});
1786
+
1787
+    # Select, more complex
1788
+    my $result = $dbi->select(
1789
+        table  => 'book',
1790
+        column => [
1791
+            {book => [qw/title author/]},
1792
+            {company => ['name']}
1793
+        ],
1794
+        where  => {'book.author' => 'Ken'},
1795
+        join => ['left outer join company on book.company_id = company.id'],
1796
+        append => 'order by id limit 5'
1797
+    );
1798
+    
1799
+    # Fetch
1800
+    while (my $row = $result->fetch) {
1801
+        
1802
+    }
1803
+    
1804
+    # Fetch as hash
1805
+    while (my $row = $result->fetch_hash) {
1806
+        
1807
+    }
1808
+    
1809
+    # Execute SQL with parameter.
1810
+    $dbi->execute(
1811
+        "select id from book where author = :author and title like :title",
1812
+        {author => 'ken', title => '%Perl%'}
1813
+    );
1814
+    
1815
+=head1 DESCRIPTIONS
1816
+
1817
+L<DBIx::Custom> is L<DBI> wrapper module to execute SQL easily.
1818
+This module have the following features.
1819
+
1820
+=over 4
1821
+
1822
+=item *
1823
+
1824
+Execute C<insert>, C<update>, C<delete>, or C<select> statement easily
1825
+
1826
+=item *
1827
+
1828
+Create C<where> clause flexibly
1829
+
1830
+=item *
1831
+
1832
+Named place holder support
1833
+
1834
+=item *
1835
+
1836
+Model support
1837
+
1838
+=item *
1839
+
1840
+Connection manager support
1841
+
1842
+=item *
1843
+
1844
+Choice your favorite relational database management system,
1845
+C<MySQL>, C<SQLite>, C<PostgreSQL>, C<Oracle>,
1846
+C<Microsoft SQL Server>, C<Microsoft Access>, C<DB2> or anything, 
1847
+
1848
+=item *
1849
+
1850
+Filtering by data type or column name(EXPERIMENTAL)
1851
+
1852
+=item *
1853
+
1854
+Create C<order by> clause flexibly(EXPERIMENTAL)
1855
+
1856
+=back
1857
+
1858
+=head1 DOCUMENTATIONS
1859
+
1860
+L<DBIx::Custom::Guide> - How to use L<DBIx::Custom>
1861
+
1862
+L<DBIx::Custom Wiki|https://github.com/yuki-kimoto/DBIx-Custom/wiki>
1863
+- Theare are various examples.
1864
+
1865
+Module documentations - 
1866
+L<DBIx::Custom::Result>,
1867
+L<DBIx::Custom::Query>,
1868
+L<DBIx::Custom::Where>,
1869
+L<DBIx::Custom::Model>,
1870
+L<DBIx::Custom::Order>
1871
+
1872
+=head1 ATTRIBUTES
1873
+
1874
+=head2 C<connector>
1875
+
1876
+    my $connector = $dbi->connector;
1877
+    $dbi = $dbi->connector($connector);
1878
+
1879
+Connection manager object. if C<connector> is set, you can get C<dbh>
1880
+through connection manager. Conection manager object must have C<dbh> mehtod.
1881
+
1882
+This is L<DBIx::Connector> example. Please pass
1883
+C<default_dbi_option> to L<DBIx::Connector> C<new> method.
1884
+
1885
+    my $connector = DBIx::Connector->new(
1886
+        "dbi:mysql:database=$DATABASE",
1887
+        $USER,
1888
+        $PASSWORD,
1889
+        DBIx::Custom->new->default_dbi_option
1890
+    );
1891
+    
1892
+    my $dbi = DBIx::Custom->connect(connector => $connector);
1893
+
1894
+=head2 C<dsn>
1895
+
1896
+    my $dsn = $dbi->dsn;
1897
+    $dbi = $dbi->dsn("DBI:mysql:database=dbname");
1898
+
1899
+Data source name, used when C<connect> method is executed.
1900
+
1901
+=head2 C<dbi_option>
1902
+
1903
+    my $dbi_option = $dbi->dbi_option;
1904
+    $dbi = $dbi->dbi_option($dbi_option);
1905
+
1906
+L<DBI> option, used when C<connect> method is executed.
1907
+Each value in option override the value of C<default_dbi_option>.
1908
+
1909
+=head2 C<default_dbi_option>
1910
+
1911
+    my $default_dbi_option = $dbi->default_dbi_option;
1912
+    $dbi = $dbi->default_dbi_option($default_dbi_option);
1913
+
1914
+L<DBI> default option, used when C<connect> method is executed,
1915
+default to the following values.
1916
+
1917
+    {
1918
+        RaiseError => 1,
1919
+        PrintError => 0,
1920
+        AutoCommit => 1,
1921
+    }
1922
+
1923
+=head2 C<filters>
1924
+
1925
+    my $filters = $dbi->filters;
1926
+    $dbi = $dbi->filters(\%filters);
1927
+
1928
+Filters, registered by C<register_filter> method.
1929
+
1930
+=head2 C<last_sql>
1931
+
1932
+    my $last_sql = $dbi->last_sql;
1933
+    $dbi = $dbi->last_sql($last_sql);
1934
+
1935
+Get last successed SQL executed by C<execute> method.
1936
+
1937
+=head2 C<models>
1938
+
1939
+    my $models = $dbi->models;
1940
+    $dbi = $dbi->models(\%models);
1941
+
1942
+Models, included by C<include_model> method.
1943
+
1944
+=head2 C<password>
1945
+
1946
+    my $password = $dbi->password;
1947
+    $dbi = $dbi->password('lkj&le`@s');
1948
+
1949
+Password, used when C<connect> method is executed.
1950
+
1951
+=head2 C<query_builder>
1952
+
1953
+    my $sql_class = $dbi->query_builder;
1954
+    $dbi = $dbi->query_builder(DBIx::Custom::QueryBuilder->new);
1955
+
1956
+Query builder, default to L<DBIx::Custom::QueryBuilder> object.
1957
+
1958
+=head2 C<quote>
1959
+
1960
+     my quote = $dbi->quote;
1961
+     $dbi = $dbi->quote('"');
1962
+
1963
+Reserved word quote.
1964
+Default to double quote '"' except for mysql.
1965
+In mysql, default to back quote '`'
1966
+
1967
+You can set quote pair.
1968
+
1969
+    $dbi->quote('[]');
1970
+
1971
+=head2 C<result_class>
1972
+
1973
+    my $result_class = $dbi->result_class;
1974
+    $dbi = $dbi->result_class('DBIx::Custom::Result');
1975
+
1976
+Result class, default to L<DBIx::Custom::Result>.
1977
+
1978
+=head2 C<safety_character>
1979
+
1980
+    my $safety_character = $self->safety_character;
1981
+    $dbi = $self->safety_character($character);
1982
+
1983
+Regex of safety character for table and column name, default to '\w'.
1984
+Note that you don't have to specify like '[\w]'.
1985
+
1986
+=head2 C<tag_parse>
1987
+
1988
+    my $tag_parse = $dbi->tag_parse(0);
1989
+    $dbi = $dbi->tag_parse;
1990
+
1991
+Enable DEPRECATED tag parsing functionality, default to 1.
1992
+If you want to disable tag parsing functionality, set to 0.
1993
+
1994
+=head2 C<user>
1995
+
1996
+    my $user = $dbi->user;
1997
+    $dbi = $dbi->user('Ken');
1998
+
1999
+User name, used when C<connect> method is executed.
2000
+
2001
+=head1 METHODS
2002
+
2003
+L<DBIx::Custom> inherits all methods from L<Object::Simple>
2004
+and use all methods of L<DBI>
2005
+and implements the following new ones.
2006
+
2007
+=head2 C<available_data_type> EXPERIMENTAL
2008
+
2009
+    print $dbi->available_data_type;
2010
+
2011
+Get available data types. You can use these data types
2012
+in C<type rule>'s C<from1> and C<from2> section.
2013
+
2014
+=head2 C<available_type_name> EXPERIMENTAL
2015
+
2016
+    print $dbi->available_type_name;
2017
+
2018
+Get available type names. You can use these type names in
2019
+C<type_rule>'s C<into1> and C<into2> section.
2020
+
2021
+=head2 C<assign_param> EXPERIMENTAL
2022
+
2023
+    my $assign_param = $dbi->assign_param({title => 'a', age => 2});
2024
+
2025
+Create assign parameter.
2026
+
2027
+    title = :title, author = :author
2028
+
2029
+This is equal to C<update_param> exept that set is not added.
2030
+
2031
+=head2 C<column>
2032
+
2033
+    my $column = $dbi->column(book => ['author', 'title']);
2034
+
2035
+Create column clause. The follwoing column clause is created.
2036
+
2037
+    book.author as "book.author",
2038
+    book.title as "book.title"
2039
+
2040
+You can change separator by C<separator> method.
2041
+
2042
+    # Separator is double underbar
2043
+    $dbi->separator('__');
2044
+    
2045
+    book.author as "book__author",
2046
+    book.title as "book__title"
2047
+
2048
+    # Separator is hyphen
2049
+    $dbi->separator('-');
2050
+    
2051
+    book.author as "book-author",
2052
+    book.title as "book-title"
2053
+    
2054
+=head2 C<connect>
2055
+
2056
+    my $dbi = DBIx::Custom->connect(
2057
+        dsn => "dbi:mysql:database=dbname",
2058
+        user => 'ken',
2059
+        password => '!LFKD%$&',
2060
+        dbi_option => {mysql_enable_utf8 => 1}
2061
+    );
2062
+
2063
+Connect to the database and create a new L<DBIx::Custom> object.
2064
+
2065
+L<DBIx::Custom> is a wrapper of L<DBI>.
2066
+C<AutoCommit> and C<RaiseError> options are true, 
2067
+and C<PrintError> option is false by default.
2068
+
2069
+=head2 create_model
2070
+
2071
+    my $model = $dbi->create_model(
2072
+        table => 'book',
2073
+        primary_key => 'id',
2074
+        join => [
2075
+            'inner join company on book.comparny_id = company.id'
2076
+        ],
2077
+    );
2078
+
2079
+Create L<DBIx::Custom::Model> object and initialize model.
2080
+the module is also used from C<model> method.
2081
+
2082
+   $dbi->model('book')->select(...);
2083
+
2084
+=head2 C<dbh>
2085
+
2086
+    my $dbh = $dbi->dbh;
2087
+
2088
+Get L<DBI> database handle. if C<connector> is set, you can get
2089
+database handle through C<connector> object.
2090
+
2091
+=head2 C<each_column>
2092
+
2093
+    $dbi->each_column(
2094
+        sub {
2095
+            my ($dbi, $table, $column, $column_info) = @_;
2096
+            
2097
+            my $type = $column_info->{TYPE_NAME};
2098
+            
2099
+            if ($type eq 'DATE') {
2100
+                # ...
2101
+            }
2102
+        }
2103
+    );
2104
+
2105
+Iterate all column informations of all table from database.
2106
+Argument is callback when one column is found.
2107
+Callback receive four arguments, dbi object, table name,
2108
+column name and column information.
2109
+
2110
+=head2 C<each_table>
2111
+
2112
+    $dbi->each_table(
2113
+        sub {
2114
+            my ($dbi, $table, $table_info) = @_;
2115
+            
2116
+            my $table_name = $table_info->{TABLE_NAME};
2117
+        }
2118
+    );
2119
+
2120
+Iterate all table informationsfrom database.
2121
+Argument is callback when one table is found.
2122
+Callback receive three arguments, dbi object, table name,
2123
+table information.
2124
+
2125
+=head2 C<execute>
2126
+
2127
+    my $result = $dbi->execute(
2128
+      "select * from book where title = :title and author like :author",
2129
+      {title => 'Perl', author => '%Ken%'}
2130
+    );
2131
+
2132
+    my $result = $dbi->execute(
2133
+      "select * from book where title = :book.title and author like :book.author",
2134
+      {'book.title' => 'Perl', 'book.author' => '%Ken%'}
2135
+    );
2136
+
2137
+Execute SQL. SQL can contain column parameter such as :author and :title.
2138
+You can append table name to column name such as :book.title and :book.author.
2139
+Second argunet is data, embedded into column parameter.
2140
+Return value is L<DBIx::Custom::Result> object when select statement is executed,
2141
+or the count of affected rows when insert, update, delete statement is executed.
2142
+
2143
+Named placeholder such as C<:title> is replaced by placeholder C<?>.
2144
+    
2145
+    # Original
2146
+    select * from book where title = :title and author like :author
2147
+    
2148
+    # Replaced
2149
+    select * from where title = ? and author like ?;
2150
+
2151
+You can specify operator with named placeholder
2152
+ by C<name{operator}> syntax.
2153
+
2154
+    # Original
2155
+    select * from book where :title{=} and :author{like}
2156
+    
2157
+    # Replaced
2158
+    select * from where title = ? and author like ?;
2159
+
2160
+Note that colons in time format such as 12:13:15 is exeption,
2161
+it is not parsed as named placeholder.
2162
+If you want to use colon generally, you must escape it by C<\\>
2163
+
2164
+    select * from where title = "aa\\:bb";
2165
+
2166
+The following opitons are available.
2167
+
2168
+=over 4
2169
+
2170
+=item C<filter>
2171
+    
2172
+    filter => {
2173
+        title  => sub { uc $_[0] }
2174
+        author => sub { uc $_[0] }
2175
+    }
2176
+
2177
+    # Filter name
2178
+    filter => {
2179
+        title  => 'upper_case',
2180
+        author => 'upper_case'
2181
+    }
2182
+        
2183
+    # At once
2184
+    filter => [
2185
+        [qw/title author/]  => sub { uc $_[0] }
2186
+    ]
2187
+
2188
+Filter. You can set subroutine or filter name
2189
+registered by by C<register_filter>.
2190
+This filter is executed before data is saved into database.
2191
+and before type rule filter is executed.
2192
+
2193
+=item C<query>
2194
+
2195
+    query => 1
2196
+
2197
+C<execute> method return L<DBIx::Custom::Query> object, not executing SQL.
2198
+You can check SQL or get statment handle.
2199
+
2200
+    my $sql = $query->sql;
2201
+    my $sth = $query->sth;
2202
+    my $columns = $query->columns;
2203
+    
2204
+If you want to execute SQL fast, you can do the following way.
2205
+
2206
+    my $query;
2207
+    foreach my $row (@$rows) {
2208
+      $query ||= $dbi->insert($row, table => 'table1', query => 1);
2209
+      $dbi->execute($query, $row, filter => {ab => sub { $_[0] * 2 }});
2210
+    }
2211
+
2212
+Statement handle is reused and SQL parsing is finished,
2213
+so you can get more performance than normal way.
2214
+
2215
+If you want to execute SQL as possible as fast and don't need filtering.
2216
+You can do the following way.
2217
+    
2218
+    my $query;
2219
+    my $sth;
2220
+    foreach my $row (@$rows) {
2221
+      $query ||= $dbi->insert($row, table => 'book', query => 1);
2222
+      $sth ||= $query->sth;
2223
+      $sth->execute(map { $row->{$_} } sort keys %$row);
2224
+    }
2225
+
2226
+Note that $row must be simple hash reference, such as
2227
+{title => 'Perl', author => 'Ken'}.
2228
+and don't forget to sort $row values by $row key asc order.
2229
+
2230
+=item C<table>
2231
+    
2232
+    table => 'author'
2233
+
2234
+If you want to omit table name in column name
2235
+and enable C<into1> and C<into2> type filter,
2236
+You must set C<table> option.
2237
+
2238
+    $dbi->execute("select * from book where title = :title and author = :author",
2239
+        {title => 'Perl', author => 'Ken', table => 'book');
2240
+
2241
+    # Same
2242
+    $dbi->execute(
2243
+      "select * from book where title = :book.title and author = :book.author",
2244
+      {title => 'Perl', author => 'Ken');
2245
+
2246
+=item C<bind_type>
2247
+
2248
+Specify database bind data type.
2249
+
2250
+    bind_type => [image => DBI::SQL_BLOB]
2251
+    bind_type => [[qw/image audio/] => DBI::SQL_BLOB]
2252
+
2253
+This is used to bind parameter by C<bind_param> of statment handle.
2254
+
2255
+    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2256
+
2257
+=item C<table_alias> EXPERIMENTAL
2258
+
2259
+    table_alias => {user => 'hiker'}
2260
+
2261
+Table alias. Key is real table name, value is alias table name.
2262
+If you set C<table_alias>, you can enable C<into1> and C<into2> type rule
2263
+on alias table name.
2264
+
2265
+=item C<type_rule_off> EXPERIMENTAL
2266
+
2267
+    type_rule_off => 1
2268
+
2269
+Turn C<into1> and C<into2> type rule off.
2270
+
2271
+=item C<type_rule1_off> EXPERIMENTAL
2272
+
2273
+    type_rule1_off => 1
2274
+
2275
+Turn C<into1> type rule off.
2276
+
2277
+=item C<type_rule2_off> EXPERIMENTAL
2278
+
2279
+    type_rule2_off => 1
2280
+
2281
+Turn C<into2> type rule off.
2282
+
2283
+=back
2284
+
2285
+=head2 C<delete>
2286
+
2287
+    $dbi->delete(table => 'book', where => {title => 'Perl'});
2288
+
2289
+Execute delete statement.
2290
+
2291
+The following opitons are available.
2292
+
2293
+=over 4
2294
+
2295
+=item C<append>
2296
+
2297
+Same as C<select> method's C<append> option.
2298
+
2299
+=item C<filter>
2300
+
2301
+Same as C<execute> method's C<filter> option.
2302
+
2303
+=item C<id>
2304
+
2305
+    id => 4
2306
+    id => [4, 5]
2307
+
2308
+ID corresponding to C<primary_key>.
2309
+You can delete rows by C<id> and C<primary_key>.
2310
+
2311
+    $dbi->delete(
2312
+        parimary_key => ['id1', 'id2'],
2313
+        id => [4, 5],
2314
+        table => 'book',
2315
+    );
2316
+
2317
+The above is same as the followin one.
2318
+
2319
+    $dbi->delete(where => {id1 => 4, id2 => 5}, table => 'book');
2320
+
2321
+=item C<prefix>
2322
+
2323
+    prefix => 'some'
2324
+
2325
+prefix before table name section.
2326
+
2327
+    delete some from book
2328
+
2329
+=item C<query>
2330
+
2331
+Same as C<execute> method's C<query> option.
2332
+
2333
+=item C<table>
2334
+
2335
+    table => 'book'
2336
+
2337
+Table name.
2338
+
2339
+=item C<where>
2340
+
2341
+Same as C<select> method's C<where> option.
2342
+
2343
+=item C<primary_key>
2344
+
2345
+See C<id> option.
2346
+
2347
+=item C<bind_type>
2348
+
2349
+Same as C<execute> method's C<bind_type> option.
2350
+
2351
+=item C<type_rule_off> EXPERIMENTAL
2352
+
2353
+Same as C<execute> method's C<type_rule_off> option.
2354
+
2355
+=item C<type_rule1_off> EXPERIMENTAL
2356
+
2357
+    type_rule1_off => 1
2358
+
2359
+Same as C<execute> method's C<type_rule1_off> option.
2360
+
2361
+=item C<type_rule2_off> EXPERIMENTAL
2362
+
2363
+    type_rule2_off => 1
2364
+
2365
+Same as C<execute> method's C<type_rule2_off> option.
2366
+
2367
+=back
2368
+
2369
+=head2 C<delete_all>
2370
+
2371
+    $dbi->delete_all(table => $table);
2372
+
2373
+Execute delete statement for all rows.
2374
+Options is same as C<delete>.
2375
+
2376
+=head2 C<insert>
2377
+
2378
+    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
2379
+
2380
+Execute insert statement. First argument is row data. Return value is
2381
+affected row count.
2382
+
2383
+If you want to set constant value to row data, use scalar reference
2384
+as parameter value.
2385
+
2386
+    {date => \"NOW()"}
2387
+
2388
+The following opitons are available.
2389
+
2390
+=over 4
2391
+
2392
+=item C<append>
2393
+
2394
+Same as C<select> method's C<append> option.
2395
+
2396
+=item C<filter>
2397
+
2398
+Same as C<execute> method's C<filter> option.
2399
+
2400
+=item C<id>
2401
+
2402
+    id => 4
2403
+    id => [4, 5]
2404
+
2405
+ID corresponding to C<primary_key>.
2406
+You can insert a row by C<id> and C<primary_key>.
2407
+
2408
+    $dbi->insert(
2409
+        {title => 'Perl', author => 'Ken'}
2410
+        parimary_key => ['id1', 'id2'],
2411
+        id => [4, 5],
2412
+        table => 'book'
2413
+    );
2414
+
2415
+The above is same as the followin one.
2416
+
2417
+    $dbi->insert(
2418
+        {id1 => 4, id2 => 5, title => 'Perl', author => 'Ken'},
2419
+        table => 'book'
2420
+    );
2421
+
2422
+=item C<prefix>
2423
+
2424
+    prefix => 'or replace'
2425
+
2426
+prefix before table name section
2427
+
2428
+    insert or replace into book
2429
+
2430
+=item C<primary_key>
2431
+
2432
+    primary_key => 'id'
2433
+    primary_key => ['id1', 'id2']
2434
+
2435
+Primary key. This is used by C<id> option.
2436
+
2437
+=item C<query>
2438
+
2439
+Same as C<execute> method's C<query> option.
2440
+
2441
+=item C<table>
2442
+
2443
+    table => 'book'
2444
+
2445
+Table name.
2446
+
2447
+=item C<bind_type>
2448
+
2449
+Same as C<execute> method's C<bind_type> option.
2450
+
2451
+=item C<type_rule_off> EXPERIMENTAL
2452
+
2453
+Same as C<execute> method's C<type_rule_off> option.
2454
+
2455
+=item C<type_rule1_off> EXPERIMENTAL
2456
+
2457
+    type_rule1_off => 1
2458
+
2459
+Same as C<execute> method's C<type_rule1_off> option.
2460
+
2461
+=item C<type_rule2_off> EXPERIMENTAL
2462
+
2463
+    type_rule2_off => 1
2464
+
2465
+Same as C<execute> method's C<type_rule2_off> option.
2466
+
2467
+=back
2468
+
2469
+=over 4
2470
+
2471
+=head2 C<insert_param>
2472
+
2473
+    my $insert_param = $dbi->insert_param({title => 'a', age => 2});
2474
+
2475
+Create insert parameters.
2476
+
2477
+    (title, author) values (title = :title, age = :age);
2478
+
2479
+=head2 C<include_model>
2480
+
2481
+    $dbi->include_model('MyModel');
2482
+
2483
+Include models from specified namespace,
2484
+the following layout is needed to include models.
2485
+
2486
+    lib / MyModel.pm
2487
+        / MyModel / book.pm
2488
+                  / company.pm
2489
+
2490
+Name space module, extending L<DBIx::Custom::Model>.
2491
+
2492
+B<MyModel.pm>
2493
+
2494
+    package MyModel;
2495
+    use DBIx::Custom::Model -base;
2496
+    
2497
+    1;
2498
+
2499
+Model modules, extending name space module.
2500
+
2501
+B<MyModel/book.pm>
2502
+
2503
+    package MyModel::book;
2504
+    use MyModel -base;
2505
+    
2506
+    1;
2507
+
2508
+B<MyModel/company.pm>
2509
+
2510
+    package MyModel::company;
2511
+    use MyModel -base;
2512
+    
2513
+    1;
2514
+    
2515
+MyModel::book and MyModel::company is included by C<include_model>.
2516
+
2517
+You can get model object by C<model>.
2518
+
2519
+    my $book_model = $dbi->model('book');
2520
+    my $company_model = $dbi->model('company');
2521
+
2522
+See L<DBIx::Custom::Model> to know model features.
2523
+
2524
+=head2 C<map_param> EXPERIMENTAL
2525
+
2526
+    my $map_param = $dbi->map_param(
2527
+        {id => 1, authro => 'Ken', price => 1900},
2528
+        'id' => 'book.id',
2529
+        'author' => ['book.author' => sub { '%' . $_[0] . '%' }],
2530
+        'price' => [
2531
+            'book.price', {if => sub { length $_[0] }}
2532
+        ]
2533
+    );
2534
+
2535
+Map paramters to other key and value. First argument is original
2536
+parameter. this is hash reference. Rest argument is mapping.
2537
+By default, Mapping is done if the value length is not zero.
2538
+
2539
+=over 4
2540
+
2541
+=item Key mapping
2542
+
2543
+    'id' => 'book.id'
2544
+
2545
+This is only key mapping. Value is same as original one.
2546
+
2547
+    (id => 1) is mapped to ('book.id' => 1) if value length is not zero.
2548
+
2549
+=item Key and value mapping
2550
+
2551
+    'author' => ['book.author' => sub { '%' . $_[0] . '%' }]
2552
+
2553
+This is key and value mapping. Frist element of array reference
2554
+is mapped key name, second element is code reference to map the value.
2555
+
2556
+    (author => 'Ken') is mapped to ('book.author' => '%Ken%')
2557
+      if value length is not zero.
2558
+
2559
+=item Condition
2560
+
2561
+    'price' => ['book.price', {if => 'exists'}]
2562
+    'price' => ['book.price', sub { '%' . $_[0] . '%' }, {if => 'exists'}]
2563
+    'price' => ['book.price', {if => sub { defined shift }}]
2564
+
2565
+If you need condition, you can sepecify it. this is code reference
2566
+or 'exists'. By default, condition is the following one.
2567
+
2568
+    sub { defined $_[0] && length $_[0] }
2569
+
2570
+=back
2571
+
2572
+=head2 C<merge_param>
2573
+
2574
+    my $param = $dbi->merge_param({key1 => 1}, {key1 => 1, key2 => 2});
2575
+
2576
+Merge parameters.
2577
+
2578
+    {key1 => [1, 1], key2 => 2}
2579
+
2580
+=head2 C<method>
2581
+
2582
+    $dbi->method(
2583
+        update_or_insert => sub {
2584
+            my $self = shift;
2585
+            
2586
+            # Process
2587
+        },
2588
+        find_or_create   => sub {
2589
+            my $self = shift;
2590
+            
2591
+            # Process
2592
+        }
2593
+    );
2594
+
2595
+Register method. These method is called directly from L<DBIx::Custom> object.
2596
+
2597
+    $dbi->update_or_insert;
2598
+    $dbi->find_or_create;
2599
+
2600
+=head2 C<model>
2601
+
2602
+    my $model = $dbi->model('book');
2603
+
2604
+Get a L<DBIx::Custom::Model> object,
2605
+
2606
+=head2 C<mycolumn>
2607
+
2608
+    my $column = $self->mycolumn(book => ['author', 'title']);
2609
+
2610
+Create column clause for myself. The follwoing column clause is created.
2611
+
2612
+    book.author as author,
2613
+    book.title as title
2614
+
2615
+=head2 C<new>
2616
+
2617
+    my $dbi = DBIx::Custom->new(
2618
+        dsn => "dbi:mysql:database=dbname",
2619
+        user => 'ken',
2620
+        password => '!LFKD%$&',
2621
+        dbi_option => {mysql_enable_utf8 => 1}
2622
+    );
2623
+
2624
+Create a new L<DBIx::Custom> object.
2625
+
2626
+=head2 C<not_exists>
2627
+
2628
+    my $not_exists = $dbi->not_exists;
2629
+
2630
+DBIx::Custom::NotExists object, indicating the column is not exists.
2631
+This is used by C<clause> of L<DBIx::Custom::Where> .
2632
+
2633
+=head2 C<order> EXPERIMENTAL
2634
+
2635
+    my $order = $dbi->order;
2636
+
2637
+Create a new L<DBIx::Custom::Order> object.
2638
+
2639
+=head2 C<register_filter>
2640
+
2641
+    $dbi->register_filter(
2642
+        # Time::Piece object to database DATE format
2643
+        tp_to_date => sub {
2644
+            my $tp = shift;
2645
+            return $tp->strftime('%Y-%m-%d');
2646
+        },
2647
+        # database DATE format to Time::Piece object
2648
+        date_to_tp => sub {
2649
+           my $date = shift;
2650
+           return Time::Piece->strptime($date, '%Y-%m-%d');
2651
+        }
2652
+    );
2653
+    
2654
+Register filters, used by C<filter> option of many methods.
2655
+
2656
+=head2 C<type_rule> EXPERIMENTAL
2657
+
2658
+    $dbi->type_rule(
2659
+        into1 => {
2660
+            date => sub { ... },
2661
+            datetime => sub { ... }
2662
+        },
2663
+        into2 => {
2664
+            date => sub { ... },
2665
+            datetime => sub { ... }
2666
+        },
2667
+        from1 => {
2668
+            # DATE
2669
+            9 => sub { ... },
2670
+            # DATETIME or TIMESTAMP
2671
+            11 => sub { ... },
2672
+        }
2673
+        from2 => {
2674
+            # DATE
2675
+            9 => sub { ... },
2676
+            # DATETIME or TIMESTAMP
2677
+            11 => sub { ... },
2678
+        }
2679
+    );
2680
+
2681
+Filtering rule when data is send into and get from database.
2682
+This has a little complex problem.
2683
+
2684
+In C<into1> and C<into2> you can specify
2685
+type name as same as type name defined
2686
+by create table, such as C<DATETIME> or C<DATE>.
2687
+
2688
+Note that type name and data type don't contain upper case.
2689
+If these contain upper case charactor, you convert it to lower case.
2690
+
2691
+C<into2> is executed after C<into1>.
2692
+
2693
+Type rule of C<into1> and C<into2> is enabled on the following
2694
+column name.
2695
+
2696
+=over 4
2697
+
2698
+=item 1. column name
2699
+
2700
+    issue_date
2701
+    issue_datetime
2702
+
2703
+This need C<table> option in each method.
2704
+
2705
+=item 2. table name and column name, separator is dot
2706
+
2707
+    book.issue_date
2708
+    book.issue_datetime
2709
+
2710
+=back
2711
+
2712
+You get all type name used in database by C<available_type_name>.
2713
+
2714
+    print $dbi->available_type_name;
2715
+
2716
+In C<from1> and C<from2> you specify data type, not type name.
2717
+C<from2> is executed after C<from1>.
2718
+You get all data type by C<available_data_type>.
2719
+
2720
+    print $dbi->available_data_type;
2721
+
2722
+You can also specify multiple types at once.
2723
+
2724
+    $dbi->type_rule(
2725
+        into1 => [
2726
+            [qw/DATE DATETIME/] => sub { ... },
2727
+        ],
2728
+    );
2729
+
2730
+=head2 C<select>
2731
+
2732
+    my $result = $dbi->select(
2733
+        table  => 'book',
2734
+        column => ['author', 'title'],
2735
+        where  => {author => 'Ken'},
2736
+    );
2737
+    
2738
+Execute select statement.
2739
+
2740
+The following opitons are available.
2741
+
2742
+=over 4
2743
+
2744
+=item C<append>
2745
+
2746
+    append => 'order by title'
2747
+
2748
+Append statement to last of SQL.
2749
+    
2750
+=item C<column>
2751
+    
2752
+    column => 'author'
2753
+    column => ['author', 'title']
2754
+
2755
+Column clause.
2756
+    
2757
+if C<column> is not specified, '*' is set.
2758
+
2759
+    column => '*'
2760
+
2761
+You can specify hash of array reference.
2762
+
2763
+    column => [
2764
+        {book => [qw/author title/]},
2765
+        {person => [qw/name age/]}
2766
+    ]
2767
+
2768
+This is expanded to the following one by using C<colomn> method.
2769
+
2770
+    book.author as "book.author",
2771
+    book.title as "book.title",
2772
+    person.name as "person.name",
2773
+    person.age as "person.age"
2774
+
2775
+You can specify array of array reference, first argument is
2776
+column name, second argument is alias.
2777
+
2778
+    column => [
2779
+        ['date(book.register_datetime)' => 'book.register_date']
2780
+    ];
2781
+
2782
+Alias is quoted properly and joined.
2783
+
2784
+    date(book.register_datetime) as "book.register_date"
2785
+
2786
+=item C<filter>
2787
+
2788
+Same as C<execute> method's C<filter> option.
2789
+
2790
+=item C<id>
2791
+
2792
+    id => 4
2793
+    id => [4, 5]
2794
+
2795
+ID corresponding to C<primary_key>.
2796
+You can select rows by C<id> and C<primary_key>.
2797
+
2798
+    $dbi->select(
2799
+        parimary_key => ['id1', 'id2'],
2800
+        id => [4, 5],
2801
+        table => 'book'
2802
+    );
2803
+
2804
+The above is same as the followin one.
2805
+
2806
+    $dbi->select(
2807
+        where => {id1 => 4, id2 => 5},
2808
+        table => 'book'
2809
+    );
2810
+    
2811
+=item C<param> EXPERIMETNAL
2812
+
2813
+    param => {'table2.key3' => 5}
2814
+
2815
+Parameter shown before where clause.
2816
+    
2817
+For example, if you want to contain tag in join clause, 
2818
+you can pass parameter by C<param> option.
2819
+
2820
+    join  => ['inner join (select * from table2 where table2.key3 = :table2.key3)' . 
2821
+              ' as table2 on table1.key1 = table2.key1']
2822
+
2823
+=itme C<prefix>
2824
+
2825
+    prefix => 'SQL_CALC_FOUND_ROWS'
2826
+
2827
+Prefix of column cluase
2828
+
2829
+    select SQL_CALC_FOUND_ROWS title, author from book;
2830
+
2831
+=item C<join>
2832
+
2833
+    join => [
2834
+        'left outer join company on book.company_id = company_id',
2835
+        'left outer join location on company.location_id = location.id'
2836
+    ]
2837
+        
2838
+Join clause. If column cluase or where clause contain table name like "company.name",
2839
+join clausees needed when SQL is created is used automatically.
2840
+
2841
+    $dbi->select(
2842
+        table => 'book',
2843
+        column => ['company.location_id as location_id'],
2844
+        where => {'company.name' => 'Orange'},
2845
+        join => [
2846
+            'left outer join company on book.company_id = company.id',
2847
+            'left outer join location on company.location_id = location.id'
2848
+        ]
2849
+    );
2850
+
2851
+In above select, column and where clause contain "company" table,
2852
+the following SQL is created
2853
+
2854
+    select company.location_id as location_id
2855
+    from book
2856
+      left outer join company on book.company_id = company.id
2857
+    where company.name = ?;
2858
+
2859
+You can specify two table by yourself. This is useful when join parser can't parse
2860
+the join clause correctly. This is EXPERIMENTAL.
2861
+
2862
+    $dbi->select(
2863
+        table => 'book',
2864
+        column => ['company.location_id as location_id'],
2865
+        where => {'company.name' => 'Orange'},
2866
+        join => [
2867
+            {
2868
+                clause => 'left outer join location on company.location_id = location.id',
2869
+                table => ['company', 'location']
2870
+            }
2871
+        ]
2872
+    );
2873
+
2874
+=item C<primary_key>
2875
+
2876
+    primary_key => 'id'
2877
+    primary_key => ['id1', 'id2']
2878
+
2879
+Primary key. This is used by C<id> option.
2880
+
2881
+=item C<query>
2882
+
2883
+Same as C<execute> method's C<query> option.
2884
+
2885
+=item C<bind_type>
2886
+
2887
+Same as C<execute> method's C<bind_type> option.
2888
+
2889
+=item C<table>
2890
+
2891
+    table => 'book'
2892
+
2893
+Table name.
2894
+
2895
+=item C<type_rule_off> EXPERIMENTAL
2896
+
2897
+Same as C<execute> method's C<type_rule_off> option.
2898
+
2899
+=item C<type_rule1_off> EXPERIMENTAL
2900
+
2901
+    type_rule1_off => 1
2902
+
2903
+Same as C<execute> method's C<type_rule1_off> option.
2904
+
2905
+=item C<type_rule2_off> EXPERIMENTAL
2906
+
2907
+    type_rule2_off => 1
2908
+
2909
+Same as C<execute> method's C<type_rule2_off> option.
2910
+
2911
+=item C<where>
2912
+    
2913
+    # Hash refrence
2914
+    where => {author => 'Ken', 'title' => 'Perl'}
2915
+    
2916
+    # DBIx::Custom::Where object
2917
+    where => $dbi->where(
2918
+        clause => ['and', 'author = :author', 'title like :title'],
2919
+        param  => {author => 'Ken', title => '%Perl%'}
2920
+    );
2921
+    
2922
+    # Array reference 1 (array reference, hash referenc). same as above
2923
+    where => [
2924
+        ['and', 'author = :author', 'title like :title'],
2925
+        {author => 'Ken', title => '%Perl%'}
2926
+    ];    
2927
+    
2928
+    # Array reference 2 (String, hash reference)
2929
+    where => [
2930
+        'title like :title',
2931
+        {title => '%Perl%'}
2932
+    ]
2933
+    
2934
+    # String
2935
+    where => 'title is null'
2936
+
2937
+Where clause.
2938
+    
2939
+=item C<wrap> EXPERIMENTAL
2940
+
2941
+Wrap statement. This is array reference.
2942
+
2943
+    $dbi->select(wrap => ['select * from (', ') as t where ROWNUM < 10']);
2944
+
2945
+This option is for Oracle and SQL Server paging process.
2946
+
2947
+=back
2948
+
2949
+=head2 C<update>
2950
+
2951
+    $dbi->update({title => 'Perl'}, table  => 'book', where  => {id => 4});
2952
+
2953
+Execute update statement. First argument is update row data.
2954
+
2955
+If you want to set constant value to row data, use scalar reference
2956
+as parameter value.
2957
+
2958
+    {date => \"NOW()"}
2959
+
2960
+The following opitons are available.
2961
+
2962
+=over 4
2963
+
2964
+=item C<append>
2965
+
2966
+Same as C<select> method's C<append> option.
2967
+
2968
+=item C<filter>
2969
+
2970
+Same as C<execute> method's C<filter> option.
2971
+
2972
+=item C<id>
2973
+
2974
+    id => 4
2975
+    id => [4, 5]
2976
+
2977
+ID corresponding to C<primary_key>.
2978
+You can update rows by C<id> and C<primary_key>.
2979
+
2980
+    $dbi->update(
2981
+        {title => 'Perl', author => 'Ken'}
2982
+        parimary_key => ['id1', 'id2'],
2983
+        id => [4, 5],
2984
+        table => 'book'
2985
+    );
2986
+
2987
+The above is same as the followin one.
2988
+
2989
+    $dbi->update(
2990
+        {title => 'Perl', author => 'Ken'}
2991
+        where => {id1 => 4, id2 => 5},
2992
+        table => 'book'
2993
+    );
2994
+
2995
+=item C<prefix>
2996
+
2997
+    prefix => 'or replace'
2998
+
2999
+prefix before table name section
3000
+
3001
+    update or replace book
3002
+
3003
+=item C<primary_key>
3004
+
3005
+    primary_key => 'id'
3006
+    primary_key => ['id1', 'id2']
3007
+
3008
+Primary key. This is used by C<id> option.
3009
+
3010
+=item C<query>
3011
+
3012
+Same as C<execute> method's C<query> option.
3013
+
3014
+=item C<table>
3015
+
3016
+    table => 'book'
3017
+
3018
+Table name.
3019
+
3020
+=item C<where>
3021
+
3022
+Same as C<select> method's C<where> option.
3023
+
3024
+=item C<bind_type>
3025
+
3026
+Same as C<execute> method's C<bind_type> option.
3027
+
3028
+=item C<type_rule_off> EXPERIMENTAL
3029
+
3030
+Same as C<execute> method's C<type_rule_off> option.
3031
+
3032
+=item C<type_rule1_off> EXPERIMENTAL
3033
+
3034
+    type_rule1_off => 1
3035
+
3036
+Same as C<execute> method's C<type_rule1_off> option.
3037
+
3038
+=item C<type_rule2_off> EXPERIMENTAL
3039
+
3040
+    type_rule2_off => 1
3041
+
3042
+Same as C<execute> method's C<type_rule2_off> option.
3043
+
3044
+=back
3045
+
3046
+=head2 C<update_all>
3047
+
3048
+    $dbi->update_all({title => 'Perl'}, table => 'book', );
3049
+
3050
+Execute update statement for all rows.
3051
+Options is same as C<update> method.
3052
+
3053
+=head2 C<update_param>
3054
+
3055
+    my $update_param = $dbi->update_param({title => 'a', age => 2});
3056
+
3057
+Create update parameter tag.
3058
+
3059
+    set title = :title, author = :author
3060
+
3061
+=head2 C<where>
3062
+
3063
+    my $where = $dbi->where(
3064
+        clause => ['and', 'title = :title', 'author = :author'],
3065
+        param => {title => 'Perl', author => 'Ken'}
3066
+    );
3067
+
3068
+Create a new L<DBIx::Custom::Where> object.
3069
+
3070
+=head2 C<setup_model>
3071
+
3072
+    $dbi->setup_model;
3073
+
3074
+Setup all model objects.
3075
+C<columns> of model object is automatically set, parsing database information.
3076
+
3077
+=head1 ENVIRONMENT VARIABLE
3078
+
3079
+=head2 C<DBIX_CUSTOM_DEBUG>
3080
+
3081
+If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
3082
+executed SQL and bind values are printed to STDERR.
3083
+
3084
+=head2 C<DBIX_CUSTOM_DEBUG_ENCODING>
3085
+
3086
+DEBUG output encoding. Default to UTF-8.
3087
+
3088
+=head1 DEPRECATED FUNCTIONALITIES
3089
+
3090
+L<DBIx::Custom>
3091
+
3092
+    # Attribute methods
3093
+    data_source # will be removed at 2017/1/1
3094
+    dbi_options # will be removed at 2017/1/1
3095
+    filter_check # will be removed at 2017/1/1
3096
+    reserved_word_quote # will be removed at 2017/1/1
3097
+    cache_method # will be removed at 2017/1/1
3098
+    
3099
+    # Methods
3100
+    create_query # will be removed at 2017/1/1
3101
+    apply_filter # will be removed at 2017/1/1
3102
+    select_at # will be removed at 2017/1/1
3103
+    delete_at # will be removed at 2017/1/1
3104
+    update_at # will be removed at 2017/1/1
3105
+    insert_at # will be removed at 2017/1/1
3106
+    register_tag # will be removed at 2017/1/1
3107
+    default_bind_filter # will be removed at 2017/1/1
3108
+    default_fetch_filter # will be removed at 2017/1/1
3109
+    insert_param_tag # will be removed at 2017/1/1
3110
+    register_tag_processor # will be removed at 2017/1/1
3111
+    update_param_tag # will be removed at 2017/1/1
3112
+    
3113
+    # Options
3114
+    select method relation option # will be removed at 2017/1/1
3115
+    select method param option # will be removed at 2017/1/1
3116
+    select method column option [COLUMN, as => ALIAS] format
3117
+      # will be removed at 2017/1/1
3118
+    
3119
+    # Others
3120
+    execute("select * from {= title}"); # execute method's
3121
+                                        # tag parsing functionality
3122
+                                        # will be removed at 2017/1/1
3123
+    Query caching # will be removed at 2017/1/1
3124
+
3125
+L<DBIx::Custom::Model>
3126
+
3127
+    # Attribute methods
3128
+    filter # will be removed at 2017/1/1
3129
+    name # will be removed at 2017/1/1
3130
+    type # will be removed at 2017/1/1
3131
+
3132
+L<DBIx::Custom::Query>
3133
+    
3134
+    # Attribute methods
3135
+    default_filter # will be removed at 2017/1/1
3136
+    table # will be removed at 2017/1/1
3137
+    filters # will be removed at 2017/1/1
3138
+    
3139
+    # Methods
3140
+    filter # will be removed at 2017/1/1
3141
+
3142
+L<DBIx::Custom::QueryBuilder>
3143
+    
3144
+    # Attribute methods
3145
+    tags # will be removed at 2017/1/1
3146
+    tag_processors # will be removed at 2017/1/1
3147
+    
3148
+    # Methods
3149
+    register_tag # will be removed at 2017/1/1
3150
+    register_tag_processor # will be removed at 2017/1/1
3151
+    
3152
+    # Others
3153
+    build_query("select * from {= title}"); # tag parsing functionality
3154
+                                            # will be removed at 2017/1/1
3155
+
3156
+L<DBIx::Custom::Result>
3157
+    
3158
+    # Attribute methods
3159
+    filter_check # will be removed at 2017/1/1
3160
+    
3161
+    # Methods
3162
+    end_filter # will be removed at 2017/1/1
3163
+    remove_end_filter # will be removed at 2017/1/1
3164
+    remove_filter # will be removed at 2017/1/1
3165
+    default_filter # will be removed at 2017/1/1
3166
+
3167
+L<DBIx::Custom::Tag>
3168
+
3169
+    This module is DEPRECATED! # will be removed at 2017/1/1
3170
+
3171
+=head1 BACKWORD COMPATIBLE POLICY
3172
+
3173
+If a functionality is DEPRECATED, you can know it by DEPRECATED warnings
3174
+except for attribute method.
3175
+You can check all DEPRECATED functionalities by document.
3176
+DEPRECATED functionality is removed after five years,
3177
+but if at least one person use the functionality and tell me that thing
3178
+I extend one year each time he tell me it.
3179
+
3180
+EXPERIMENTAL functionality will be changed without warnings.
3181
+
3182
+This policy was changed at 2011/6/28
3183
+
3184
+=head1 BUGS
3185
+
3186
+Please tell me bugs if found.
3187
+
3188
+C<< <kimoto.yuki at gmail.com> >>
3189
+
3190
+L<http://github.com/yuki-kimoto/DBIx-Custom>
3191
+
3192
+=head1 AUTHOR
3193
+
3194
+Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
3195
+
3196
+=head1 COPYRIGHT & LICENSE
3197
+
3198
+Copyright 2009-2011 Yuki Kimoto, all rights reserved.
3199
+
3200
+This program is free software; you can redistribute it and/or modify it
3201
+under the same terms as Perl itself.
3202
+
3203
+=cut
+603
DBIx-Custom-0.1711/blib/lib/DBIx/Custom/Guide.pod
... ...
@@ -0,0 +1,603 @@
1
+=encoding utf8
2
+
3
+=head1 NAME
4
+
5
+DBIx::Custom::Guide - DBIx::Custom Guide
6
+
7
+=head1 FEATURES
8
+
9
+L<DBIx::Custom> is the wrapper class of L<DBI> to execute SQL easily.
10
+This module have the following features.
11
+
12
+=over 4
13
+
14
+=item * Execute INSERT, UPDATE, DELETE, SELECT statement easily
15
+
16
+=item * You can specify bind values by hash reference
17
+
18
+=item * Filtering by data type. and you can set filter to any column
19
+
20
+=item * Creating where clause and order by clause flexibly
21
+
22
+=item * Support model
23
+
24
+=back
25
+
26
+=head1 GUIDE
27
+
28
+=head2 Connect to database
29
+
30
+    use DBIx::Custom;
31
+    my $dbi = DBIx::Custom->connect(
32
+        dsn => "dbi:mysql:database=bookshop",
33
+        user => 'ken',
34
+        password => '!LFKD%$&',
35
+        dbi_option => {mysql_enable_utf8 => 1}
36
+    );
37
+
38
+You can connect to database by C<connect> method.
39
+C<dsn> is data source name, C<user> is user name, C<password> is password.
40
+
41
+C<dbi_option> is L<DBI> option.
42
+By default, the following option is set.
43
+Exeption is thrown when fatal error occur and commit mode is auto commit.
44
+
45
+    {
46
+        RaiseError  =>  1
47
+        PrintError  =>  0
48
+        AutoCommit  =>  1
49
+    }
50
+
51
+=head2 Execute query
52
+
53
+=head3 Insert Statement : C<insert>
54
+
55
+If you want to execute insert statement, use C<insert> method.
56
+
57
+    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
58
+
59
+First argument is insert row data, C<table>  is table name.
60
+
61
+=head3 Update Statement : C<update>
62
+
63
+If you want to execute update stateimuse, use C<update> method.
64
+
65
+    $dbi->update(
66
+        {title => 'Perl', author => 'Ken'},
67
+        table  => 'book', 
68
+        where  => {id => 5}
69
+    );
70
+
71
+First argument is update row data, C<table> is table name, C<where> is condition.
72
+
73
+Note that you can't execute C<update> method without C<where>.
74
+If you want to update all rows, use update_all.
75
+
76
+    $dbi->update_all({title => 'Perl', author => 'Ken'}, table  => 'book');
77
+
78
+=head3 Delete Statement : C<delete>
79
+
80
+If you want to execute delete statement, use C<delete> method.
81
+
82
+    $dbi->delete(table  => 'book', where  => {author => 'Ken'});
83
+
84
+C<table> is table name, C<where> is condition.
85
+
86
+Note that you can't execute C<delete> method without C<where>.
87
+If you want to delete all rows, use C<delete_all> method.
88
+
89
+    $dbi->delete_all(table  => 'book');
90
+
91
+=head3 Select Statement : C<select>
92
+
93
+If you want to execute select statement, use C<select> method.
94
+
95
+    my $result = $dbi->select(table => 'book');
96
+
97
+Return value is L<DBIx::Custom::Result> object.
98
+You can fetch rows by C<fetch> method.
99
+
100
+    while (my $row = $result->fetch) {
101
+        my $title  = $row->[0];
102
+        my $author = $row->[1];
103
+    }
104
+
105
+See also L<Fetch row/"Fetch row"> about L<DBIx::Custom::Result>.
106
+
107
+You can specify column names by C<column> option
108
+and condition by C<where> option.
109
+
110
+    my $result = $dbi->select(
111
+        table  => 'book',
112
+        column => ['author',  'title'],
113
+        where  => {author => 'Ken'}
114
+    );
115
+
116
+You can specify join clause by C<join> option.
117
+
118
+    my $result = $dbi->select(
119
+        table  => 'book',
120
+        column => ['company.name as company_name']
121
+        where  => {'book.name' => 'Perl'},
122
+        join   => ['left outer join company on book.company_id = company.id]
123
+    );
124
+
125
+Note that join clause is joined only when C<where> or C<column> option contains table name,
126
+such as book.name.
127
+
128
+You can append statement to the end of whole statement by C<append> option.
129
+
130
+    my $result = $dbi->select(
131
+        table  => 'book',
132
+        where  => {author => 'Ken'},
133
+        append => 'for update',
134
+    );
135
+
136
+=head3 C<execute>
137
+
138
+If you want to execute SQL, use C<execute> method.
139
+
140
+    $dbi->execute("select * from book;");
141
+
142
+You can specify named placeholder.
143
+
144
+    $dbi->execute(
145
+        "select * from book title = :title and author = :author;"
146
+        {title => 'Perl', author => 'Ken'}
147
+    );
148
+
149
+:title and :author is named placeholder, which is replaced to placeholers.
150
+
151
+    select * from book title = ? and author = ?;
152
+
153
+=head3 C<dbh>
154
+
155
+    my $dbh = $dbi->dbh;
156
+
157
+Get get database handle object of L<DBI>.
158
+
159
+=head3 C<DBI> methods
160
+
161
+    $dbi->do(...);
162
+    $dbi->begin_work;
163
+
164
+You can call all methods of L<DBI> from L<DBIx::Custom> object.
165
+
166
+=head2 Fetch Rows
167
+
168
+C<select> method return value is L<DBIx::Custom::Result> object.
169
+You can fetch a row or rows by various methods.
170
+
171
+=head3 Fetch a row (array) : C<fetch>
172
+
173
+    my $row = $result->fetch;
174
+
175
+C<fetch> method fetch a row and put it into array reference.
176
+You can continue to fetch 
177
+
178
+    while (my $row = $result->fetch) {
179
+        my $title  = $row->[0];
180
+        my $author = $row->[1];
181
+    }
182
+
183
+=head3 Fetch only first row (array) : C<fetch_first>
184
+
185
+    my $row = $result->fetch_first;
186
+
187
+C<fetch_first> fetch a only first row and finish statment handle,
188
+and put it into array refrence.
189
+
190
+=head3 Fetch all rows (array) : C<fetch_all>
191
+
192
+    my $rows = $result->fetch_all;
193
+
194
+C<fetch_all> fetch all rows and put them into array of array reference.
195
+
196
+=head3 Fetch a row (hash) : C<fetch_hash>
197
+
198
+    my $row = $result->fetch_hash;
199
+
200
+C<fetch_hash> fetch a row and put it into hash reference.
201
+You can fetch a row while row exists.
202
+
203
+    while (my $row = $result->fetch_hash) {
204
+        my $title  = $row->{title};
205
+        my $author = $row->{author};
206
+    }
207
+
208
+=head3 Fetch only a first row (hash) : C<fetch_hash_first>
209
+
210
+    my $row = $result->fetch_hash_first;
211
+
212
+C<fetch_hash_first> fetch only a first row and finish statement handle,
213
+and put them into hash refrence.
214
+
215
+C<one> is C<fetch_hash_first> synonym to save word typing.
216
+
217
+    my $row = $result->one;
218
+
219
+=head3 Fetch all rows (hash) : C<fetch_hash_all>
220
+
221
+    my $rows = $result->fetch_hash_all;
222
+
223
+C<fetch_hash_all> fetch all rows and put them into array of hash reference.
224
+
225
+=head3 Statement Handle : C<sth>
226
+
227
+    my $sth = $result->sth;
228
+
229
+If you want to get statment handle, use <sth> method.
230
+
231
+=head2 Named placeholder
232
+
233
+=head3 Basic of Parameter
234
+
235
+You can embedd named placeholder into SQL.
236
+
237
+    select * from book where title = :title and author like :author;
238
+
239
+:title and :author is named placeholder
240
+
241
+Named placeholder is replaced by place holder.
242
+
243
+    select * from book where title = ? and author like ?;
244
+
245
+use C<execute> to execute SQL.
246
+
247
+    my $sql = "select * from book where title = :title and author like :author;"
248
+    $dbi->execute($sql, {title => 'Perl', author => '%Ken%'});
249
+
250
+You can specify C<filter> at C<execute>.
251
+
252
+    $dbi->execute($sql, {title => 'Perl', author => '%Ken%'}
253
+                  filter => {title => 'to_something');
254
+
255
+=head3 Manipulate same name's columns
256
+
257
+It is ok if there are same name's columns.
258
+Let's think two date comparison.
259
+
260
+    my $sql = "select * from table where date > :date and date < :date;";
261
+
262
+In this case, You specify parameter values as array reference.
263
+
264
+    my $dbi->execute($sql, {date => ['2010-10-01', '2012-02-10']});
265
+
266
+=head2 Create where clause
267
+
268
+=head3 Dinamically create where clause : where
269
+
270
+You want to search multiple conditions in many times.
271
+Let's think the following three cases.
272
+
273
+Case1: Search only C<title>
274
+
275
+    where title = :title
276
+
277
+Case2: Search only C<author>
278
+
279
+    where author = :author
280
+
281
+Case3: Search C<title> and C<author>
282
+
283
+    where title = :title and author = :author
284
+
285
+L<DBIx::Custom> support dinamic where clause creating.
286
+At first, create L<DBIx::Custom::Where> object by C<where>.
287
+
288
+    my $where = $dbi->where;
289
+
290
+Set clause by C<clause>
291
+
292
+    $where->clause(
293
+        ['and', 'title = :title, 'author = :author']
294
+    );
295
+
296
+C<clause> is the following format.
297
+
298
+    ['or' or 'and', PART1, PART1, PART1]
299
+
300
+First argument is 'or' or 'and'.
301
+Later than first argument are part which contains named placeholder.
302
+
303
+You can write more complex format.
304
+
305
+    ['and', 
306
+      'title = :title', 
307
+      ['or', 'author = :author', 'date like :date']
308
+    ]
309
+
310
+This mean "title = :title and ( author = :author or date like :date )".
311
+
312
+After setting C<clause>, set C<param>.
313
+    
314
+    $where->param({title => 'Perl'});
315
+
316
+In this example, parameter contains only title.
317
+
318
+If you execute C<string_to>, you can get where clause
319
+which contain only named placeholder.
320
+
321
+    my $where_clause = $where->to_string;
322
+
323
+Parameter name is only title, the following where clause is created.
324
+
325
+    where title = :title
326
+
327
+You can also create where clause by stringification.
328
+
329
+    my $where_clause = "$where";
330
+
331
+This is useful to embbed it into SQL. 
332
+
333
+=head3 In case where clause contains same name columns
334
+
335
+Even if same name parameters exists, you can create where clause.
336
+Let's think that there are starting date and ending date.
337
+
338
+    my $param = {start_date => '2010-11-15', end_date => '2011-11-21'};
339
+
340
+In this case, you set parameter value as array reference.
341
+
342
+    my $p = {date => ['2010-11-15', '2011-11-21']};
343
+
344
+You can embbed these values into same name parameters.
345
+
346
+    $where->clause(
347
+        ['and', 'date > :date', 'date < :date']
348
+    );
349
+    $where->param($p);
350
+
351
+If starting date isn't exists, create the following parameter.
352
+
353
+    my $p = {date => [$dbi->not_exists, '2011-11-21']};
354
+
355
+You can get DBIx::Custom::NotExists object by C<not_exists>
356
+This mean correnspondinf value isn't exists.
357
+
358
+If ending date isn't exists, create the following parameter.
359
+
360
+    my $p = {date => ['2010-11-15']};
361
+
362
+If both date isn't exists, create the following parameter.
363
+
364
+    my $p = {date => []};
365
+
366
+This logic is a little difficut. See the following ones.
367
+
368
+    my @date;
369
+    push @date, exists $param->{start_date} ? $param->{start_date}
370
+                                            : $dbi->not_exists;
371
+    push @date, $param->{end_date} if exists $param->{end_date};
372
+    my $p = {date => \@date};
373
+
374
+=head3 With C<select>
375
+
376
+You can pass L<DBIx::Custom::Where> object to C<where> of C<select>.
377
+    
378
+    my $where = $dbi->where;
379
+    $where->clause(['and', 'title = :title', 'author = :author']);
380
+    $where->param({title => 'Perl'});
381
+    my $result = $dbi->select(table => 'book', where => $where);
382
+
383
+You can also pass it to C<where> of C<update>AC<delete>
384
+
385
+=head3 With C<execute>
386
+
387
+L<DBIx::Custom::Where> object is embedded into SQL.
388
+
389
+    my $where = $dbi->where;
390
+    $where->clause(['and', 'title = :title', 'author = :author']);
391
+    $where->param({title => 'Perl'});
392
+
393
+    my $sql = <<"EOS";
394
+    select * from book;
395
+    $where
396
+    EOS
397
+
398
+    $dbi->execute($sql, $param, table => 'book');
399
+
400
+=head2 Filtering
401
+
402
+=head3 Register filter : C<register_filter>
403
+
404
+If you want to register filter, use C<register_filter>.
405
+
406
+    $dbi->register_filter(
407
+        # Time::Piece object to DATE format
408
+        tp_to_date => sub {
409
+            my $date = shift;
410
+            return $tp->strftime('%Y-%m-%d');
411
+        },
412
+        
413
+        # DATE to Time::Piece object
414
+        date_to_tp => sub {
415
+            my $date = shift;
416
+            return Time::Piece->strptime($date, '%Y-%m-%d');
417
+        },
418
+    );
419
+
420
+=head3 Filter before sending data into database : C<filter> option
421
+
422
+If you filter sending data, use C<filter> option.
423
+
424
+    $dbi->execute(
425
+        'insert into book (date) values (:date)',
426
+        {date => $tp},
427
+        filter => {date => 'tp_to_date'}
428
+    );
429
+
430
+You can use C<filter> option in C<insert>, C<update>, C<delete>, C<select> method.
431
+
432
+    $dbi->insert(
433
+        {date => $tp},
434
+        table => 'book',
435
+        filter => {date => 'tp_to_date'}
436
+    );
437
+
438
+=head3 Filter after fetching data from database.
439
+
440
+If you filter fetch data, use L<DBIx::Custom::Result>'s C<filter> method.
441
+
442
+    my $result = $dbi->select(column => 'date', table => 'book');
443
+    $result->filter(date => 'date_to_tp');
444
+    my $row = $result->one;
445
+
446
+=head2 7. Model
447
+
448
+=head3 Model
449
+
450
+you can define model extending L<DBIx::Custom::Model>
451
+to improve source code view.
452
+
453
+At first, you create basic model class extending <DBIx::Custom::Model>.
454
+Each L<DBIx::Custom> class inherit L<Object::Simple>.
455
+so you can inherit the following way.
456
+
457
+    package MyModel;
458
+    use DBIx::Custom::Model -base;
459
+
460
+Next, you create each model classes.
461
+
462
+MyModel::book
463
+
464
+    package MyModel::book;
465
+    use MyModel -base;
466
+    
467
+    sub insert { ... }
468
+    sub list { ... }
469
+
470
+MyModel::company
471
+
472
+    package MyModel::company;
473
+    use MyModel -base;
474
+    
475
+    sub insert { ... }
476
+    sub list { ... }
477
+
478
+The follwoing modules location is needed.
479
+
480
+    MyModel.pm
481
+    MyModel / book.pm
482
+            / company.pm
483
+
484
+You can include these models by C<include_model>
485
+
486
+    $dbi->include_model('MyModel');
487
+
488
+First argument is name space of model.
489
+
490
+You can use model like this.
491
+
492
+    my $result = $dbi->model('book')->list;
493
+
494
+In mode, You can use such as methods,
495
+C<insert>, C<update>, C<update_all>,
496
+C<delete>, C<delete_all>, C<select>
497
+without C<table> option.
498
+
499
+    $dbi->model('book')->insert($param);
500
+
501
+Model is L<DBIx::Custom::Model>.
502
+
503
+If you need table nameAyou can get it by C<table>.
504
+
505
+    my $table = $model->table;
506
+
507
+You can get L<DBIx::Custom>.
508
+
509
+    my $dbi = $model->dbi;
510
+
511
+You can also call all methods of L<DBIx::Custom> and L<DBI>. 
512
+
513
+    # DBIx::Custom method
514
+    $model->execute($sql);
515
+    
516
+    # DBI method
517
+    $model->begin_work;
518
+    $model->commit;
519
+
520
+If you want to get all models, you can get them by keys of C<models>.
521
+
522
+    my @models = keys %{$self->models};
523
+
524
+You can set primary key to model.
525
+
526
+   $model->primary_key(['id', 'number_id']);
527
+
528
+Primary key is used by C<insert>, C<update>, C<delete>,
529
+and C<select> methods.
530
+
531
+You can set column names
532
+
533
+    $model->columns(['id', 'number_id']);
534
+
535
+Column names is automarically set by C<setup_model>.
536
+This method is needed to be call after C<include_model>.
537
+
538
+    $dbi->setup_model;
539
+
540
+You can set C<join>
541
+
542
+    $model->join(['left outer join company on book.company_id = company.id']);
543
+
544
+C<join> is used by C<select> method.
545
+
546
+=head2 Create column clause automatically : mycolumn, column
547
+
548
+To create column clause automatically, use C<mycolumn>.
549
+Valude of C<table> and C<columns> is used.
550
+
551
+    my $mycolumns = $model->mycolumn;
552
+
553
+If C<table> is 'book'AC<column> is ['id', 'name'],
554
+the following clause is created.
555
+
556
+    book.id as id, book.name as name
557
+
558
+These column name is for removing column name ambiguities.
559
+
560
+You can create column clause from columns of other table.
561
+
562
+    my $columns = $model->column('company');
563
+
564
+If C<table> is "company", C<column> return ['id', 'name'],
565
+the following clause is created.
566
+
567
+    company.id as "company.id", company.name as "company.name"
568
+
569
+=head2 Model Examples
570
+
571
+Model examples
572
+
573
+    package MyDBI;
574
+    use DBIx::Custom -base;
575
+    
576
+    sub connect {
577
+        my $self = shift->SUPER::connect(@_);
578
+        
579
+        $self->include_model(
580
+            MyModel => [
581
+                'book',
582
+                'company'
583
+            ]
584
+        );
585
+    }
586
+    
587
+    package MyModel::book;
588
+    use DBIx::Custom::Model -base;
589
+    
590
+    has primary_key => sub { ['id'] };
591
+    
592
+    sub insert { ... }
593
+    sub list { ... }
594
+    
595
+    package MyModel::company;
596
+    use DBIx::Custom::Model -base;
597
+
598
+    has primary_key => sub { ['id'] };
599
+    
600
+    sub insert { ... }
601
+    sub list { ... }
602
+
603
+=cut
+13
DBIx-Custom-0.1711/blib/lib/DBIx/Custom/Guide/Ja.pod
... ...
@@ -0,0 +1,13 @@
1
+=encoding utf8
2
+
3
+=head1 NAME
4
+
5
+DBIx::Custom::Guide - DBIx::Customガイド
6
+
7
+=head1 LINK
8
+
9
+ドキュメントは以下のリンクに移動しました。
10
+
11
+L<http://d.hatena.ne.jp/perlcodesample/20110401/1305597081>
12
+
13
+=cut
+247
DBIx-Custom-0.1711/blib/lib/DBIx/Custom/Model.pm
... ...
@@ -0,0 +1,247 @@
1
+package DBIx::Custom::Model;
2
+use Object::Simple -base;
3
+
4
+use Carp 'croak';
5
+use DBIx::Custom::Util '_subname';
6
+
7
+# Carp trust relationship
8
+push @DBIx::Custom::CARP_NOT, __PACKAGE__;
9
+
10
+has [qw/dbi table/],
11
+    bind_type => sub { [] },
12
+    columns => sub { [] },
13
+    join => sub { [] },
14
+    primary_key => sub { [] };
15
+
16
+our $AUTOLOAD;
17
+
18
+sub AUTOLOAD {
19
+    my $self = shift;
20
+
21
+    # Method name
22
+    my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
23
+
24
+    # Method
25
+    $self->{_methods} ||= {};
26
+    if (my $method = $self->{_methods}->{$mname}) {
27
+        return $self->$method(@_)
28
+    }
29
+    elsif (my $dbi_method = $self->dbi->can($mname)) {
30
+        $self->dbi->$dbi_method(@_);
31
+    }
32
+    elsif ($self->{dbh} && (my $dbh_method = $self->dbh->can($mname))) {
33
+        $self->dbi->dbh->$dbh_method(@_);
34
+    }
35
+    else {
36
+        croak qq{Can't locate object method "$mname" via "$package" }
37
+            . _subname;
38
+    }
39
+}
40
+
41
+my @methods = qw/insert insert_at update update_at update_all
42
+                 delete delete_at delete_all select select_at/;
43
+foreach my $method (@methods) {
44
+
45
+    my $code = sub {
46
+        my $self = shift;
47
+
48
+        my @args = (
49
+            table => $self->table,
50
+            bind_type => $self->bind_type,
51
+            primary_key => $self->primary_key,
52
+            type => $self->type, # DEPRECATED!
53
+        );
54
+        push @args, (join => $self->join) if $method =~ /^select/;
55
+        unshift @args, shift if @_ % 2;
56
+        
57
+        $self->dbi->$method(@args, @_);
58
+    };
59
+    
60
+    no strict 'refs';
61
+    my $class = __PACKAGE__;
62
+    *{"${class}::$method"} = $code;
63
+}
64
+
65
+sub DESTROY { }
66
+
67
+sub method {
68
+    my $self = shift;
69
+    
70
+    # Merge
71
+    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
72
+    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
73
+    
74
+    return $self;
75
+}
76
+
77
+sub mycolumn {
78
+    my $self = shift;
79
+    my $table = shift unless ref $_[0];
80
+    my $columns = shift;
81
+    
82
+    $table ||= $self->table || '';
83
+    $columns ||= $self->columns;
84
+    
85
+    return $self->dbi->mycolumn($table, $columns);
86
+}
87
+
88
+sub new {
89
+    my $self = shift->SUPER::new(@_);
90
+    
91
+    # Check attribute names
92
+    my @attrs = keys %$self;
93
+    foreach my $attr (@attrs) {
94
+        croak qq{"$attr" is invalid attribute name } . _subname
95
+          unless $self->can($attr);
96
+    }
97
+    
98
+    return $self;
99
+}
100
+
101
+# DEPRECATED!
102
+has 'filter';
103
+has 'name';
104
+has type => sub { [] };
105
+
106
+1;
107
+
108
+=head1 NAME
109
+
110
+DBIx::Custom::Model - Model
111
+
112
+=head1 SYNOPSIS
113
+
114
+use DBIx::Custom::Table;
115
+
116
+my $table = DBIx::Custom::Model->new(table => 'books');
117
+
118
+=head1 ATTRIBUTES
119
+
120
+=head2 C<dbi>
121
+
122
+    my $dbi = $model->dbi;
123
+    $model = $model->dbi($dbi);
124
+
125
+L<DBIx::Custom> object.
126
+
127
+=head2 C<join>
128
+
129
+    my $join = $model->join;
130
+    $model = $model->join(
131
+        ['left outer join company on book.company_id = company.id']
132
+    );
133
+    
134
+Join clause, this value is passed to C<select> method.
135
+
136
+=head2 C<primary_key>
137
+
138
+    my $primary_key = $model->primary_key;
139
+    $model = $model->primary_key(['id', 'number']);
140
+
141
+Primary key,this is passed to C<insert>, C<update>,
142
+C<delete>, and C<select> method.
143
+
144
+=head2 C<table>
145
+
146
+    my $table = $model->table;
147
+    $model = $model->table('book');
148
+
149
+Table name, this is passed to C<select> method.
150
+
151
+=head2 C<bind_type>
152
+
153
+    my $type = $model->bind_type;
154
+    $model = $model->bind_type(['image' => DBI::SQL_BLOB]);
155
+    
156
+Database data type, this is used as type optioon of C<insert>, 
157
+C<update>, C<update_all>, C<delete>, C<delete_all>,
158
+C<select>, and C<execute> method
159
+
160
+=head1 METHODS
161
+
162
+L<DBIx::Custom::Model> inherits all methods from L<Object::Simple>,
163
+and you can use all methods of L<DBIx::Custom> and L<DBI>
164
+and implements the following new ones.
165
+
166
+=head2 C<delete>
167
+
168
+    $table->delete(...);
169
+    
170
+Same as C<delete> of L<DBIx::Custom> except that
171
+you don't have to specify C<table> option.
172
+
173
+=head2 C<delete_all>
174
+
175
+    $table->delete_all(...);
176
+    
177
+Same as C<delete_all> of L<DBIx::Custom> except that
178
+you don't have to specify C<table> option.
179
+
180
+=head2 C<insert>
181
+
182
+    $table->insert(...);
183
+    
184
+Same as C<insert> of L<DBIx::Custom> except that
185
+you don't have to specify C<table> option.
186
+
187
+=head2 C<method>
188
+
189
+    $model->method(
190
+        update_or_insert => sub {
191
+            my $self = shift;
192
+            
193
+            # ...
194
+        },
195
+        find_or_create   => sub {
196
+            my $self = shift;
197
+            
198
+            # ...
199
+    );
200
+
201
+Register method. These method is called directly from L<DBIx::Custom::Model> object.
202
+
203
+    $model->update_or_insert;
204
+    $model->find_or_create;
205
+
206
+=head2 C<mycolumn>
207
+
208
+    my $column = $self->mycolumn;
209
+    my $column = $self->mycolumn(book => ['author', 'title']);
210
+    my $column = $self->mycolumn(['author', 'title']);
211
+
212
+Create column clause for myself. The follwoing column clause is created.
213
+
214
+    book.author as author,
215
+    book.title as title
216
+
217
+If table name is ommited, C<table> attribute of the model is used.
218
+If column names is omitted, C<columns> attribute of the model is used.
219
+
220
+=head2 C<new>
221
+
222
+    my $table = DBIx::Custom::Table->new;
223
+
224
+Create a L<DBIx::Custom::Table> object.
225
+
226
+=head2 C<select>
227
+
228
+    $table->select(...);
229
+    
230
+Same as C<select> of L<DBIx::Custom> except that
231
+you don't have to specify C<table> option.
232
+
233
+=head2 C<update>
234
+
235
+    $table->update(...);
236
+    
237
+Same as C<update> of L<DBIx::Custom> except that
238
+you don't have to specify C<table> option.
239
+
240
+=head2 C<update_all>
241
+
242
+    $table->update_all(param => \%param);
243
+    
244
+Same as C<update_all> of L<DBIx::Custom> except that
245
+you don't have to specify table name.
246
+
247
+=cut
+108
DBIx-Custom-0.1711/blib/lib/DBIx/Custom/Order.pm
... ...
@@ -0,0 +1,108 @@
1
+package DBIx::Custom::Order;
2
+use Object::Simple -base;
3
+use overload
4
+  'bool'   => sub {1},
5
+  '""'     => sub { shift->to_string },
6
+  fallback => 1;
7
+
8
+has 'dbi',
9
+    orders => sub { [] };
10
+
11
+sub prepend {
12
+    my $self = shift;
13
+    
14
+    foreach my $order (reverse @_) {
15
+        if (ref $order eq 'ARRAY') {
16
+            my $column = shift @$order;
17
+            $column = $self->dbi->_q($column) if defined $column;
18
+            my $derection = shift @$order;
19
+            $order = $column;
20
+            $order .= " $derection" if $derection;
21
+        }
22
+        unshift @{$self->orders}, $order;
23
+    }
24
+    
25
+    return $self;
26
+}
27
+
28
+sub to_string {
29
+    my $self = shift;
30
+    
31
+    my $exists = {};
32
+    my @orders;
33
+    foreach my $order (@{$self->orders}) {
34
+        next unless defined $order;
35
+        $order =~ s/^\s+//;
36
+        $order =~ s/\s+$//;
37
+        my ($column, $direction) = split /\s+/, $order;
38
+        push @orders, $order unless $exists->{$column};
39
+        $exists->{$column} = 1;
40
+    }
41
+    
42
+    return '' unless @orders;
43
+    return 'order by ' . join(', ', @orders);
44
+}
45
+
46
+1;
47
+
48
+=head1 NAME
49
+
50
+DBIx::Custom::Order - Order by EXPERIMENTAL
51
+
52
+=head1 SYNOPSIS
53
+
54
+    # Result
55
+    my $order = DBIx::Custom::Order->new;
56
+    $order->prepend('title', 'author desc');
57
+    my $order_by = "$order";
58
+    
59
+=head1 ATTRIBUTES
60
+
61
+=head2 C<dbi>
62
+
63
+    my $dbi = $order->dbi;
64
+    $order = $order->dbi($dbi);
65
+
66
+L<DBIx::Custom> object.
67
+
68
+=head2 C<orders>
69
+
70
+    my $orders = $result->orders;
71
+    $result = $result->orders(\%orders);
72
+
73
+Parts of order by clause
74
+
75
+=head1 METHODS
76
+
77
+L<DBIx::Custom::Result> inherits all methods from L<Object::Simple>
78
+and implements the following new ones.
79
+
80
+=head2 C<prepend>
81
+
82
+    $order->prepend('title', 'author desc');
83
+
84
+Prepend order parts to C<orders>.
85
+
86
+You can pass array reference, which contain column name and direction.
87
+Column name is quoted properly
88
+    
89
+    # Column name and direction
90
+    $order->prepend(['book-title']);
91
+    $order->prepend([qw/book-title desc/]);
92
+
93
+This is expanded to the following way.
94
+
95
+    "book-title"
96
+    "book-title" desc
97
+
98
+=head2 C<to_string>
99
+
100
+    my $order_by = $order->to_string;
101
+
102
+Create order by clause. If column name is duplicated, First one is used.
103
+C<to_string> override stringification. so you can write the follwoing way.
104
+
105
+    my $order_by = "$order";
106
+
107
+=cut
108
+
+116
DBIx-Custom-0.1711/blib/lib/DBIx/Custom/Query.pm
... ...
@@ -0,0 +1,116 @@
1
+package DBIx::Custom::Query;
2
+use Object::Simple -base;
3
+
4
+use Carp 'croak';
5
+use DBIx::Custom::Util '_subname';
6
+
7
+has 'sth',
8
+    sql => '',
9
+    columns => sub { [] };
10
+
11
+# DEPRECATED!
12
+has 'default_filter';
13
+sub filters {
14
+    warn "DBIx::Custom::Query filters attribute method is DEPRECATED!";
15
+    my $self = shift;
16
+    if (@_) {
17
+        $self->{filters} = $_[0];
18
+        return $self;
19
+    }
20
+    return $self->{filters};
21
+}
22
+
23
+# DEPRECATED!
24
+sub tables {
25
+    warn "DBIx::Custom::Query tables attribute method is DEPRECATED!";
26
+    my $self = shift;
27
+    if (@_) {
28
+        $self->{tables} = $_[0];
29
+        return $self;
30
+    }
31
+    return $self->{tables} ||= [];
32
+}
33
+
34
+#DEPRECATED!
35
+sub filter {
36
+    Carp::carp "DBIx::Custom::Query filter method is DEPRECATED!";
37
+    my $self = shift;
38
+    if (@_) {
39
+        my $filter = {};
40
+        if (ref $_[0] eq 'HASH') {
41
+            $filter = $_[0];
42
+        }
43
+        else {
44
+            my $ef = @_ > 1 ? [@_] : $_[0];
45
+            for (my $i = 0; $i < @$ef; $i += 2) {
46
+                my $column = $ef->[$i];
47
+                my $f = $ef->[$i + 1];
48
+                if (ref $column eq 'ARRAY') {
49
+                    foreach my $c (@$column) {
50
+                        $filter->{$c} = $f;
51
+                    }
52
+                }
53
+                else {
54
+                    $filter->{$column} = $f;
55
+                }
56
+            }
57
+        }
58
+        foreach my $column (keys %$filter) {
59
+            my $fname = $filter->{$column};
60
+            if  (exists $filter->{$column}
61
+              && defined $fname
62
+              && ref $fname ne 'CODE') 
63
+            {
64
+                my $filters = $self->{filters} || {};
65
+                croak qq{Filter "$fname" is not registered" } . _subname
66
+                  unless exists $filters->{$fname};
67
+                $filter->{$column} = $filters->{$fname};
68
+            }
69
+        }
70
+        $self->{filter} = {%{$self->{filter} || {}}, %$filter};
71
+        return $self;
72
+    }
73
+    return $self->{filter} ||= {};
74
+}
75
+
76
+1;
77
+
78
+=head1 NAME
79
+
80
+DBIx::Custom::Query - Query
81
+
82
+=head1 SYNOPSIS
83
+    
84
+    my $query = DBIx::Custom::Query->new;
85
+    my $sth = $query->sth;
86
+    my $sql = $query->sql;
87
+    my $columns = $query->columns;
88
+    
89
+=head1 ATTRIBUTES
90
+
91
+=head2 C<columns>
92
+
93
+    my $columns = $query->columns;
94
+    $query      = $query->columns(['auhtor', 'title']);
95
+
96
+Column names.
97
+
98
+=head2 C<sql>
99
+
100
+    my $sql = $query->sql;
101
+    $query  = $query->sql('select * from books where author = ?;');
102
+
103
+SQL statement.
104
+
105
+=head2 C<sth>
106
+
107
+    my $sth = $query->sth;
108
+    $query  = $query->sth($sth);
109
+
110
+Statement handle of L<DBI>
111
+
112
+=head1 METHODS
113
+
114
+L<DBIx::Custom::Query> inherits all methods from L<Object::Simple>.
115
+
116
+=cut
+329
DBIx-Custom-0.1711/blib/lib/DBIx/Custom/QueryBuilder.pm
... ...
@@ -0,0 +1,329 @@
1
+package DBIx::Custom::QueryBuilder;
2
+
3
+use Object::Simple -base;
4
+
5
+use Carp 'croak';
6
+use DBIx::Custom::Query;
7
+use DBIx::Custom::Util '_subname';
8
+
9
+# Carp trust relationship
10
+push @DBIx::Custom::CARP_NOT, __PACKAGE__;
11
+push @DBIx::Custom::Where::CARP_NOT, __PACKAGE__;
12
+
13
+has 'dbi';
14
+
15
+sub build_query {
16
+    my ($self, $source) = @_;
17
+    
18
+    my $query;
19
+    
20
+    # Parse tag. tag is DEPRECATED!
21
+    if ($self->dbi->tag_parse && $source =~ /(\s|^)\{/) {
22
+        $query = $self->_parse_tag($source);
23
+        my $tag_count = delete $query->{tag_count};
24
+        warn qq/Tag system such as {? name} is DEPRECATED! / .
25
+             qq/use parameter system such as :name instead/
26
+          if $tag_count;
27
+        my $query2 = $self->_parse_parameter($query->sql);
28
+        $query->sql($query2->sql);
29
+        for (my $i =0; $i < @{$query->columns}; $i++) {
30
+            my $column = $query->columns->[$i];
31
+            if ($column eq 'RESERVED_PARAMETER') {
32
+                my $column2 = shift @{$query2->columns};
33
+                croak ":name syntax is wrong"
34
+                  unless defined $column2;
35
+                $query->columns->[$i] = $column2;
36
+            }
37
+        }
38
+    }
39
+    
40
+    # Parse parameter
41
+    else { $query = $self->_parse_parameter($source) }
42
+    
43
+    my $sql = $query->sql;
44
+    $sql .= ';' unless $source =~ /;$/;
45
+    $query->sql($sql);
46
+
47
+    # Check placeholder count
48
+    croak qq{Placeholder count in "$sql" must be same as column count}
49
+        . _subname
50
+      unless $self->_placeholder_count($sql) eq @{$query->columns};
51
+        
52
+    return $query;
53
+}
54
+
55
+sub _placeholder_count {
56
+    my ($self, $sql) = @_;
57
+    
58
+    # Count
59
+    $sql ||= '';
60
+    my $count = 0;
61
+    my $pos   = -1;
62
+    while (($pos = index($sql, '?', $pos + 1)) != -1) {
63
+        $count++;
64
+    }
65
+    return $count;
66
+}
67
+
68
+sub _parse_parameter {
69
+    my ($self, $source) = @_;
70
+    
71
+    # Get and replace parameters
72
+    my $sql = $source || '';
73
+    my $columns = [];
74
+    my $c = $self->dbi->safety_character;
75
+    # Parameter regex
76
+    $sql =~ s/([^:]):(\d+):([^:])/$1\\:$2\\:$3/g;
77
+    my $re = qr/(^|.*?[^\\]):([$c\.]+)(?:\{(.*?)\})?(.*)/s;
78
+    while ($sql =~ /$re/g) {
79
+        push @$columns, $2;
80
+        $sql = defined $3 ? "$1$2 $3 ?$4" : "$1?$4";
81
+    }
82
+    $sql =~ s/\\:/:/g;
83
+
84
+    # Create query
85
+    my $query = DBIx::Custom::Query->new(
86
+        sql => $sql,
87
+        columns => $columns
88
+    );
89
+    
90
+    return $query;
91
+}
92
+    
93
+# DEPRECATED!
94
+has tags => sub { {} };
95
+
96
+# DEPRECATED!
97
+sub register_tag {
98
+    my $self = shift;
99
+    
100
+    warn "register_tag is DEPRECATED!";
101
+    
102
+    # Merge tag
103
+    my $tags = ref $_[0] eq 'HASH' ? $_[0] : {@_};
104
+    $self->tags({%{$self->tags}, %$tags});
105
+    
106
+    return $self;
107
+}
108
+
109
+# DEPRECATED!
110
+sub _parse_tag {
111
+    my ($self, $source) = @_;
112
+    # Source
113
+    $source ||= '';
114
+    # Tree
115
+    my @tree;
116
+    # Value
117
+    my $value = '';
118
+    # State
119
+    my $state = 'text';
120
+    # Before charactor
121
+    my $before = '';
122
+    # Position
123
+    my $pos = 0;
124
+    # Parse
125
+    my $original = $source;
126
+    my $tag_count = 0;
127
+    while (defined(my $c = substr($source, $pos, 1))) {
128
+        # Last
129
+        last unless length $c;
130
+        # Parameter
131
+        if ($c eq ':' && (substr($source, $pos + 1, 1) || '') =~ /\w/) {
132
+            push @tree, {type => 'param'};;
133
+        }
134
+        # State is text
135
+        if ($state eq 'text') {
136
+            # Tag start charactor
137
+            if ($c eq '{') {
138
+                # Escaped charactor
139
+                if ($before eq "\\") {
140
+                    substr($value, -1, 1, '');
141
+                    $value .= $c;
142
+                }
143
+                # Tag start
144
+                else {
145
+                    # Change state
146
+                    $state = 'tag';
147
+                    # Add text
148
+                    push @tree, {type => 'text', value => $value}
149
+                      if $value;
150
+                    # Clear
151
+                    $value = '';
152
+                }
153
+            }
154
+            # Tag end charactor
155
+            elsif ($c eq '}') {
156
+                # Escaped charactor
157
+                if ($before eq "\\") {
158
+                    substr($value, -1, 1, '');
159
+                    $value .= $c;
160
+                }
161
+                # Unexpected
162
+                else {
163
+                    croak qq{Parsing error. unexpected "\}". }
164
+                        . qq{pos $pos of "$original" } . _subname
165
+                }
166
+            }
167
+            # Normal charactor
168
+            else { $value .= $c }
169
+        }
170
+        # State is tags
171
+        else {
172
+            # Tag start charactor
173
+            if ($c eq '{') {
174
+                # Escaped charactor
175
+                if ($before eq "\\") {
176
+                    substr($value, -1, 1, '');
177
+                    $value .= $c;
178
+                }
179
+                # Unexpected
180
+                else {
181
+                    croak qq{Parsing error. unexpected "\{". }
182
+                        . qq{pos $pos of "$original" } . _subname
183
+                }
184
+            }
185
+            # Tag end charactor
186
+            elsif ($c eq '}') {
187
+                # Escaped charactor
188
+                if ($before eq "\\") {
189
+                    substr($value, -1, 1, '');
190
+                    $value .= $c;
191
+                }
192
+                # Tag end
193
+                else {
194
+                    # Change state
195
+                    $state = 'text';
196
+                    # Add tag
197
+                    my ($tag_name, @tag_args) = split /\s+/, $value;
198
+                    push @tree, {type => 'tag', tag_name => $tag_name, 
199
+                                 tag_args => \@tag_args};
200
+                    # Clear
201
+                    $value = '';
202
+                    # Countup
203
+                    $tag_count++;
204
+                }
205
+            }
206
+            # Normal charactor
207
+            else { $value .= $c }
208
+        }
209
+        # Save before charactor
210
+        $before = $c;
211
+        # increment position
212
+        $pos++;
213
+    }
214
+    # Tag not finished
215
+    croak qq{Tag not finished. "$original" } . _subname
216
+      if $state eq 'tag';
217
+    # Not contains tag
218
+    return DBIx::Custom::Query->new(sql => $source, tag_count => $tag_count)
219
+      if $tag_count == 0;
220
+    # Add rest text
221
+    push @tree, {type => 'text', value => $value}
222
+      if $value;
223
+    # SQL
224
+    my $sql = '';
225
+    # All Columns
226
+    my $all_columns = [];
227
+    # Tables
228
+    my $tables = [];
229
+    # Build SQL 
230
+    foreach my $node (@tree) {
231
+        # Text
232
+        if ($node->{type} eq 'text') { $sql .= $node->{value} }
233
+        # Parameter
234
+        elsif ($node->{type} eq 'param') {
235
+            push @$all_columns, 'RESERVED_PARAMETER';
236
+        }
237
+        # Tag
238
+        else {
239
+            # Tag name
240
+            my $tag_name = $node->{tag_name};
241
+            # Tag arguments
242
+            my $tag_args = $node->{tag_args};
243
+            # Table
244
+            if ($tag_name eq 'table') {
245
+                my $table = $tag_args->[0];
246
+                push @$tables, $table;
247
+                $sql .= $table;
248
+                next;
249
+            }
250
+            # Get tag
251
+            my $tag = $self->tag_processors->{$tag_name}
252
+                             || $self->tags->{$tag_name};
253
+            # Tag is not registered
254
+            croak qq{Tag "$tag_name" is not registered } . _subname
255
+              unless $tag;
256
+            # Tag not sub reference
257
+            croak qq{Tag "$tag_name" must be sub reference } . _subname
258
+              unless ref $tag eq 'CODE';
259
+            # Execute tag
260
+            my $r = $tag->(@$tag_args);
261
+            # Check tag return value
262
+            croak qq{Tag "$tag_name" must return [STRING, ARRAY_REFERENCE] }
263
+                . _subname
264
+              unless ref $r eq 'ARRAY' && defined $r->[0] && ref $r->[1] eq 'ARRAY';
265
+            # Part of SQL statement and colum names
266
+            my ($part, $columns) = @$r;
267
+            # Add columns
268
+            push @$all_columns, @$columns;
269
+            # Join part tag to SQL
270
+            $sql .= $part;
271
+        }
272
+    }
273
+    # Query
274
+    my $query = DBIx::Custom::Query->new(
275
+        sql => $sql,
276
+        columns => $all_columns,
277
+        tables => $tables,
278
+        tag_count => $tag_count
279
+    );
280
+    return $query;
281
+}
282
+
283
+# DEPRECATED!
284
+has tag_processors => sub { {} };
285
+
286
+# DEPRECATED!
287
+sub register_tag_processor {
288
+    my $self = shift;
289
+    warn "register_tag_processor is DEPRECATED!";
290
+    # Merge tag
291
+    my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
292
+    $self->tag_processors({%{$self->tag_processors}, %{$tag_processors}});
293
+    return $self;
294
+}
295
+
296
+1;
297
+
298
+=head1 NAME
299
+
300
+DBIx::Custom::QueryBuilder - Query builder
301
+
302
+=head1 SYNOPSIS
303
+    
304
+    my $builder = DBIx::Custom::QueryBuilder->new;
305
+    my $query = $builder->build_query(
306
+        "select from table title = :title and author = :author"
307
+    );
308
+
309
+=head1 ATTRIBUTES
310
+
311
+=head2 C<dbi>
312
+
313
+    my $dbi = $builder->dbi;
314
+    $builder = $builder->dbi($dbi);
315
+
316
+L<DBIx::Custom> object.
317
+
318
+=head1 METHODS
319
+
320
+L<DBIx::Custom::QueryBuilder> inherits all methods from L<Object::Simple>
321
+and implements the following new ones.
322
+
323
+=head2 C<build_query>
324
+    
325
+    my $query = $builder->build_query($source);
326
+
327
+Create a new L<DBIx::Custom::Query> object from SQL source.
328
+
329
+=cut
+573
DBIx-Custom-0.1711/blib/lib/DBIx/Custom/Result.pm
... ...
@@ -0,0 +1,573 @@
1
+package DBIx::Custom::Result;
2
+use Object::Simple -base;
3
+
4
+use Carp 'croak';
5
+use DBIx::Custom::Util qw/_array_to_hash _subname/;
6
+
7
+has [qw/dbi sth/],
8
+    stash => sub { {} };
9
+
10
+*all = \&fetch_hash_all;
11
+
12
+sub filter {
13
+    my $self = shift;
14
+    
15
+    # Set
16
+    if (@_) {
17
+        
18
+        # Convert filter name to subroutine
19
+        my $filter = @_ == 1 ? $_[0] : [@_];
20
+        $filter = _array_to_hash($filter);
21
+        foreach my $column (keys %$filter) {
22
+            my $fname = $filter->{$column};
23
+            if  (exists $filter->{$column}
24
+              && defined $fname
25
+              && ref $fname ne 'CODE') 
26
+            {
27
+              croak qq{Filter "$fname" is not registered" } . _subname
28
+                unless exists $self->dbi->filters->{$fname};
29
+              $filter->{$column} = $self->dbi->filters->{$fname};
30
+            }
31
+        }
32
+        
33
+        # Merge
34
+        $self->{filter} = {%{$self->filter}, %$filter};
35
+        
36
+        return $self;
37
+    }
38
+    
39
+    return $self->{filter} ||= {};
40
+}
41
+
42
+sub filter_off {
43
+    my $self = shift;
44
+    $self->{filter_off} = 1;
45
+    return $self;
46
+}
47
+
48
+sub filter_on {
49
+    my $self = shift;
50
+    $self->{filter_off} = 0;
51
+    return $self;
52
+}
53
+
54
+sub fetch {
55
+    my $self = shift;
56
+    
57
+    # Info
58
+    my $columns = $self->{sth}->{NAME};
59
+    my $types = $self->{sth}->{TYPE};
60
+    
61
+    # Fetch
62
+    my @row = $self->{sth}->fetchrow_array;
63
+    return unless @row;
64
+    
65
+    # Filtering
66
+    my $type_rule1 = $self->type_rule->{from1} || {};
67
+    my $type_rule2 = $self->type_rule->{from2} || {};
68
+    my $filter = $self->filter;
69
+    my $end_filter = $self->{end_filter} || {};
70
+    for (my $i = 0; $i < @$columns; $i++) {
71
+        
72
+        # Column
73
+        my $column = $columns->[$i];
74
+        
75
+        # Type rule
76
+        my $type_filter1 = $type_rule1->{lc($types->[$i])};
77
+        $row[$i] = $type_filter1->($row[$i])
78
+          if  $type_filter1 && !$self->{type_rule_off}
79
+           && !$self->{type_rule1_off};
80
+        my $type_filter2 = $type_rule2->{lc($types->[$i])};
81
+        $row[$i] = $type_filter2->($row[$i])
82
+          if  $type_filter2 && !$self->{type_rule_off}
83
+           && !$self->{type_rule2_off};
84
+        
85
+        # Filter
86
+        my $filter  = $filter->{$column} || $self->{default_filter};
87
+        $row[$i] = $filter->($row[$i])
88
+          if $filter && !$self->{filter_off};
89
+        $row[$i] = $end_filter->{$column}->($row[$i])
90
+          if $end_filter->{$column} && !$self->{filter_off};
91
+    }
92
+
93
+    return \@row;
94
+}
95
+
96
+sub fetch_all {
97
+    my $self = shift;
98
+    
99
+    # Fetch all rows
100
+    my $rows = [];
101
+    while(my $row = $self->fetch) { push @$rows, $row}
102
+    
103
+    return $rows;
104
+}
105
+
106
+sub fetch_first {
107
+    my $self = shift;
108
+    
109
+    # Fetch
110
+    my $row = $self->fetch;
111
+    return unless $row;
112
+    
113
+    # Finish statement handle
114
+    $self->sth->finish;
115
+    
116
+    return $row;
117
+}
118
+
119
+sub fetch_hash {
120
+    my $self = shift;
121
+    
122
+    # Info
123
+    my $columns = $self->{sth}->{NAME};
124
+    my $types = $self->{sth}->{TYPE};
125
+    
126
+    # Fetch
127
+    my $row = $self->{sth}->fetchrow_arrayref;
128
+    return unless $row;
129
+
130
+    # Filter
131
+    my $hash_row = {};
132
+    my $filter  = $self->filter;
133
+    my $end_filter = $self->{end_filter} || {};
134
+    my $type_rule1 = $self->type_rule->{from1} || {};
135
+    my $type_rule2 = $self->type_rule->{from2} || {};
136
+    for (my $i = 0; $i < @$columns; $i++) {
137
+        
138
+        # Column
139
+        my $column = $columns->[$i];
140
+        $hash_row->{$column} = $row->[$i];
141
+        
142
+        # Type rule
143
+        my $type_filter1 = $type_rule1->{lc($types->[$i])};
144
+        $hash_row->{$column} = $type_filter1->($hash_row->{$column})
145
+        if  !$self->{type_rule_off} && !$self->{type_rule1_off}
146
+         && $type_filter1;
147
+        my $type_filter2 = $type_rule2->{lc($types->[$i])};
148
+        $hash_row->{$column} = $type_filter2->($hash_row->{$column})
149
+        if  !$self->{type_rule_off} && !$self->{type_rule2_off}
150
+         && $type_filter2;
151
+        
152
+        # Filter
153
+        my $f = $filter->{$column} || $self->{default_filter};
154
+        $hash_row->{$column} = $f->($hash_row->{$column})
155
+          if $f && !$self->{filter_off};
156
+        $hash_row->{$column} = $end_filter->{$column}->($hash_row->{$column})
157
+          if $end_filter->{$column} && !$self->{filter_off};
158
+    }
159
+    
160
+    return $hash_row;
161
+}
162
+
163
+sub fetch_hash_all {
164
+    my $self = shift;
165
+    
166
+    # Fetch all rows as hash
167
+    my $rows = [];
168
+    while(my $row = $self->fetch_hash) { push @$rows, $row }
169
+    
170
+    return $rows;
171
+}
172
+
173
+sub fetch_hash_first {
174
+    my $self = shift;
175
+    
176
+    # Fetch hash
177
+    my $row = $self->fetch_hash;
178
+    return unless $row;
179
+    
180
+    # Finish statement handle
181
+    $self->sth->finish;
182
+    
183
+    return $row;
184
+}
185
+
186
+sub fetch_hash_multi {
187
+    my ($self, $count) = @_;
188
+    
189
+    # Fetch multiple rows
190
+    croak 'Row count must be specified ' . _subname
191
+      unless $count;
192
+    my $rows = [];
193
+    for (my $i = 0; $i < $count; $i++) {
194
+        my $row = $self->fetch_hash;
195
+        last unless $row;
196
+        push @$rows, $row;
197
+    }
198
+    
199
+    return unless @$rows;
200
+    return $rows;
201
+}
202
+
203
+sub fetch_multi {
204
+    my ($self, $count) = @_;
205
+    
206
+    # Row count not specifed
207
+    croak 'Row count must be specified ' . _subname
208
+      unless $count;
209
+    
210
+    # Fetch multi rows
211
+    my $rows = [];
212
+    for (my $i = 0; $i < $count; $i++) {
213
+        my $row = $self->fetch;
214
+        last unless $row;
215
+        push @$rows, $row;
216
+    }
217
+    
218
+    return unless @$rows;
219
+    return $rows;
220
+}
221
+
222
+sub header { shift->sth->{NAME} }
223
+
224
+*one = \&fetch_hash_first;
225
+
226
+sub type_rule {
227
+    my $self = shift;
228
+    
229
+    if (@_) {
230
+        my $type_rule = ref $_[0] eq 'HASH' ? $_[0] : {@_};
231
+
232
+        # From
233
+        foreach my $i (1 .. 2) {
234
+            $type_rule->{"from$i"} = _array_to_hash($type_rule->{"from$i"});
235
+            foreach my $data_type (keys %{$type_rule->{"from$i"} || {}}) {
236
+                croak qq{data type of from$i section must be lower case or number}
237
+                  if $data_type =~ /[A-Z]/;
238
+                my $fname = $type_rule->{"from$i"}{$data_type};
239
+                if (defined $fname && ref $fname ne 'CODE') {
240
+                    croak qq{Filter "$fname" is not registered" } . _subname
241
+                      unless exists $self->dbi->filters->{$fname};
242
+                    
243
+                    $type_rule->{"from$i"}{$data_type} = $self->dbi->filters->{$fname};
244
+                }
245
+            }
246
+        }
247
+        $self->{type_rule} = $type_rule;
248
+        
249
+        return $self;
250
+    }
251
+    
252
+    return $self->{type_rule} || {};
253
+}
254
+
255
+sub type_rule_off {
256
+    my $self = shift;
257
+    $self->{type_rule_off} = 1;
258
+    return $self;
259
+}
260
+
261
+sub type_rule_on {
262
+    my $self = shift;
263
+    $self->{type_rule_off} = 0;
264
+    return $self;
265
+}
266
+
267
+sub type_rule1_off {
268
+    my $self = shift;
269
+    $self->{type_rule1_off} = 1;
270
+    return $self;
271
+}
272
+
273
+sub type_rule1_on {
274
+    my $self = shift;
275
+    $self->{type_rule1_off} = 0;
276
+    return $self;
277
+}
278
+
279
+sub type_rule2_off {
280
+    my $self = shift;
281
+    $self->{type_rule2_off} = 1;
282
+    return $self;
283
+}
284
+
285
+sub type_rule2_on {
286
+    my $self = shift;
287
+    $self->{type_rule2_off} = 0;
288
+    return $self;
289
+}
290
+
291
+# DEPRECATED!
292
+sub end_filter {
293
+    warn "end_filter method is DEPRECATED!";
294
+    my $self = shift;
295
+    if (@_) {
296
+        my $end_filter = {};
297
+        if (ref $_[0] eq 'HASH') { $end_filter = $_[0] }
298
+        else { 
299
+            $end_filter = _array_to_hash(
300
+                @_ > 1 ? [@_] : $_[0]
301
+            );
302
+        }
303
+        foreach my $column (keys %$end_filter) {
304
+            my $fname = $end_filter->{$column};
305
+            if  (exists $end_filter->{$column}
306
+              && defined $fname
307
+              && ref $fname ne 'CODE') 
308
+            {
309
+              croak qq{Filter "$fname" is not registered" } . _subname
310
+                unless exists $self->dbi->filters->{$fname};
311
+              $end_filter->{$column} = $self->dbi->filters->{$fname};
312
+            }
313
+        }
314
+        $self->{end_filter} = {%{$self->end_filter}, %$end_filter};
315
+        return $self;
316
+    }
317
+    return $self->{end_filter} ||= {};
318
+}
319
+# DEPRECATED!
320
+sub remove_end_filter {
321
+    warn "remove_end_filter is DEPRECATED!";
322
+    my $self = shift;
323
+    $self->{end_filter} = {};
324
+    return $self;
325
+}
326
+# DEPRECATED!
327
+sub remove_filter {
328
+    warn "remove_filter is DEPRECATED!";
329
+    my $self = shift;
330
+    $self->{filter} = {};
331
+    return $self;
332
+}
333
+# DEPRECATED!
334
+sub default_filter {
335
+    warn "default_filter is DEPRECATED!";
336
+    my $self = shift;
337
+    if (@_) {
338
+        my $fname = $_[0];
339
+        if (@_ && !$fname) {
340
+            $self->{default_filter} = undef;
341
+        }
342
+        else {
343
+            croak qq{Filter "$fname" is not registered}
344
+              unless exists $self->dbi->filters->{$fname};
345
+            $self->{default_filter} = $self->dbi->filters->{$fname};
346
+        }
347
+        return $self;
348
+    }
349
+    return $self->{default_filter};
350
+}
351
+# DEPRECATED!
352
+has 'filter_check'; 
353
+
354
+1;
355
+
356
+=head1 NAME
357
+
358
+DBIx::Custom::Result - Result of select statement
359
+
360
+=head1 SYNOPSIS
361
+
362
+    # Result
363
+    my $result = $dbi->select(table => 'book');
364
+
365
+    # Fetch a row and put it into array reference
366
+    while (my $row = $result->fetch) {
367
+        my $author = $row->[0];
368
+        my $title  = $row->[1];
369
+    }
370
+    
371
+    # Fetch only a first row and put it into array reference
372
+    my $row = $result->fetch_first;
373
+    
374
+    # Fetch all rows and put them into array of array reference
375
+    my $rows = $result->fetch_all;
376
+
377
+    # Fetch a row and put it into hash reference
378
+    while (my $row = $result->fetch_hash) {
379
+        my $title  = $row->{title};
380
+        my $author = $row->{author};
381
+    }
382
+    
383
+    # Fetch only a first row and put it into hash reference
384
+    my $row = $result->fetch_hash_first;
385
+    my $row = $result->one; # Same as fetch_hash_first
386
+    
387
+    # Fetch all rows and put them into array of hash reference
388
+    my $rows = $result->fetch_hash_all;
389
+    my $rows = $result->all; # Same as fetch_hash_all
390
+
391
+=head1 ATTRIBUTES
392
+
393
+=head2 C<dbi>
394
+
395
+    my $dbi = $result->dbi;
396
+    $result = $result->dbi($dbi);
397
+
398
+L<DBIx::Custom> object.
399
+
400
+=head2 C<sth>
401
+
402
+    my $sth = $reuslt->sth
403
+    $result = $result->sth($sth);
404
+
405
+Statement handle of L<DBI>.
406
+
407
+=head1 METHODS
408
+
409
+L<DBIx::Custom::Result> inherits all methods from L<Object::Simple>
410
+and implements the following new ones.
411
+
412
+=head2 C<all>
413
+
414
+    my $rows = $result->all;
415
+
416
+Same as C<fetch_hash_all>.
417
+
418
+=head2 C<fetch>
419
+
420
+    my $row = $result->fetch;
421
+
422
+Fetch a row and put it into array reference.
423
+
424
+=head2 C<fetch_all>
425
+
426
+    my $rows = $result->fetch_all;
427
+
428
+Fetch all rows and put them into array of array reference.
429
+
430
+=head2 C<fetch_first>
431
+
432
+    my $row = $result->fetch_first;
433
+
434
+Fetch only a first row and put it into array reference,
435
+and finish statment handle.
436
+
437
+=head2 C<fetch_hash>
438
+
439
+    my $row = $result->fetch_hash;
440
+
441
+Fetch a row and put it into hash reference.
442
+
443
+=head2 C<fetch_hash_all>
444
+
445
+    my $rows = $result->fetch_hash_all;
446
+
447
+Fetch all rows and put them into array of hash reference.
448
+
449
+=head2 C<fetch_hash_first>
450
+    
451
+    my $row = $result->fetch_hash_first;
452
+
453
+Fetch only a first row and put it into hash reference,
454
+and finish statment handle.
455
+
456
+=head2 C<fetch_hash_multi>
457
+
458
+    my $rows = $result->fetch_hash_multi(5);
459
+    
460
+Fetch multiple rows and put them into array of hash reference.
461
+
462
+=head2 C<fetch_multi>
463
+
464
+    my $rows = $result->fetch_multi(5);
465
+    
466
+Fetch multiple rows and put them into array of array reference.
467
+
468
+=head2 C<filter>
469
+
470
+    $result->filter(title  => sub { uc $_[0] }, author => 'to_upper');
471
+    $result->filter([qw/title author/] => 'to_upper');
472
+
473
+Set filter for column.
474
+You can use subroutine or filter name as filter.
475
+This filter is executed after C<type_rule> filter.
476
+
477
+=head2 C<filter_off> EXPERIMENTAL
478
+
479
+    $result = $result->filter_off;
480
+
481
+Turn filtering by C<filter> method off.
482
+By default, filterin is on.
483
+
484
+=head2 C<filter_on> EXPERIMENTAL
485
+
486
+    $result = $resutl->filter_on;
487
+
488
+Turn filtering by C<filter> method on.
489
+By default, filterin is on.
490
+
491
+=head2 C<header>
492
+
493
+    my $header = $result->header;
494
+
495
+Get header column names.
496
+
497
+=head2 C<one>
498
+
499
+    my $row = $result->one;
500
+
501
+Same as C<fetch_hash_first>.
502
+
503
+=head2 C<stash>
504
+
505
+    my $stash = $result->stash;
506
+    my $foo = $result->stash->{foo};
507
+    $result->stash->{foo} = $foo;
508
+
509
+Stash is hash reference for data.
510
+
511
+=head2 C<type_rule> EXPERIMENTAL
512
+    
513
+    # Merge type rule
514
+    $result->type_rule(
515
+        # DATE
516
+        9 => sub { ... },
517
+        # DATETIME or TIMESTAMP
518
+        11 => sub { ... }
519
+    );
520
+
521
+    # Replace type rule(by reference)
522
+    $result->type_rule([
523
+        # DATE
524
+        9 => sub { ... },
525
+        # DATETIME or TIMESTAMP
526
+        11 => sub { ... }
527
+    ]);
528
+
529
+This is same as L<DBIx::Custom>'s C<type_rule>'s <from>.
530
+
531
+=head2 C<type_rule_off> EXPERIMENTAL
532
+
533
+    $result = $result->type_rule_off;
534
+
535
+Turn C<from1> and C<from2> type rule off.
536
+By default, type rule is on.
537
+
538
+=head2 C<type_rule_on> EXPERIMENTAL
539
+
540
+    $result = $result->type_rule_on;
541
+
542
+Turn C<from1> and C<from2> type rule on.
543
+By default, type rule is on.
544
+
545
+=head2 C<type_rule1_off> EXPERIMENTAL
546
+
547
+    $result = $result->type_rule1_off;
548
+
549
+Turn C<from1> type rule off.
550
+By default, type rule is on.
551
+
552
+=head2 C<type_rule1_on> EXPERIMENTAL
553
+
554
+    $result = $result->type_rule1_on;
555
+
556
+Turn C<from1> type rule on.
557
+By default, type rule is on.
558
+
559
+=head2 C<type_rule2_off> EXPERIMENTAL
560
+
561
+    $result = $result->type_rule2_off;
562
+
563
+Turn C<from2> type rule off.
564
+By default, type rule is on.
565
+
566
+=head2 C<type_rule2_on> EXPERIMENTAL
567
+
568
+    $result = $result->type_rule2_on;
569
+
570
+Turn C<from2> type rule on.
571
+By default, type rule is on.
572
+
573
+=cut
+98
DBIx-Custom-0.1711/blib/lib/DBIx/Custom/Tag.pm
... ...
@@ -0,0 +1,98 @@
1
+package DBIx::Custom::Tag;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use Carp 'croak';
7
+use DBIx::Custom::Util '_subname';
8
+
9
+# Carp trust relationship
10
+push @DBIx::Custom::QueryBuilder::CARP_NOT, __PACKAGE__;
11
+
12
+sub equal              { _basic('=',  @_) }
13
+sub greater_than_equal { _basic('>=', @_) }
14
+sub greater_than       { _basic('>',  @_) }
15
+
16
+sub in {
17
+    my ($column, $count) = @_;
18
+    
19
+    # Check arguments
20
+    croak qq{Column name and count of values must be specified in tag "{in }" }
21
+        . _subname
22
+      unless $column && $count && $count =~ /^\d+$/;
23
+
24
+    # Part of statement
25
+    my $s = "$column in (";
26
+    for (my $i = 0; $i < $count; $i++) {
27
+        $s .= '?, ';
28
+    }
29
+    $s =~ s/, $//;
30
+    $s .= ')';
31
+    
32
+    # Columns
33
+    my $columns = [];
34
+    push @$columns, $column for (0 .. $count - 1);
35
+    
36
+    return [$s, $columns];
37
+}
38
+
39
+sub insert_param {
40
+    my @columns = @_;
41
+    
42
+    # Insert parameters
43
+    my $s = '(';
44
+    $s .= "$_, " for @columns;
45
+    $s =~ s/, $//;
46
+    $s .= ') ';
47
+    $s .= 'values (';
48
+    $s .= "?, " for @columns;
49
+    $s =~ s/, $//;
50
+    $s .= ')';
51
+    
52
+    return [$s, \@columns];
53
+}
54
+
55
+sub like               { _basic('like', @_) }
56
+sub lower_than_equal   { _basic('<=',   @_) }
57
+sub lower_than         { _basic('<',    @_) }
58
+sub not_equal          { _basic('<>',   @_) }
59
+
60
+sub placeholder {
61
+    my $column = shift;
62
+    
63
+    # Check arguments
64
+    croak qq{Column name must be specified in tag "{? }" } . _subname
65
+      unless $column;
66
+    
67
+    return ['?', [$column]];
68
+}
69
+
70
+sub update_param {
71
+    my @columns = @_;
72
+    
73
+    # Update parameters
74
+    my $s = 'set ';
75
+    $s .= "$_ = ?, " for @columns;
76
+    $s =~ s/, $//;
77
+    
78
+    return [$s, \@columns];
79
+}
80
+
81
+sub _basic {
82
+    my ($name, $column) = @_;
83
+    
84
+    # Check arguments
85
+    croak qq{Column name must be specified in tag "{$name }" } . _subname
86
+      unless $column;
87
+    
88
+    return ["$column $name ?", [$column]];
89
+}
90
+
91
+1;
92
+
93
+=head1 NAME
94
+
95
+DBIx::Custom::Tag - DEPRECATED!
96
+
97
+=cut
98
+
+41
DBIx-Custom-0.1711/blib/lib/DBIx/Custom/Util.pm
... ...
@@ -0,0 +1,41 @@
1
+package DBIx::Custom::Util;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use base 'Exporter';
7
+
8
+our @EXPORT_OK = qw/_array_to_hash _subname/;
9
+
10
+sub _array_to_hash {
11
+    my $array = shift;
12
+    
13
+    return $array if ref $array eq 'HASH';
14
+    return unless $array;
15
+    
16
+    my $hash = {};
17
+    
18
+    for (my $i = 0; $i < @$array; $i += 2) {
19
+        my $key = $array->[$i];
20
+        my $f = $array->[$i + 1];
21
+        
22
+        if (ref $key eq 'ARRAY') {
23
+            foreach my $k (@$key) {
24
+                $hash->{$k} = $f;
25
+            }
26
+        }
27
+        else {
28
+            $hash->{$key} = $f;
29
+        }
30
+    }
31
+    return $hash;
32
+}
33
+
34
+sub _subname { '(' . (caller 1)[3] . ')' }
35
+
36
+1;
37
+
38
+=head1 NAME
39
+
40
+DBIx::Custom::Util - Utility class
41
+
+208
DBIx-Custom-0.1711/blib/lib/DBIx/Custom/Where.pm
... ...
@@ -0,0 +1,208 @@
1
+package DBIx::Custom::Where;
2
+use Object::Simple -base;
3
+
4
+use Carp 'croak';
5
+use DBIx::Custom::Util '_subname';
6
+use overload 'bool' => sub {1}, fallback => 1;
7
+use overload '""' => sub { shift->to_string }, fallback => 1;
8
+
9
+# Carp trust relationship
10
+push @DBIx::Custom::CARP_NOT, __PACKAGE__;
11
+
12
+has [qw/dbi param/],
13
+    clause => sub { [] };
14
+
15
+sub new {
16
+    my $self = shift->SUPER::new(@_);
17
+    
18
+    # Check attribute names
19
+    my @attrs = keys %$self;
20
+    foreach my $attr (@attrs) {
21
+        croak qq{"$attr" is invalid attribute name (} . _subname . ")"
22
+          unless $self->can($attr);
23
+    }
24
+    
25
+    return $self;
26
+}
27
+
28
+sub to_string {
29
+    my $self = shift;
30
+    
31
+    # Check if column name is safety character;
32
+    my $safety = $self->dbi->safety_character;
33
+    if (ref $self->param eq 'HASH') {
34
+        foreach my $column (keys %{$self->param}) {
35
+            croak qq{"$column" is not safety column name (} . _subname . ")"
36
+              unless $column =~ /^[$safety\.]+$/;
37
+        }
38
+    }
39
+    # Clause
40
+    my $clause = $self->clause;
41
+    $clause = ['and', $clause] unless ref $clause eq 'ARRAY';
42
+    $clause->[0] = 'and' unless @$clause;
43
+
44
+    # Parse
45
+    my $where = [];
46
+    my $count = {};
47
+    $self->_parse($clause, $where, $count, 'and');
48
+    
49
+    # Stringify
50
+    unshift @$where, 'where' if @$where;
51
+    return join(' ', @$where);
52
+}
53
+
54
+our %VALID_OPERATIONS = map { $_ => 1 } qw/and or/;
55
+sub _parse {
56
+    my ($self, $clause, $where, $count, $op) = @_;
57
+    
58
+    # Array
59
+    if (ref $clause eq 'ARRAY') {
60
+        
61
+        # Start
62
+        push @$where, '(';
63
+        
64
+        # Operation
65
+        my $op = $clause->[0] || '';
66
+        croak qq{First argument must be "and" or "or" in where clause } .
67
+              qq{"$op" is passed} . _subname . ")"
68
+          unless $VALID_OPERATIONS{$op};
69
+        
70
+        my $pushed_array;
71
+        # Parse internal clause
72
+        for (my $i = 1; $i < @$clause; $i++) {
73
+            my $pushed = $self->_parse($clause->[$i], $where, $count, $op);
74
+            push @$where, $op if $pushed;
75
+            $pushed_array = 1 if $pushed;
76
+        }
77
+        pop @$where if $where->[-1] eq $op;
78
+        
79
+        # Undo
80
+        if ($where->[-1] eq '(') {
81
+            pop @$where;
82
+            pop @$where if ($where->[-1] || '') eq $op;
83
+        }
84
+        # End
85
+        else { push @$where, ')' }
86
+        
87
+        return $pushed_array;
88
+    }
89
+    
90
+    # String
91
+    else {
92
+        # Pushed
93
+        my $pushed;
94
+        
95
+        # Column
96
+        my $columns = $self->dbi->query_builder->build_query($clause)->columns;
97
+        if (@$columns == 0) {
98
+            push @$where, $clause;
99
+            $pushed = 1;
100
+            return $pushed;
101
+        }
102
+        elsif (@$columns != 1) {
103
+            croak qq{Each part contains one column name: "$clause" (}
104
+                  . _subname . ")";
105
+        }
106
+        
107
+        # Remove quote
108
+        my $column = $columns->[0];
109
+        if (my $q = $self->dbi->_quote) {
110
+            $q = quotemeta($q);
111
+            $column =~ s/[$q]//g;
112
+        }
113
+        
114
+        # Check safety
115
+        my $safety = $self->dbi->safety_character;
116
+        croak qq{"$column" is not safety column name (} . _subname . ")"
117
+          unless $column =~ /^[$safety\.]+$/;
118
+        
119
+        # Column count up
120
+        my $count = ++$count->{$column};
121
+        
122
+        # Push
123
+        my $param = $self->param;
124
+        if (ref $param eq 'HASH') {
125
+            if (exists $param->{$column}) {
126
+                if (ref $param->{$column} eq 'ARRAY') {
127
+                    $pushed = 1
128
+                      if  exists $param->{$column}->[$count - 1]
129
+                       && ref $param->{$column}->[$count - 1] ne 'DBIx::Custom::NotExists';
130
+                } 
131
+                elsif ($count == 1) {
132
+                    $pushed = 1;
133
+                }
134
+            }
135
+            push @$where, $clause if $pushed;
136
+        }
137
+        elsif (!defined $param) {
138
+            push @$where, $clause;
139
+            $pushed = 1;
140
+        }
141
+        else {
142
+            croak "Parameter must be hash reference or undfined value ("
143
+                . _subname . ")"
144
+        }
145
+        return $pushed;
146
+    }
147
+    return;
148
+}
149
+
150
+1;
151
+
152
+=head1 NAME
153
+
154
+DBIx::Custom::Where - Where clause
155
+
156
+=head1 SYNOPSYS
157
+
158
+    my $where = DBIx::Custom::Where->new;
159
+    my $string_where = "$where";
160
+
161
+=head1 ATTRIBUTES
162
+
163
+=head2 C<clause>
164
+
165
+    my $clause = $where->clause;
166
+    $where = $where->clause(
167
+        ['and',
168
+            'title = :title', 
169
+            ['or', 'date < :date', 'date > :date']
170
+        ]
171
+    );
172
+
173
+Where clause. Above one is expanded to the following SQL by to_string
174
+If all parameter names is exists.
175
+
176
+    "where ( title = :title and ( date < :date or date > :date ) )"
177
+
178
+=head2 C<param>
179
+
180
+    my $param = $where->param;
181
+    $where = $where->param({
182
+        title => 'Perl',
183
+        date => ['2010-11-11', '2011-03-05'],
184
+    });
185
+
186
+=head2 C<dbi>
187
+
188
+    my $dbi = $where->dbi;
189
+    $where = $where->dbi($dbi);
190
+
191
+L<DBIx::Custom> object.
192
+
193
+=head1 METHODS
194
+
195
+L<DBIx::Custom::Where> inherits all methods from L<Object::Simple>
196
+and implements the following new ones.
197
+
198
+=head2 C<to_string>
199
+
200
+    $where->to_string;
201
+
202
+Convert where clause to string.
203
+
204
+double quote is override to execute C<to_string> method.
205
+
206
+    my $string_where = "$where";
207
+
208
+=cut
DBIx-Custom-0.1711/blib/lib/auto/DBIx/Custom/.exists
No changes.
DBIx-Custom-0.1711/blib/man1/.exists
No changes.
DBIx-Custom-0.1711/blib/man3/.exists
No changes.
+1894
DBIx-Custom-0.1711/blib/man3/DBIx::Custom.3pm
... ...
@@ -0,0 +1,1894 @@
1
+.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2
+.\"
3
+.\" Standard preamble:
4
+.\" ========================================================================
5
+.de Sh \" Subsection heading
6
+.br
7
+.if t .Sp
8
+.ne 5
9
+.PP
10
+\fB\\$1\fR
11
+.PP
12
+..
13
+.de Sp \" Vertical space (when we can't use .PP)
14
+.if t .sp .5v
15
+.if n .sp
16
+..
17
+.de Vb \" Begin verbatim text
18
+.ft CW
19
+.nf
20
+.ne \\$1
21
+..
22
+.de Ve \" End verbatim text
23
+.ft R
24
+.fi
25
+..
26
+.\" Set up some character translations and predefined strings.  \*(-- will
27
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
28
+.\" double quote, and \*(R" will give a right double quote.  | will give a
29
+.\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used to
30
+.\" do unbreakable dashes and therefore won't be available.  \*(C` and \*(C'
31
+.\" expand to `' in nroff, nothing in troff, for use with C<>.
32
+.tr \(*W-|\(bv\*(Tr
33
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34
+.ie n \{\
35
+.    ds -- \(*W-
36
+.    ds PI pi
37
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
38
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
39
+.    ds L" ""
40
+.    ds R" ""
41
+.    ds C` ""
42
+.    ds C' ""
43
+'br\}
44
+.el\{\
45
+.    ds -- \|\(em\|
46
+.    ds PI \(*p
47
+.    ds L" ``
48
+.    ds R" ''
49
+'br\}
50
+.\"
51
+.\" If the F register is turned on, we'll generate index entries on stderr for
52
+.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
54
+.\" output yourself in some meaningful fashion.
55
+.if \nF \{\
56
+.    de IX
57
+.    tm Index:\\$1\t\\n%\t"\\$2"
58
+..
59
+.    nr % 0
60
+.    rr F
61
+.\}
62
+.\"
63
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
64
+.\" way too many mistakes in technical documents.
65
+.hy 0
66
+.if n .na
67
+.\"
68
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
70
+.    \" fudge factors for nroff and troff
71
+.if n \{\
72
+.    ds #H 0
73
+.    ds #V .8m
74
+.    ds #F .3m
75
+.    ds #[ \f1
76
+.    ds #] \fP
77
+.\}
78
+.if t \{\
79
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80
+.    ds #V .6m
81
+.    ds #F 0
82
+.    ds #[ \&
83
+.    ds #] \&
84
+.\}
85
+.    \" simple accents for nroff and troff
86
+.if n \{\
87
+.    ds ' \&
88
+.    ds ` \&
89
+.    ds ^ \&
90
+.    ds , \&
91
+.    ds ~ ~
92
+.    ds /
93
+.\}
94
+.if t \{\
95
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
96
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
97
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
98
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
99
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
100
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
101
+.\}
102
+.    \" troff and (daisy-wheel) nroff accents
103
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
104
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
105
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
106
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
107
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
108
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
109
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
110
+.ds ae a\h'-(\w'a'u*4/10)'e
111
+.ds Ae A\h'-(\w'A'u*4/10)'E
112
+.    \" corrections for vroff
113
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
114
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
115
+.    \" for low resolution devices (crt and lpr)
116
+.if \n(.H>23 .if \n(.V>19 \
117
+\{\
118
+.    ds : e
119
+.    ds 8 ss
120
+.    ds o a
121
+.    ds d- d\h'-1'\(ga
122
+.    ds D- D\h'-1'\(hy
123
+.    ds th \o'bp'
124
+.    ds Th \o'LP'
125
+.    ds ae ae
126
+.    ds Ae AE
127
+.\}
128
+.rm #[ #] #H #V #F C
129
+.\" ========================================================================
130
+.\"
131
+.IX Title "DBIx::Custom 3"
132
+.TH DBIx::Custom 3 "2011-08-06" "perl v5.8.8" "User Contributed Perl Documentation"
133
+.SH "NAME"
134
+DBIx::Custom \- Execute insert, update, delete, and select statement easily
135
+.SH "SYNOPSYS"
136
+.IX Header "SYNOPSYS"
137
+.Vb 1
138
+\&    use DBIx::Custom;
139
+.Ve
140
+.PP
141
+.Vb 7
142
+\&    # Connect
143
+\&    my $dbi = DBIx::Custom->connect(
144
+\&        dsn => "dbi:mysql:database=dbname",
145
+\&        user => 'ken',
146
+\&        password => '!LFKD%$&',
147
+\&        dbi_option => {mysql_enable_utf8 => 1}
148
+\&    );
149
+.Ve
150
+.PP
151
+.Vb 2
152
+\&    # Insert 
153
+\&    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
154
+.Ve
155
+.PP
156
+.Vb 3
157
+\&    # Update 
158
+\&    $dbi->update({title => 'Perl', author => 'Ken'}, table  => 'book',
159
+\&      where  => {id => 5});
160
+.Ve
161
+.PP
162
+.Vb 2
163
+\&    # Delete
164
+\&    $dbi->delete(table  => 'book', where => {author => 'Ken'});
165
+.Ve
166
+.PP
167
+.Vb 3
168
+\&    # Select
169
+\&    my $result = $dbi->select(table  => 'book',
170
+\&      column => ['title', 'author'], where  => {author => 'Ken'});
171
+.Ve
172
+.PP
173
+.Vb 11
174
+\&    # Select, more complex
175
+\&    my $result = $dbi->select(
176
+\&        table  => 'book',
177
+\&        column => [
178
+\&            {book => [qw/title author/]},
179
+\&            {company => ['name']}
180
+\&        ],
181
+\&        where  => {'book.author' => 'Ken'},
182
+\&        join => ['left outer join company on book.company_id = company.id'],
183
+\&        append => 'order by id limit 5'
184
+\&    );
185
+.Ve
186
+.PP
187
+.Vb 2
188
+\&    # Fetch
189
+\&    while (my $row = $result->fetch) {
190
+.Ve
191
+.PP
192
+.Vb 1
193
+\&    }
194
+.Ve
195
+.PP
196
+.Vb 2
197
+\&    # Fetch as hash
198
+\&    while (my $row = $result->fetch_hash) {
199
+.Ve
200
+.PP
201
+.Vb 1
202
+\&    }
203
+.Ve
204
+.PP
205
+.Vb 5
206
+\&    # Execute SQL with parameter.
207
+\&    $dbi->execute(
208
+\&        "select id from book where author = :author and title like :title",
209
+\&        {author => 'ken', title => '%Perl%'}
210
+\&    );
211
+.Ve
212
+.SH "DESCRIPTIONS"
213
+.IX Header "DESCRIPTIONS"
214
+DBIx::Custom is \s-1DBI\s0 wrapper module to execute \s-1SQL\s0 easily.
215
+This module have the following features.
216
+.IP "\(bu" 4
217
+Execute \f(CW\*(C`insert\*(C'\fR, \f(CW\*(C`update\*(C'\fR, \f(CW\*(C`delete\*(C'\fR, or \f(CW\*(C`select\*(C'\fR statement easily
218
+.IP "\(bu" 4
219
+Create \f(CW\*(C`where\*(C'\fR clause flexibly
220
+.IP "\(bu" 4
221
+Named place holder support
222
+.IP "\(bu" 4
223
+Model support
224
+.IP "\(bu" 4
225
+Connection manager support
226
+.IP "\(bu" 4
227
+Choice your favorite relational database management system,
228
+\&\f(CW\*(C`MySQL\*(C'\fR, \f(CW\*(C`SQLite\*(C'\fR, \f(CW\*(C`PostgreSQL\*(C'\fR, \f(CW\*(C`Oracle\*(C'\fR,
229
+\&\f(CW\*(C`Microsoft SQL Server\*(C'\fR, \f(CW\*(C`Microsoft Access\*(C'\fR, \f(CW\*(C`DB2\*(C'\fR or anything, 
230
+.IP "\(bu" 4
231
+Filtering by data type or column name(\s-1EXPERIMENTAL\s0)
232
+.IP "\(bu" 4
233
+Create \f(CW\*(C`order by\*(C'\fR clause flexibly(\s-1EXPERIMENTAL\s0)
234
+.SH "DOCUMENTATIONS"
235
+.IX Header "DOCUMENTATIONS"
236
+DBIx::Custom::Guide \- How to use DBIx::Custom
237
+.PP
238
+DBIx::Custom Wiki
239
+\&\- Theare are various examples.
240
+.PP
241
+Module documentations \- 
242
+DBIx::Custom::Result,
243
+DBIx::Custom::Query,
244
+DBIx::Custom::Where,
245
+DBIx::Custom::Model,
246
+DBIx::Custom::Order
247
+.SH "ATTRIBUTES"
248
+.IX Header "ATTRIBUTES"
249
+.ie n .Sh """connector"""
250
+.el .Sh "\f(CWconnector\fP"
251
+.IX Subsection "connector"
252
+.Vb 2
253
+\&    my $connector = $dbi->connector;
254
+\&    $dbi = $dbi->connector($connector);
255
+.Ve
256
+.PP
257
+Connection manager object. if \f(CW\*(C`connector\*(C'\fR is set, you can get \f(CW\*(C`dbh\*(C'\fR
258
+through connection manager. Conection manager object must have \f(CW\*(C`dbh\*(C'\fR mehtod.
259
+.PP
260
+This is DBIx::Connector example. Please pass
261
+\&\f(CW\*(C`default_dbi_option\*(C'\fR to DBIx::Connector \f(CW\*(C`new\*(C'\fR method.
262
+.PP
263
+.Vb 6
264
+\&    my $connector = DBIx::Connector->new(
265
+\&        "dbi:mysql:database=$DATABASE",
266
+\&        $USER,
267
+\&        $PASSWORD,
268
+\&        DBIx::Custom->new->default_dbi_option
269
+\&    );
270
+.Ve
271
+.PP
272
+.Vb 1
273
+\&    my $dbi = DBIx::Custom->connect(connector => $connector);
274
+.Ve
275
+.ie n .Sh """dsn"""
276
+.el .Sh "\f(CWdsn\fP"
277
+.IX Subsection "dsn"
278
+.Vb 2
279
+\&    my $dsn = $dbi->dsn;
280
+\&    $dbi = $dbi->dsn("DBI:mysql:database=dbname");
281
+.Ve
282
+.PP
283
+Data source name, used when \f(CW\*(C`connect\*(C'\fR method is executed.
284
+.ie n .Sh """dbi_option"""
285
+.el .Sh "\f(CWdbi_option\fP"
286
+.IX Subsection "dbi_option"
287
+.Vb 2
288
+\&    my $dbi_option = $dbi->dbi_option;
289
+\&    $dbi = $dbi->dbi_option($dbi_option);
290
+.Ve
291
+.PP
292
+\&\s-1DBI\s0 option, used when \f(CW\*(C`connect\*(C'\fR method is executed.
293
+Each value in option override the value of \f(CW\*(C`default_dbi_option\*(C'\fR.
294
+.ie n .Sh """default_dbi_option"""
295
+.el .Sh "\f(CWdefault_dbi_option\fP"
296
+.IX Subsection "default_dbi_option"
297
+.Vb 2
298
+\&    my $default_dbi_option = $dbi->default_dbi_option;
299
+\&    $dbi = $dbi->default_dbi_option($default_dbi_option);
300
+.Ve
301
+.PP
302
+\&\s-1DBI\s0 default option, used when \f(CW\*(C`connect\*(C'\fR method is executed,
303
+default to the following values.
304
+.PP
305
+.Vb 5
306
+\&    {
307
+\&        RaiseError => 1,
308
+\&        PrintError => 0,
309
+\&        AutoCommit => 1,
310
+\&    }
311
+.Ve
312
+.ie n .Sh """filters"""
313
+.el .Sh "\f(CWfilters\fP"
314
+.IX Subsection "filters"
315
+.Vb 2
316
+\&    my $filters = $dbi->filters;
317
+\&    $dbi = $dbi->filters(\e%filters);
318
+.Ve
319
+.PP
320
+Filters, registered by \f(CW\*(C`register_filter\*(C'\fR method.
321
+.ie n .Sh """last_sql"""
322
+.el .Sh "\f(CWlast_sql\fP"
323
+.IX Subsection "last_sql"
324
+.Vb 2
325
+\&    my $last_sql = $dbi->last_sql;
326
+\&    $dbi = $dbi->last_sql($last_sql);
327
+.Ve
328
+.PP
329
+Get last successed \s-1SQL\s0 executed by \f(CW\*(C`execute\*(C'\fR method.
330
+.ie n .Sh """models"""
331
+.el .Sh "\f(CWmodels\fP"
332
+.IX Subsection "models"
333
+.Vb 2
334
+\&    my $models = $dbi->models;
335
+\&    $dbi = $dbi->models(\e%models);
336
+.Ve
337
+.PP
338
+Models, included by \f(CW\*(C`include_model\*(C'\fR method.
339
+.ie n .Sh """password"""
340
+.el .Sh "\f(CWpassword\fP"
341
+.IX Subsection "password"
342
+.Vb 2
343
+\&    my $password = $dbi->password;
344
+\&    $dbi = $dbi->password('lkj&le`@s');
345
+.Ve
346
+.PP
347
+Password, used when \f(CW\*(C`connect\*(C'\fR method is executed.
348
+.ie n .Sh """query_builder"""
349
+.el .Sh "\f(CWquery_builder\fP"
350
+.IX Subsection "query_builder"
351
+.Vb 2
352
+\&    my $sql_class = $dbi->query_builder;
353
+\&    $dbi = $dbi->query_builder(DBIx::Custom::QueryBuilder->new);
354
+.Ve
355
+.PP
356
+Query builder, default to DBIx::Custom::QueryBuilder object.
357
+.ie n .Sh """quote"""
358
+.el .Sh "\f(CWquote\fP"
359
+.IX Subsection "quote"
360
+.Vb 2
361
+\&     my quote = $dbi->quote;
362
+\&     $dbi = $dbi->quote('"');
363
+.Ve
364
+.PP
365
+Reserved word quote.
366
+Default to double quote '"' except for mysql.
367
+In mysql, default to back quote '`'
368
+.PP
369
+You can set quote pair.
370
+.PP
371
+.Vb 1
372
+\&    $dbi->quote('[]');
373
+.Ve
374
+.ie n .Sh """result_class"""
375
+.el .Sh "\f(CWresult_class\fP"
376
+.IX Subsection "result_class"
377
+.Vb 2
378
+\&    my $result_class = $dbi->result_class;
379
+\&    $dbi = $dbi->result_class('DBIx::Custom::Result');
380
+.Ve
381
+.PP
382
+Result class, default to DBIx::Custom::Result.
383
+.ie n .Sh """safety_character"""
384
+.el .Sh "\f(CWsafety_character\fP"
385
+.IX Subsection "safety_character"
386
+.Vb 2
387
+\&    my $safety_character = $self->safety_character;
388
+\&    $dbi = $self->safety_character($character);
389
+.Ve
390
+.PP
391
+Regex of safety character for table and column name, default to '\ew'.
392
+Note that you don't have to specify like '[\ew]'.
393
+.ie n .Sh """tag_parse"""
394
+.el .Sh "\f(CWtag_parse\fP"
395
+.IX Subsection "tag_parse"
396
+.Vb 2
397
+\&    my $tag_parse = $dbi->tag_parse(0);
398
+\&    $dbi = $dbi->tag_parse;
399
+.Ve
400
+.PP
401
+Enable \s-1DEPRECATED\s0 tag parsing functionality, default to 1.
402
+If you want to disable tag parsing functionality, set to 0.
403
+.ie n .Sh """user"""
404
+.el .Sh "\f(CWuser\fP"
405
+.IX Subsection "user"
406
+.Vb 2
407
+\&    my $user = $dbi->user;
408
+\&    $dbi = $dbi->user('Ken');
409
+.Ve
410
+.PP
411
+User name, used when \f(CW\*(C`connect\*(C'\fR method is executed.
412
+.SH "METHODS"
413
+.IX Header "METHODS"
414
+DBIx::Custom inherits all methods from Object::Simple
415
+and use all methods of \s-1DBI\s0
416
+and implements the following new ones.
417
+.ie n .Sh """available_data_type"" \s-1EXPERIMENTAL\s0"
418
+.el .Sh "\f(CWavailable_data_type\fP \s-1EXPERIMENTAL\s0"
419
+.IX Subsection "available_data_type EXPERIMENTAL"
420
+.Vb 1
421
+\&    print $dbi->available_data_type;
422
+.Ve
423
+.PP
424
+Get available data types. You can use these data types
425
+in \f(CW\*(C`type rule\*(C'\fR's \f(CW\*(C`from1\*(C'\fR and \f(CW\*(C`from2\*(C'\fR section.
426
+.ie n .Sh """available_type_name"" \s-1EXPERIMENTAL\s0"
427
+.el .Sh "\f(CWavailable_type_name\fP \s-1EXPERIMENTAL\s0"
428
+.IX Subsection "available_type_name EXPERIMENTAL"
429
+.Vb 1
430
+\&    print $dbi->available_type_name;
431
+.Ve
432
+.PP
433
+Get available type names. You can use these type names in
434
+\&\f(CW\*(C`type_rule\*(C'\fR's \f(CW\*(C`into1\*(C'\fR and \f(CW\*(C`into2\*(C'\fR section.
435
+.ie n .Sh """assign_param"" \s-1EXPERIMENTAL\s0"
436
+.el .Sh "\f(CWassign_param\fP \s-1EXPERIMENTAL\s0"
437
+.IX Subsection "assign_param EXPERIMENTAL"
438
+.Vb 1
439
+\&    my $assign_param = $dbi->assign_param({title => 'a', age => 2});
440
+.Ve
441
+.PP
442
+Create assign parameter.
443
+.PP
444
+.Vb 1
445
+\&    title = :title, author = :author
446
+.Ve
447
+.PP
448
+This is equal to \f(CW\*(C`update_param\*(C'\fR exept that set is not added.
449
+.ie n .Sh """column"""
450
+.el .Sh "\f(CWcolumn\fP"
451
+.IX Subsection "column"
452
+.Vb 1
453
+\&    my $column = $dbi->column(book => ['author', 'title']);
454
+.Ve
455
+.PP
456
+Create column clause. The follwoing column clause is created.
457
+.PP
458
+.Vb 2
459
+\&    book.author as "book.author",
460
+\&    book.title as "book.title"
461
+.Ve
462
+.PP
463
+You can change separator by \f(CW\*(C`separator\*(C'\fR method.
464
+.PP
465
+.Vb 2
466
+\&    # Separator is double underbar
467
+\&    $dbi->separator('__');
468
+.Ve
469
+.PP
470
+.Vb 2
471
+\&    book.author as "book__author",
472
+\&    book.title as "book__title"
473
+.Ve
474
+.PP
475
+.Vb 2
476
+\&    # Separator is hyphen
477
+\&    $dbi->separator('-');
478
+.Ve
479
+.PP
480
+.Vb 2
481
+\&    book.author as "book-author",
482
+\&    book.title as "book-title"
483
+.Ve
484
+.ie n .Sh """connect"""
485
+.el .Sh "\f(CWconnect\fP"
486
+.IX Subsection "connect"
487
+.Vb 6
488
+\&    my $dbi = DBIx::Custom->connect(
489
+\&        dsn => "dbi:mysql:database=dbname",
490
+\&        user => 'ken',
491
+\&        password => '!LFKD%$&',
492
+\&        dbi_option => {mysql_enable_utf8 => 1}
493
+\&    );
494
+.Ve
495
+.PP
496
+Connect to the database and create a new DBIx::Custom object.
497
+.PP
498
+DBIx::Custom is a wrapper of \s-1DBI\s0.
499
+\&\f(CW\*(C`AutoCommit\*(C'\fR and \f(CW\*(C`RaiseError\*(C'\fR options are true, 
500
+and \f(CW\*(C`PrintError\*(C'\fR option is false by default.
501
+.Sh "create_model"
502
+.IX Subsection "create_model"
503
+.Vb 7
504
+\&    my $model = $dbi->create_model(
505
+\&        table => 'book',
506
+\&        primary_key => 'id',
507
+\&        join => [
508
+\&            'inner join company on book.comparny_id = company.id'
509
+\&        ],
510
+\&    );
511
+.Ve
512
+.PP
513
+Create DBIx::Custom::Model object and initialize model.
514
+the module is also used from \f(CW\*(C`model\*(C'\fR method.
515
+.PP
516
+.Vb 1
517
+\&   $dbi->model('book')->select(...);
518
+.Ve
519
+.ie n .Sh """dbh"""
520
+.el .Sh "\f(CWdbh\fP"
521
+.IX Subsection "dbh"
522
+.Vb 1
523
+\&    my $dbh = $dbi->dbh;
524
+.Ve
525
+.PP
526
+Get \s-1DBI\s0 database handle. if \f(CW\*(C`connector\*(C'\fR is set, you can get
527
+database handle through \f(CW\*(C`connector\*(C'\fR object.
528
+.ie n .Sh """each_column"""
529
+.el .Sh "\f(CWeach_column\fP"
530
+.IX Subsection "each_column"
531
+.Vb 3
532
+\&    $dbi->each_column(
533
+\&        sub {
534
+\&            my ($dbi, $table, $column, $column_info) = @_;
535
+.Ve
536
+.PP
537
+.Vb 1
538
+\&            my $type = $column_info->{TYPE_NAME};
539
+.Ve
540
+.PP
541
+.Vb 5
542
+\&            if ($type eq 'DATE') {
543
+\&                # ...
544
+\&            }
545
+\&        }
546
+\&    );
547
+.Ve
548
+.PP
549
+Iterate all column informations of all table from database.
550
+Argument is callback when one column is found.
551
+Callback receive four arguments, dbi object, table name,
552
+column name and column information.
553
+.ie n .Sh """each_table"""
554
+.el .Sh "\f(CWeach_table\fP"
555
+.IX Subsection "each_table"
556
+.Vb 3
557
+\&    $dbi->each_table(
558
+\&        sub {
559
+\&            my ($dbi, $table, $table_info) = @_;
560
+.Ve
561
+.PP
562
+.Vb 3
563
+\&            my $table_name = $table_info->{TABLE_NAME};
564
+\&        }
565
+\&    );
566
+.Ve
567
+.PP
568
+Iterate all table informationsfrom database.
569
+Argument is callback when one table is found.
570
+Callback receive three arguments, dbi object, table name,
571
+table information.
572
+.ie n .Sh """execute"""
573
+.el .Sh "\f(CWexecute\fP"
574
+.IX Subsection "execute"
575
+.Vb 4
576
+\&    my $result = $dbi->execute(
577
+\&      "select * from book where title = :title and author like :author",
578
+\&      {title => 'Perl', author => '%Ken%'}
579
+\&    );
580
+.Ve
581
+.PP
582
+.Vb 4
583
+\&    my $result = $dbi->execute(
584
+\&      "select * from book where title = :book.title and author like :book.author",
585
+\&      {'book.title' => 'Perl', 'book.author' => '%Ken%'}
586
+\&    );
587
+.Ve
588
+.PP
589
+Execute \s-1SQL\s0. \s-1SQL\s0 can contain column parameter such as :author and :title.
590
+You can append table name to column name such as :book.title and :book.author.
591
+Second argunet is data, embedded into column parameter.
592
+Return value is DBIx::Custom::Result object when select statement is executed,
593
+or the count of affected rows when insert, update, delete statement is executed.
594
+.PP
595
+Named placeholder such as \f(CW\*(C`:title\*(C'\fR is replaced by placeholder \f(CW\*(C`?\*(C'\fR.
596
+.PP
597
+.Vb 2
598
+\&    # Original
599
+\&    select * from book where title = :title and author like :author
600
+.Ve
601
+.PP
602
+.Vb 2
603
+\&    # Replaced
604
+\&    select * from where title = ? and author like ?;
605
+.Ve
606
+.PP
607
+You can specify operator with named placeholder
608
+ by \f(CW\*(C`name{operator}\*(C'\fR syntax.
609
+.PP
610
+.Vb 2
611
+\&    # Original
612
+\&    select * from book where :title{=} and :author{like}
613
+.Ve
614
+.PP
615
+.Vb 2
616
+\&    # Replaced
617
+\&    select * from where title = ? and author like ?;
618
+.Ve
619
+.PP
620
+Note that colons in time format such as 12:13:15 is exeption,
621
+it is not parsed as named placeholder.
622
+If you want to use colon generally, you must escape it by \f(CW\*(C`\e\e\*(C'\fR
623
+.PP
624
+.Vb 1
625
+\&    select * from where title = "aa\e\e:bb";
626
+.Ve
627
+.PP
628
+The following opitons are available.
629
+.ie n .IP """filter""" 4
630
+.el .IP "\f(CWfilter\fR" 4
631
+.IX Item "filter"
632
+.Vb 4
633
+\&    filter => {
634
+\&        title  => sub { uc $_[0] }
635
+\&        author => sub { uc $_[0] }
636
+\&    }
637
+.Ve
638
+.Sp
639
+.Vb 5
640
+\&    # Filter name
641
+\&    filter => {
642
+\&        title  => 'upper_case',
643
+\&        author => 'upper_case'
644
+\&    }
645
+.Ve
646
+.Sp
647
+.Vb 4
648
+\&    # At once
649
+\&    filter => [
650
+\&        [qw/title author/]  => sub { uc $_[0] }
651
+\&    ]
652
+.Ve
653
+.Sp
654
+Filter. You can set subroutine or filter name
655
+registered by by \f(CW\*(C`register_filter\*(C'\fR.
656
+This filter is executed before data is saved into database.
657
+and before type rule filter is executed.
658
+.ie n .IP """query""" 4
659
+.el .IP "\f(CWquery\fR" 4
660
+.IX Item "query"
661
+.Vb 1
662
+\&    query => 1
663
+.Ve
664
+.Sp
665
+\&\f(CW\*(C`execute\*(C'\fR method return DBIx::Custom::Query object, not executing \s-1SQL\s0.
666
+You can check \s-1SQL\s0 or get statment handle.
667
+.Sp
668
+.Vb 3
669
+\&    my $sql = $query->sql;
670
+\&    my $sth = $query->sth;
671
+\&    my $columns = $query->columns;
672
+.Ve
673
+.Sp
674
+If you want to execute \s-1SQL\s0 fast, you can do the following way.
675
+.Sp
676
+.Vb 5
677
+\&    my $query;
678
+\&    foreach my $row (@$rows) {
679
+\&      $query ||= $dbi->insert($row, table => 'table1', query => 1);
680
+\&      $dbi->execute($query, $row, filter => {ab => sub { $_[0] * 2 }});
681
+\&    }
682
+.Ve
683
+.Sp
684
+Statement handle is reused and \s-1SQL\s0 parsing is finished,
685
+so you can get more performance than normal way.
686
+.Sp
687
+If you want to execute \s-1SQL\s0 as possible as fast and don't need filtering.
688
+You can do the following way.
689
+.Sp
690
+.Vb 7
691
+\&    my $query;
692
+\&    my $sth;
693
+\&    foreach my $row (@$rows) {
694
+\&      $query ||= $dbi->insert($row, table => 'book', query => 1);
695
+\&      $sth ||= $query->sth;
696
+\&      $sth->execute(map { $row->{$_} } sort keys %$row);
697
+\&    }
698
+.Ve
699
+.Sp
700
+Note that \f(CW$row\fR must be simple hash reference, such as
701
+{title => 'Perl', author => 'Ken'}.
702
+and don't forget to sort \f(CW$row\fR values by \f(CW$row\fR key asc order.
703
+.ie n .IP """table""" 4
704
+.el .IP "\f(CWtable\fR" 4
705
+.IX Item "table"
706
+.Vb 1
707
+\&    table => 'author'
708
+.Ve
709
+.Sp
710
+If you want to omit table name in column name
711
+and enable \f(CW\*(C`into1\*(C'\fR and \f(CW\*(C`into2\*(C'\fR type filter,
712
+You must set \f(CW\*(C`table\*(C'\fR option.
713
+.Sp
714
+.Vb 2
715
+\&    $dbi->execute("select * from book where title = :title and author = :author",
716
+\&        {title => 'Perl', author => 'Ken', table => 'book');
717
+.Ve
718
+.Sp
719
+.Vb 4
720
+\&    # Same
721
+\&    $dbi->execute(
722
+\&      "select * from book where title = :book.title and author = :book.author",
723
+\&      {title => 'Perl', author => 'Ken');
724
+.Ve
725
+.ie n .IP """bind_type""" 4
726
+.el .IP "\f(CWbind_type\fR" 4
727
+.IX Item "bind_type"
728
+Specify database bind data type.
729
+.Sp
730
+.Vb 2
731
+\&    bind_type => [image => DBI::SQL_BLOB]
732
+\&    bind_type => [[qw/image audio/] => DBI::SQL_BLOB]
733
+.Ve
734
+.Sp
735
+This is used to bind parameter by \f(CW\*(C`bind_param\*(C'\fR of statment handle.
736
+.Sp
737
+.Vb 1
738
+\&    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
739
+.Ve
740
+.ie n .IP """table_alias"" \s-1EXPERIMENTAL\s0" 4
741
+.el .IP "\f(CWtable_alias\fR \s-1EXPERIMENTAL\s0" 4
742
+.IX Item "table_alias EXPERIMENTAL"
743
+.Vb 1
744
+\&    table_alias => {user => 'hiker'}
745
+.Ve
746
+.Sp
747
+Table alias. Key is real table name, value is alias table name.
748
+If you set \f(CW\*(C`table_alias\*(C'\fR, you can enable \f(CW\*(C`into1\*(C'\fR and \f(CW\*(C`into2\*(C'\fR type rule
749
+on alias table name.
750
+.ie n .IP """type_rule_off"" \s-1EXPERIMENTAL\s0" 4
751
+.el .IP "\f(CWtype_rule_off\fR \s-1EXPERIMENTAL\s0" 4
752
+.IX Item "type_rule_off EXPERIMENTAL"
753
+.Vb 1
754
+\&    type_rule_off => 1
755
+.Ve
756
+.Sp
757
+Turn \f(CW\*(C`into1\*(C'\fR and \f(CW\*(C`into2\*(C'\fR type rule off.
758
+.ie n .IP """type_rule1_off"" \s-1EXPERIMENTAL\s0" 4
759
+.el .IP "\f(CWtype_rule1_off\fR \s-1EXPERIMENTAL\s0" 4
760
+.IX Item "type_rule1_off EXPERIMENTAL"
761
+.Vb 1
762
+\&    type_rule1_off => 1
763
+.Ve
764
+.Sp
765
+Turn \f(CW\*(C`into1\*(C'\fR type rule off.
766
+.ie n .IP """type_rule2_off"" \s-1EXPERIMENTAL\s0" 4
767
+.el .IP "\f(CWtype_rule2_off\fR \s-1EXPERIMENTAL\s0" 4
768
+.IX Item "type_rule2_off EXPERIMENTAL"
769
+.Vb 1
770
+\&    type_rule2_off => 1
771
+.Ve
772
+.Sp
773
+Turn \f(CW\*(C`into2\*(C'\fR type rule off.
774
+.ie n .Sh """delete"""
775
+.el .Sh "\f(CWdelete\fP"
776
+.IX Subsection "delete"
777
+.Vb 1
778
+\&    $dbi->delete(table => 'book', where => {title => 'Perl'});
779
+.Ve
780
+.PP
781
+Execute delete statement.
782
+.PP
783
+The following opitons are available.
784
+.ie n .IP """append""" 4
785
+.el .IP "\f(CWappend\fR" 4
786
+.IX Item "append"
787
+Same as \f(CW\*(C`select\*(C'\fR method's \f(CW\*(C`append\*(C'\fR option.
788
+.ie n .IP """filter""" 4
789
+.el .IP "\f(CWfilter\fR" 4
790
+.IX Item "filter"
791
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`filter\*(C'\fR option.
792
+.ie n .IP """id""" 4
793
+.el .IP "\f(CWid\fR" 4
794
+.IX Item "id"
795
+.Vb 2
796
+\&    id => 4
797
+\&    id => [4, 5]
798
+.Ve
799
+.Sp
800
+\&\s-1ID\s0 corresponding to \f(CW\*(C`primary_key\*(C'\fR.
801
+You can delete rows by \f(CW\*(C`id\*(C'\fR and \f(CW\*(C`primary_key\*(C'\fR.
802
+.Sp
803
+.Vb 5
804
+\&    $dbi->delete(
805
+\&        parimary_key => ['id1', 'id2'],
806
+\&        id => [4, 5],
807
+\&        table => 'book',
808
+\&    );
809
+.Ve
810
+.Sp
811
+The above is same as the followin one.
812
+.Sp
813
+.Vb 1
814
+\&    $dbi->delete(where => {id1 => 4, id2 => 5}, table => 'book');
815
+.Ve
816
+.ie n .IP """prefix""" 4
817
+.el .IP "\f(CWprefix\fR" 4
818
+.IX Item "prefix"
819
+.Vb 1
820
+\&    prefix => 'some'
821
+.Ve
822
+.Sp
823
+prefix before table name section.
824
+.Sp
825
+.Vb 1
826
+\&    delete some from book
827
+.Ve
828
+.ie n .IP """query""" 4
829
+.el .IP "\f(CWquery\fR" 4
830
+.IX Item "query"
831
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`query\*(C'\fR option.
832
+.ie n .IP """table""" 4
833
+.el .IP "\f(CWtable\fR" 4
834
+.IX Item "table"
835
+.Vb 1
836
+\&    table => 'book'
837
+.Ve
838
+.Sp
839
+Table name.
840
+.ie n .IP """where""" 4
841
+.el .IP "\f(CWwhere\fR" 4
842
+.IX Item "where"
843
+Same as \f(CW\*(C`select\*(C'\fR method's \f(CW\*(C`where\*(C'\fR option.
844
+.ie n .IP """primary_key""" 4
845
+.el .IP "\f(CWprimary_key\fR" 4
846
+.IX Item "primary_key"
847
+See \f(CW\*(C`id\*(C'\fR option.
848
+.ie n .IP """bind_type""" 4
849
+.el .IP "\f(CWbind_type\fR" 4
850
+.IX Item "bind_type"
851
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`bind_type\*(C'\fR option.
852
+.ie n .IP """type_rule_off"" \s-1EXPERIMENTAL\s0" 4
853
+.el .IP "\f(CWtype_rule_off\fR \s-1EXPERIMENTAL\s0" 4
854
+.IX Item "type_rule_off EXPERIMENTAL"
855
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`type_rule_off\*(C'\fR option.
856
+.ie n .IP """type_rule1_off"" \s-1EXPERIMENTAL\s0" 4
857
+.el .IP "\f(CWtype_rule1_off\fR \s-1EXPERIMENTAL\s0" 4
858
+.IX Item "type_rule1_off EXPERIMENTAL"
859
+.Vb 1
860
+\&    type_rule1_off => 1
861
+.Ve
862
+.Sp
863
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`type_rule1_off\*(C'\fR option.
864
+.ie n .IP """type_rule2_off"" \s-1EXPERIMENTAL\s0" 4
865
+.el .IP "\f(CWtype_rule2_off\fR \s-1EXPERIMENTAL\s0" 4
866
+.IX Item "type_rule2_off EXPERIMENTAL"
867
+.Vb 1
868
+\&    type_rule2_off => 1
869
+.Ve
870
+.Sp
871
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`type_rule2_off\*(C'\fR option.
872
+.ie n .Sh """delete_all"""
873
+.el .Sh "\f(CWdelete_all\fP"
874
+.IX Subsection "delete_all"
875
+.Vb 1
876
+\&    $dbi->delete_all(table => $table);
877
+.Ve
878
+.PP
879
+Execute delete statement for all rows.
880
+Options is same as \f(CW\*(C`delete\*(C'\fR.
881
+.ie n .Sh """insert"""
882
+.el .Sh "\f(CWinsert\fP"
883
+.IX Subsection "insert"
884
+.Vb 1
885
+\&    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
886
+.Ve
887
+.PP
888
+Execute insert statement. First argument is row data. Return value is
889
+affected row count.
890
+.PP
891
+If you want to set constant value to row data, use scalar reference
892
+as parameter value.
893
+.PP
894
+.Vb 1
895
+\&    {date => \e"NOW()"}
896
+.Ve
897
+.PP
898
+The following opitons are available.
899
+.ie n .IP """append""" 4
900
+.el .IP "\f(CWappend\fR" 4
901
+.IX Item "append"
902
+Same as \f(CW\*(C`select\*(C'\fR method's \f(CW\*(C`append\*(C'\fR option.
903
+.ie n .IP """filter""" 4
904
+.el .IP "\f(CWfilter\fR" 4
905
+.IX Item "filter"
906
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`filter\*(C'\fR option.
907
+.ie n .IP """id""" 4
908
+.el .IP "\f(CWid\fR" 4
909
+.IX Item "id"
910
+.Vb 2
911
+\&    id => 4
912
+\&    id => [4, 5]
913
+.Ve
914
+.Sp
915
+\&\s-1ID\s0 corresponding to \f(CW\*(C`primary_key\*(C'\fR.
916
+You can insert a row by \f(CW\*(C`id\*(C'\fR and \f(CW\*(C`primary_key\*(C'\fR.
917
+.Sp
918
+.Vb 6
919
+\&    $dbi->insert(
920
+\&        {title => 'Perl', author => 'Ken'}
921
+\&        parimary_key => ['id1', 'id2'],
922
+\&        id => [4, 5],
923
+\&        table => 'book'
924
+\&    );
925
+.Ve
926
+.Sp
927
+The above is same as the followin one.
928
+.Sp
929
+.Vb 4
930
+\&    $dbi->insert(
931
+\&        {id1 => 4, id2 => 5, title => 'Perl', author => 'Ken'},
932
+\&        table => 'book'
933
+\&    );
934
+.Ve
935
+.ie n .IP """prefix""" 4
936
+.el .IP "\f(CWprefix\fR" 4
937
+.IX Item "prefix"
938
+.Vb 1
939
+\&    prefix => 'or replace'
940
+.Ve
941
+.Sp
942
+prefix before table name section
943
+.Sp
944
+.Vb 1
945
+\&    insert or replace into book
946
+.Ve
947
+.ie n .IP """primary_key""" 4
948
+.el .IP "\f(CWprimary_key\fR" 4
949
+.IX Item "primary_key"
950
+.Vb 2
951
+\&    primary_key => 'id'
952
+\&    primary_key => ['id1', 'id2']
953
+.Ve
954
+.Sp
955
+Primary key. This is used by \f(CW\*(C`id\*(C'\fR option.
956
+.ie n .IP """query""" 4
957
+.el .IP "\f(CWquery\fR" 4
958
+.IX Item "query"
959
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`query\*(C'\fR option.
960
+.ie n .IP """table""" 4
961
+.el .IP "\f(CWtable\fR" 4
962
+.IX Item "table"
963
+.Vb 1
964
+\&    table => 'book'
965
+.Ve
966
+.Sp
967
+Table name.
968
+.ie n .IP """bind_type""" 4
969
+.el .IP "\f(CWbind_type\fR" 4
970
+.IX Item "bind_type"
971
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`bind_type\*(C'\fR option.
972
+.ie n .IP """type_rule_off"" \s-1EXPERIMENTAL\s0" 4
973
+.el .IP "\f(CWtype_rule_off\fR \s-1EXPERIMENTAL\s0" 4
974
+.IX Item "type_rule_off EXPERIMENTAL"
975
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`type_rule_off\*(C'\fR option.
976
+.ie n .IP """type_rule1_off"" \s-1EXPERIMENTAL\s0" 4
977
+.el .IP "\f(CWtype_rule1_off\fR \s-1EXPERIMENTAL\s0" 4
978
+.IX Item "type_rule1_off EXPERIMENTAL"
979
+.Vb 1
980
+\&    type_rule1_off => 1
981
+.Ve
982
+.Sp
983
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`type_rule1_off\*(C'\fR option.
984
+.ie n .IP """type_rule2_off"" \s-1EXPERIMENTAL\s0" 4
985
+.el .IP "\f(CWtype_rule2_off\fR \s-1EXPERIMENTAL\s0" 4
986
+.IX Item "type_rule2_off EXPERIMENTAL"
987
+.Vb 1
988
+\&    type_rule2_off => 1
989
+.Ve
990
+.Sp
991
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`type_rule2_off\*(C'\fR option.
992
+.ie n .Sh """insert_param"""
993
+.el .Sh "\f(CWinsert_param\fP"
994
+.IX Subsection "insert_param"
995
+.Vb 1
996
+\&    my $insert_param = $dbi->insert_param({title => 'a', age => 2});
997
+.Ve
998
+.Sp
999
+.RS 4
1000
+Create insert parameters.
1001
+.Sp
1002
+.Vb 1
1003
+\&    (title, author) values (title = :title, age = :age);
1004
+.Ve
1005
+.ie n .Sh """include_model"""
1006
+.el .Sh "\f(CWinclude_model\fP"
1007
+.IX Subsection "include_model"
1008
+.Vb 1
1009
+\&    $dbi->include_model('MyModel');
1010
+.Ve
1011
+.Sp
1012
+Include models from specified namespace,
1013
+the following layout is needed to include models.
1014
+.Sp
1015
+.Vb 3
1016
+\&    lib / MyModel.pm
1017
+\&        / MyModel / book.pm
1018
+\&                  / company.pm
1019
+.Ve
1020
+.Sp
1021
+Name space module, extending DBIx::Custom::Model.
1022
+.Sp
1023
+\&\fBMyModel.pm\fR
1024
+.Sp
1025
+.Vb 2
1026
+\&    package MyModel;
1027
+\&    use DBIx::Custom::Model -base;
1028
+.Ve
1029
+.Sp
1030
+.Vb 1
1031
+\&    1;
1032
+.Ve
1033
+.Sp
1034
+Model modules, extending name space module.
1035
+.Sp
1036
+\&\fBMyModel/book.pm\fR
1037
+.Sp
1038
+.Vb 2
1039
+\&    package MyModel::book;
1040
+\&    use MyModel -base;
1041
+.Ve
1042
+.Sp
1043
+.Vb 1
1044
+\&    1;
1045
+.Ve
1046
+.Sp
1047
+\&\fBMyModel/company.pm\fR
1048
+.Sp
1049
+.Vb 2
1050
+\&    package MyModel::company;
1051
+\&    use MyModel -base;
1052
+.Ve
1053
+.Sp
1054
+.Vb 1
1055
+\&    1;
1056
+.Ve
1057
+.Sp
1058
+MyModel::book and MyModel::company is included by \f(CW\*(C`include_model\*(C'\fR.
1059
+.Sp
1060
+You can get model object by \f(CW\*(C`model\*(C'\fR.
1061
+.Sp
1062
+.Vb 2
1063
+\&    my $book_model = $dbi->model('book');
1064
+\&    my $company_model = $dbi->model('company');
1065
+.Ve
1066
+.Sp
1067
+See DBIx::Custom::Model to know model features.
1068
+.ie n .Sh """map_param"" \s-1EXPERIMENTAL\s0"
1069
+.el .Sh "\f(CWmap_param\fP \s-1EXPERIMENTAL\s0"
1070
+.IX Subsection "map_param EXPERIMENTAL"
1071
+.Vb 8
1072
+\&    my $map_param = $dbi->map_param(
1073
+\&        {id => 1, authro => 'Ken', price => 1900},
1074
+\&        'id' => 'book.id',
1075
+\&        'author' => ['book.author' => sub { '%' . $_[0] . '%' }],
1076
+\&        'price' => [
1077
+\&            'book.price', {if => sub { length $_[0] }}
1078
+\&        ]
1079
+\&    );
1080
+.Ve
1081
+.Sp
1082
+Map paramters to other key and value. First argument is original
1083
+parameter. this is hash reference. Rest argument is mapping.
1084
+By default, Mapping is done if the value length is not zero.
1085
+.IP "Key mapping" 4
1086
+.IX Item "Key mapping"
1087
+.Vb 1
1088
+\&    'id' => 'book.id'
1089
+.Ve
1090
+.Sp
1091
+This is only key mapping. Value is same as original one.
1092
+.Sp
1093
+.Vb 1
1094
+\&    (id => 1) is mapped to ('book.id' => 1) if value length is not zero.
1095
+.Ve
1096
+.IP "Key and value mapping" 4
1097
+.IX Item "Key and value mapping"
1098
+.Vb 1
1099
+\&    'author' => ['book.author' => sub { '%' . $_[0] . '%' }]
1100
+.Ve
1101
+.Sp
1102
+This is key and value mapping. Frist element of array reference
1103
+is mapped key name, second element is code reference to map the value.
1104
+.Sp
1105
+.Vb 2
1106
+\&    (author => 'Ken') is mapped to ('book.author' => '%Ken%')
1107
+\&      if value length is not zero.
1108
+.Ve
1109
+.IP "Condition" 4
1110
+.IX Item "Condition"
1111
+.Vb 3
1112
+\&    'price' => ['book.price', {if => 'exists'}]
1113
+\&    'price' => ['book.price', sub { '%' . $_[0] . '%' }, {if => 'exists'}]
1114
+\&    'price' => ['book.price', {if => sub { defined shift }}]
1115
+.Ve
1116
+.Sp
1117
+If you need condition, you can sepecify it. this is code reference
1118
+or 'exists'. By default, condition is the following one.
1119
+.Sp
1120
+.Vb 1
1121
+\&    sub { defined $_[0] && length $_[0] }
1122
+.Ve
1123
+.RE
1124
+.RS 4
1125
+.ie n .Sh """merge_param"""
1126
+.el .Sh "\f(CWmerge_param\fP"
1127
+.IX Subsection "merge_param"
1128
+.Vb 1
1129
+\&    my $param = $dbi->merge_param({key1 => 1}, {key1 => 1, key2 => 2});
1130
+.Ve
1131
+.Sp
1132
+Merge parameters.
1133
+.Sp
1134
+.Vb 1
1135
+\&    {key1 => [1, 1], key2 => 2}
1136
+.Ve
1137
+.ie n .Sh """method"""
1138
+.el .Sh "\f(CWmethod\fP"
1139
+.IX Subsection "method"
1140
+.Vb 3
1141
+\&    $dbi->method(
1142
+\&        update_or_insert => sub {
1143
+\&            my $self = shift;
1144
+.Ve
1145
+.Sp
1146
+.Vb 4
1147
+\&            # Process
1148
+\&        },
1149
+\&        find_or_create   => sub {
1150
+\&            my $self = shift;
1151
+.Ve
1152
+.Sp
1153
+.Vb 3
1154
+\&            # Process
1155
+\&        }
1156
+\&    );
1157
+.Ve
1158
+.Sp
1159
+Register method. These method is called directly from DBIx::Custom object.
1160
+.Sp
1161
+.Vb 2
1162
+\&    $dbi->update_or_insert;
1163
+\&    $dbi->find_or_create;
1164
+.Ve
1165
+.ie n .Sh """model"""
1166
+.el .Sh "\f(CWmodel\fP"
1167
+.IX Subsection "model"
1168
+.Vb 1
1169
+\&    my $model = $dbi->model('book');
1170
+.Ve
1171
+.Sp
1172
+Get a DBIx::Custom::Model object,
1173
+.ie n .Sh """mycolumn"""
1174
+.el .Sh "\f(CWmycolumn\fP"
1175
+.IX Subsection "mycolumn"
1176
+.Vb 1
1177
+\&    my $column = $self->mycolumn(book => ['author', 'title']);
1178
+.Ve
1179
+.Sp
1180
+Create column clause for myself. The follwoing column clause is created.
1181
+.Sp
1182
+.Vb 2
1183
+\&    book.author as author,
1184
+\&    book.title as title
1185
+.Ve
1186
+.ie n .Sh """new"""
1187
+.el .Sh "\f(CWnew\fP"
1188
+.IX Subsection "new"
1189
+.Vb 6
1190
+\&    my $dbi = DBIx::Custom->new(
1191
+\&        dsn => "dbi:mysql:database=dbname",
1192
+\&        user => 'ken',
1193
+\&        password => '!LFKD%$&',
1194
+\&        dbi_option => {mysql_enable_utf8 => 1}
1195
+\&    );
1196
+.Ve
1197
+.Sp
1198
+Create a new DBIx::Custom object.
1199
+.ie n .Sh """not_exists"""
1200
+.el .Sh "\f(CWnot_exists\fP"
1201
+.IX Subsection "not_exists"
1202
+.Vb 1
1203
+\&    my $not_exists = $dbi->not_exists;
1204
+.Ve
1205
+.Sp
1206
+DBIx::Custom::NotExists object, indicating the column is not exists.
1207
+This is used by \f(CW\*(C`clause\*(C'\fR of DBIx::Custom::Where .
1208
+.ie n .Sh """order"" \s-1EXPERIMENTAL\s0"
1209
+.el .Sh "\f(CWorder\fP \s-1EXPERIMENTAL\s0"
1210
+.IX Subsection "order EXPERIMENTAL"
1211
+.Vb 1
1212
+\&    my $order = $dbi->order;
1213
+.Ve
1214
+.Sp
1215
+Create a new DBIx::Custom::Order object.
1216
+.ie n .Sh """register_filter"""
1217
+.el .Sh "\f(CWregister_filter\fP"
1218
+.IX Subsection "register_filter"
1219
+.Vb 12
1220
+\&    $dbi->register_filter(
1221
+\&        # Time::Piece object to database DATE format
1222
+\&        tp_to_date => sub {
1223
+\&            my $tp = shift;
1224
+\&            return $tp->strftime('%Y-%m-%d');
1225
+\&        },
1226
+\&        # database DATE format to Time::Piece object
1227
+\&        date_to_tp => sub {
1228
+\&           my $date = shift;
1229
+\&           return Time::Piece->strptime($date, '%Y-%m-%d');
1230
+\&        }
1231
+\&    );
1232
+.Ve
1233
+.Sp
1234
+Register filters, used by \f(CW\*(C`filter\*(C'\fR option of many methods.
1235
+.ie n .Sh """type_rule"" \s-1EXPERIMENTAL\s0"
1236
+.el .Sh "\f(CWtype_rule\fP \s-1EXPERIMENTAL\s0"
1237
+.IX Subsection "type_rule EXPERIMENTAL"
1238
+.Vb 22
1239
+\&    $dbi->type_rule(
1240
+\&        into1 => {
1241
+\&            date => sub { ... },
1242
+\&            datetime => sub { ... }
1243
+\&        },
1244
+\&        into2 => {
1245
+\&            date => sub { ... },
1246
+\&            datetime => sub { ... }
1247
+\&        },
1248
+\&        from1 => {
1249
+\&            # DATE
1250
+\&            9 => sub { ... },
1251
+\&            # DATETIME or TIMESTAMP
1252
+\&            11 => sub { ... },
1253
+\&        }
1254
+\&        from2 => {
1255
+\&            # DATE
1256
+\&            9 => sub { ... },
1257
+\&            # DATETIME or TIMESTAMP
1258
+\&            11 => sub { ... },
1259
+\&        }
1260
+\&    );
1261
+.Ve
1262
+.Sp
1263
+Filtering rule when data is send into and get from database.
1264
+This has a little complex problem.
1265
+.Sp
1266
+In \f(CW\*(C`into1\*(C'\fR and \f(CW\*(C`into2\*(C'\fR you can specify
1267
+type name as same as type name defined
1268
+by create table, such as \f(CW\*(C`DATETIME\*(C'\fR or \f(CW\*(C`DATE\*(C'\fR.
1269
+.Sp
1270
+Note that type name and data type don't contain upper case.
1271
+If these contain upper case charactor, you convert it to lower case.
1272
+.Sp
1273
+\&\f(CW\*(C`into2\*(C'\fR is executed after \f(CW\*(C`into1\*(C'\fR.
1274
+.Sp
1275
+Type rule of \f(CW\*(C`into1\*(C'\fR and \f(CW\*(C`into2\*(C'\fR is enabled on the following
1276
+column name.
1277
+.IP "1. column name" 4
1278
+.IX Item "1. column name"
1279
+.Vb 2
1280
+\&    issue_date
1281
+\&    issue_datetime
1282
+.Ve
1283
+.Sp
1284
+This need \f(CW\*(C`table\*(C'\fR option in each method.
1285
+.IP "2. table name and column name, separator is dot" 4
1286
+.IX Item "2. table name and column name, separator is dot"
1287
+.Vb 2
1288
+\&    book.issue_date
1289
+\&    book.issue_datetime
1290
+.Ve
1291
+.RE
1292
+.RS 4
1293
+.Sp
1294
+You get all type name used in database by \f(CW\*(C`available_type_name\*(C'\fR.
1295
+.Sp
1296
+.Vb 1
1297
+\&    print $dbi->available_type_name;
1298
+.Ve
1299
+.Sp
1300
+In \f(CW\*(C`from1\*(C'\fR and \f(CW\*(C`from2\*(C'\fR you specify data type, not type name.
1301
+\&\f(CW\*(C`from2\*(C'\fR is executed after \f(CW\*(C`from1\*(C'\fR.
1302
+You get all data type by \f(CW\*(C`available_data_type\*(C'\fR.
1303
+.Sp
1304
+.Vb 1
1305
+\&    print $dbi->available_data_type;
1306
+.Ve
1307
+.Sp
1308
+You can also specify multiple types at once.
1309
+.Sp
1310
+.Vb 5
1311
+\&    $dbi->type_rule(
1312
+\&        into1 => [
1313
+\&            [qw/DATE DATETIME/] => sub { ... },
1314
+\&        ],
1315
+\&    );
1316
+.Ve
1317
+.ie n .Sh """select"""
1318
+.el .Sh "\f(CWselect\fP"
1319
+.IX Subsection "select"
1320
+.Vb 5
1321
+\&    my $result = $dbi->select(
1322
+\&        table  => 'book',
1323
+\&        column => ['author', 'title'],
1324
+\&        where  => {author => 'Ken'},
1325
+\&    );
1326
+.Ve
1327
+.Sp
1328
+Execute select statement.
1329
+.Sp
1330
+The following opitons are available.
1331
+.ie n .IP """append""" 4
1332
+.el .IP "\f(CWappend\fR" 4
1333
+.IX Item "append"
1334
+.Vb 1
1335
+\&    append => 'order by title'
1336
+.Ve
1337
+.Sp
1338
+Append statement to last of \s-1SQL\s0.
1339
+.ie n .IP """column""" 4
1340
+.el .IP "\f(CWcolumn\fR" 4
1341
+.IX Item "column"
1342
+.Vb 2
1343
+\&    column => 'author'
1344
+\&    column => ['author', 'title']
1345
+.Ve
1346
+.Sp
1347
+Column clause.
1348
+.Sp
1349
+if \f(CW\*(C`column\*(C'\fR is not specified, '*' is set.
1350
+.Sp
1351
+.Vb 1
1352
+\&    column => '*'
1353
+.Ve
1354
+.Sp
1355
+You can specify hash of array reference.
1356
+.Sp
1357
+.Vb 4
1358
+\&    column => [
1359
+\&        {book => [qw/author title/]},
1360
+\&        {person => [qw/name age/]}
1361
+\&    ]
1362
+.Ve
1363
+.Sp
1364
+This is expanded to the following one by using \f(CW\*(C`colomn\*(C'\fR method.
1365
+.Sp
1366
+.Vb 4
1367
+\&    book.author as "book.author",
1368
+\&    book.title as "book.title",
1369
+\&    person.name as "person.name",
1370
+\&    person.age as "person.age"
1371
+.Ve
1372
+.Sp
1373
+You can specify array of array reference, first argument is
1374
+column name, second argument is alias.
1375
+.Sp
1376
+.Vb 3
1377
+\&    column => [
1378
+\&        ['date(book.register_datetime)' => 'book.register_date']
1379
+\&    ];
1380
+.Ve
1381
+.Sp
1382
+Alias is quoted properly and joined.
1383
+.Sp
1384
+.Vb 1
1385
+\&    date(book.register_datetime) as "book.register_date"
1386
+.Ve
1387
+.ie n .IP """filter""" 4
1388
+.el .IP "\f(CWfilter\fR" 4
1389
+.IX Item "filter"
1390
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`filter\*(C'\fR option.
1391
+.ie n .IP """id""" 4
1392
+.el .IP "\f(CWid\fR" 4
1393
+.IX Item "id"
1394
+.Vb 2
1395
+\&    id => 4
1396
+\&    id => [4, 5]
1397
+.Ve
1398
+.Sp
1399
+\&\s-1ID\s0 corresponding to \f(CW\*(C`primary_key\*(C'\fR.
1400
+You can select rows by \f(CW\*(C`id\*(C'\fR and \f(CW\*(C`primary_key\*(C'\fR.
1401
+.Sp
1402
+.Vb 5
1403
+\&    $dbi->select(
1404
+\&        parimary_key => ['id1', 'id2'],
1405
+\&        id => [4, 5],
1406
+\&        table => 'book'
1407
+\&    );
1408
+.Ve
1409
+.Sp
1410
+The above is same as the followin one.
1411
+.Sp
1412
+.Vb 4
1413
+\&    $dbi->select(
1414
+\&        where => {id1 => 4, id2 => 5},
1415
+\&        table => 'book'
1416
+\&    );
1417
+.Ve
1418
+.ie n .IP """param"" \s-1EXPERIMETNAL\s0" 4
1419
+.el .IP "\f(CWparam\fR \s-1EXPERIMETNAL\s0" 4
1420
+.IX Item "param EXPERIMETNAL"
1421
+.Vb 1
1422
+\&    param => {'table2.key3' => 5}
1423
+.Ve
1424
+.Sp
1425
+Parameter shown before where clause.
1426
+.Sp
1427
+For example, if you want to contain tag in join clause, 
1428
+you can pass parameter by \f(CW\*(C`param\*(C'\fR option.
1429
+.Sp
1430
+.Vb 2
1431
+\&    join  => ['inner join (select * from table2 where table2.key3 = :table2.key3)' . 
1432
+\&              ' as table2 on table1.key1 = table2.key1']
1433
+.Ve
1434
+.Sp
1435
+.Vb 1
1436
+\&    prefix => 'SQL_CALC_FOUND_ROWS'
1437
+.Ve
1438
+.Sp
1439
+Prefix of column cluase
1440
+.Sp
1441
+.Vb 1
1442
+\&    select SQL_CALC_FOUND_ROWS title, author from book;
1443
+.Ve
1444
+.ie n .IP """join""" 4
1445
+.el .IP "\f(CWjoin\fR" 4
1446
+.IX Item "join"
1447
+.Vb 4
1448
+\&    join => [
1449
+\&        'left outer join company on book.company_id = company_id',
1450
+\&        'left outer join location on company.location_id = location.id'
1451
+\&    ]
1452
+.Ve
1453
+.Sp
1454
+Join clause. If column cluase or where clause contain table name like \*(L"company.name\*(R",
1455
+join clausees needed when \s-1SQL\s0 is created is used automatically.
1456
+.Sp
1457
+.Vb 9
1458
+\&    $dbi->select(
1459
+\&        table => 'book',
1460
+\&        column => ['company.location_id as location_id'],
1461
+\&        where => {'company.name' => 'Orange'},
1462
+\&        join => [
1463
+\&            'left outer join company on book.company_id = company.id',
1464
+\&            'left outer join location on company.location_id = location.id'
1465
+\&        ]
1466
+\&    );
1467
+.Ve
1468
+.Sp
1469
+In above select, column and where clause contain \*(L"company\*(R" table,
1470
+the following \s-1SQL\s0 is created
1471
+.Sp
1472
+.Vb 4
1473
+\&    select company.location_id as location_id
1474
+\&    from book
1475
+\&      left outer join company on book.company_id = company.id
1476
+\&    where company.name = ?;
1477
+.Ve
1478
+.Sp
1479
+You can specify two table by yourself. This is useful when join parser can't parse
1480
+the join clause correctly. This is \s-1EXPERIMENTAL\s0.
1481
+.Sp
1482
+.Vb 11
1483
+\&    $dbi->select(
1484
+\&        table => 'book',
1485
+\&        column => ['company.location_id as location_id'],
1486
+\&        where => {'company.name' => 'Orange'},
1487
+\&        join => [
1488
+\&            {
1489
+\&                clause => 'left outer join location on company.location_id = location.id',
1490
+\&                table => ['company', 'location']
1491
+\&            }
1492
+\&        ]
1493
+\&    );
1494
+.Ve
1495
+.ie n .IP """primary_key""" 4
1496
+.el .IP "\f(CWprimary_key\fR" 4
1497
+.IX Item "primary_key"
1498
+.Vb 2
1499
+\&    primary_key => 'id'
1500
+\&    primary_key => ['id1', 'id2']
1501
+.Ve
1502
+.Sp
1503
+Primary key. This is used by \f(CW\*(C`id\*(C'\fR option.
1504
+.ie n .IP """query""" 4
1505
+.el .IP "\f(CWquery\fR" 4
1506
+.IX Item "query"
1507
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`query\*(C'\fR option.
1508
+.ie n .IP """bind_type""" 4
1509
+.el .IP "\f(CWbind_type\fR" 4
1510
+.IX Item "bind_type"
1511
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`bind_type\*(C'\fR option.
1512
+.ie n .IP """table""" 4
1513
+.el .IP "\f(CWtable\fR" 4
1514
+.IX Item "table"
1515
+.Vb 1
1516
+\&    table => 'book'
1517
+.Ve
1518
+.Sp
1519
+Table name.
1520
+.ie n .IP """type_rule_off"" \s-1EXPERIMENTAL\s0" 4
1521
+.el .IP "\f(CWtype_rule_off\fR \s-1EXPERIMENTAL\s0" 4
1522
+.IX Item "type_rule_off EXPERIMENTAL"
1523
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`type_rule_off\*(C'\fR option.
1524
+.ie n .IP """type_rule1_off"" \s-1EXPERIMENTAL\s0" 4
1525
+.el .IP "\f(CWtype_rule1_off\fR \s-1EXPERIMENTAL\s0" 4
1526
+.IX Item "type_rule1_off EXPERIMENTAL"
1527
+.Vb 1
1528
+\&    type_rule1_off => 1
1529
+.Ve
1530
+.Sp
1531
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`type_rule1_off\*(C'\fR option.
1532
+.ie n .IP """type_rule2_off"" \s-1EXPERIMENTAL\s0" 4
1533
+.el .IP "\f(CWtype_rule2_off\fR \s-1EXPERIMENTAL\s0" 4
1534
+.IX Item "type_rule2_off EXPERIMENTAL"
1535
+.Vb 1
1536
+\&    type_rule2_off => 1
1537
+.Ve
1538
+.Sp
1539
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`type_rule2_off\*(C'\fR option.
1540
+.ie n .IP """where""" 4
1541
+.el .IP "\f(CWwhere\fR" 4
1542
+.IX Item "where"
1543
+.Vb 2
1544
+\&    # Hash refrence
1545
+\&    where => {author => 'Ken', 'title' => 'Perl'}
1546
+.Ve
1547
+.Sp
1548
+.Vb 5
1549
+\&    # DBIx::Custom::Where object
1550
+\&    where => $dbi->where(
1551
+\&        clause => ['and', 'author = :author', 'title like :title'],
1552
+\&        param  => {author => 'Ken', title => '%Perl%'}
1553
+\&    );
1554
+.Ve
1555
+.Sp
1556
+.Vb 5
1557
+\&    # Array reference 1 (array reference, hash referenc). same as above
1558
+\&    where => [
1559
+\&        ['and', 'author = :author', 'title like :title'],
1560
+\&        {author => 'Ken', title => '%Perl%'}
1561
+\&    ];
1562
+.Ve
1563
+.Sp
1564
+.Vb 5
1565
+\&    # Array reference 2 (String, hash reference)
1566
+\&    where => [
1567
+\&        'title like :title',
1568
+\&        {title => '%Perl%'}
1569
+\&    ]
1570
+.Ve
1571
+.Sp
1572
+.Vb 2
1573
+\&    # String
1574
+\&    where => 'title is null'
1575
+.Ve
1576
+.Sp
1577
+Where clause.
1578
+.ie n .IP """wrap"" \s-1EXPERIMENTAL\s0" 4
1579
+.el .IP "\f(CWwrap\fR \s-1EXPERIMENTAL\s0" 4
1580
+.IX Item "wrap EXPERIMENTAL"
1581
+Wrap statement. This is array reference.
1582
+.Sp
1583
+.Vb 1
1584
+\&    $dbi->select(wrap => ['select * from (', ') as t where ROWNUM < 10']);
1585
+.Ve
1586
+.Sp
1587
+This option is for Oracle and \s-1SQL\s0 Server paging process.
1588
+.RE
1589
+.RS 4
1590
+.ie n .Sh """update"""
1591
+.el .Sh "\f(CWupdate\fP"
1592
+.IX Subsection "update"
1593
+.Vb 1
1594
+\&    $dbi->update({title => 'Perl'}, table  => 'book', where  => {id => 4});
1595
+.Ve
1596
+.Sp
1597
+Execute update statement. First argument is update row data.
1598
+.Sp
1599
+If you want to set constant value to row data, use scalar reference
1600
+as parameter value.
1601
+.Sp
1602
+.Vb 1
1603
+\&    {date => \e"NOW()"}
1604
+.Ve
1605
+.Sp
1606
+The following opitons are available.
1607
+.ie n .IP """append""" 4
1608
+.el .IP "\f(CWappend\fR" 4
1609
+.IX Item "append"
1610
+Same as \f(CW\*(C`select\*(C'\fR method's \f(CW\*(C`append\*(C'\fR option.
1611
+.ie n .IP """filter""" 4
1612
+.el .IP "\f(CWfilter\fR" 4
1613
+.IX Item "filter"
1614
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`filter\*(C'\fR option.
1615
+.ie n .IP """id""" 4
1616
+.el .IP "\f(CWid\fR" 4
1617
+.IX Item "id"
1618
+.Vb 2
1619
+\&    id => 4
1620
+\&    id => [4, 5]
1621
+.Ve
1622
+.Sp
1623
+\&\s-1ID\s0 corresponding to \f(CW\*(C`primary_key\*(C'\fR.
1624
+You can update rows by \f(CW\*(C`id\*(C'\fR and \f(CW\*(C`primary_key\*(C'\fR.
1625
+.Sp
1626
+.Vb 6
1627
+\&    $dbi->update(
1628
+\&        {title => 'Perl', author => 'Ken'}
1629
+\&        parimary_key => ['id1', 'id2'],
1630
+\&        id => [4, 5],
1631
+\&        table => 'book'
1632
+\&    );
1633
+.Ve
1634
+.Sp
1635
+The above is same as the followin one.
1636
+.Sp
1637
+.Vb 5
1638
+\&    $dbi->update(
1639
+\&        {title => 'Perl', author => 'Ken'}
1640
+\&        where => {id1 => 4, id2 => 5},
1641
+\&        table => 'book'
1642
+\&    );
1643
+.Ve
1644
+.ie n .IP """prefix""" 4
1645
+.el .IP "\f(CWprefix\fR" 4
1646
+.IX Item "prefix"
1647
+.Vb 1
1648
+\&    prefix => 'or replace'
1649
+.Ve
1650
+.Sp
1651
+prefix before table name section
1652
+.Sp
1653
+.Vb 1
1654
+\&    update or replace book
1655
+.Ve
1656
+.ie n .IP """primary_key""" 4
1657
+.el .IP "\f(CWprimary_key\fR" 4
1658
+.IX Item "primary_key"
1659
+.Vb 2
1660
+\&    primary_key => 'id'
1661
+\&    primary_key => ['id1', 'id2']
1662
+.Ve
1663
+.Sp
1664
+Primary key. This is used by \f(CW\*(C`id\*(C'\fR option.
1665
+.ie n .IP """query""" 4
1666
+.el .IP "\f(CWquery\fR" 4
1667
+.IX Item "query"
1668
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`query\*(C'\fR option.
1669
+.ie n .IP """table""" 4
1670
+.el .IP "\f(CWtable\fR" 4
1671
+.IX Item "table"
1672
+.Vb 1
1673
+\&    table => 'book'
1674
+.Ve
1675
+.Sp
1676
+Table name.
1677
+.ie n .IP """where""" 4
1678
+.el .IP "\f(CWwhere\fR" 4
1679
+.IX Item "where"
1680
+Same as \f(CW\*(C`select\*(C'\fR method's \f(CW\*(C`where\*(C'\fR option.
1681
+.ie n .IP """bind_type""" 4
1682
+.el .IP "\f(CWbind_type\fR" 4
1683
+.IX Item "bind_type"
1684
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`bind_type\*(C'\fR option.
1685
+.ie n .IP """type_rule_off"" \s-1EXPERIMENTAL\s0" 4
1686
+.el .IP "\f(CWtype_rule_off\fR \s-1EXPERIMENTAL\s0" 4
1687
+.IX Item "type_rule_off EXPERIMENTAL"
1688
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`type_rule_off\*(C'\fR option.
1689
+.ie n .IP """type_rule1_off"" \s-1EXPERIMENTAL\s0" 4
1690
+.el .IP "\f(CWtype_rule1_off\fR \s-1EXPERIMENTAL\s0" 4
1691
+.IX Item "type_rule1_off EXPERIMENTAL"
1692
+.Vb 1
1693
+\&    type_rule1_off => 1
1694
+.Ve
1695
+.Sp
1696
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`type_rule1_off\*(C'\fR option.
1697
+.ie n .IP """type_rule2_off"" \s-1EXPERIMENTAL\s0" 4
1698
+.el .IP "\f(CWtype_rule2_off\fR \s-1EXPERIMENTAL\s0" 4
1699
+.IX Item "type_rule2_off EXPERIMENTAL"
1700
+.Vb 1
1701
+\&    type_rule2_off => 1
1702
+.Ve
1703
+.Sp
1704
+Same as \f(CW\*(C`execute\*(C'\fR method's \f(CW\*(C`type_rule2_off\*(C'\fR option.
1705
+.RE
1706
+.RS 4
1707
+.ie n .Sh """update_all"""
1708
+.el .Sh "\f(CWupdate_all\fP"
1709
+.IX Subsection "update_all"
1710
+.Vb 1
1711
+\&    $dbi->update_all({title => 'Perl'}, table => 'book', );
1712
+.Ve
1713
+.Sp
1714
+Execute update statement for all rows.
1715
+Options is same as \f(CW\*(C`update\*(C'\fR method.
1716
+.ie n .Sh """update_param"""
1717
+.el .Sh "\f(CWupdate_param\fP"
1718
+.IX Subsection "update_param"
1719
+.Vb 1
1720
+\&    my $update_param = $dbi->update_param({title => 'a', age => 2});
1721
+.Ve
1722
+.Sp
1723
+Create update parameter tag.
1724
+.Sp
1725
+.Vb 1
1726
+\&    set title = :title, author = :author
1727
+.Ve
1728
+.ie n .Sh """where"""
1729
+.el .Sh "\f(CWwhere\fP"
1730
+.IX Subsection "where"
1731
+.Vb 4
1732
+\&    my $where = $dbi->where(
1733
+\&        clause => ['and', 'title = :title', 'author = :author'],
1734
+\&        param => {title => 'Perl', author => 'Ken'}
1735
+\&    );
1736
+.Ve
1737
+.Sp
1738
+Create a new DBIx::Custom::Where object.
1739
+.ie n .Sh """setup_model"""
1740
+.el .Sh "\f(CWsetup_model\fP"
1741
+.IX Subsection "setup_model"
1742
+.Vb 1
1743
+\&    $dbi->setup_model;
1744
+.Ve
1745
+.Sp
1746
+Setup all model objects.
1747
+\&\f(CW\*(C`columns\*(C'\fR of model object is automatically set, parsing database information.
1748
+.SH "ENVIRONMENT VARIABLE"
1749
+.IX Header "ENVIRONMENT VARIABLE"
1750
+.ie n .Sh """DBIX_CUSTOM_DEBUG"""
1751
+.el .Sh "\f(CWDBIX_CUSTOM_DEBUG\fP"
1752
+.IX Subsection "DBIX_CUSTOM_DEBUG"
1753
+If environment variable \f(CW\*(C`DBIX_CUSTOM_DEBUG\*(C'\fR is set to true,
1754
+executed \s-1SQL\s0 and bind values are printed to \s-1STDERR\s0.
1755
+.ie n .Sh """DBIX_CUSTOM_DEBUG_ENCODING"""
1756
+.el .Sh "\f(CWDBIX_CUSTOM_DEBUG_ENCODING\fP"
1757
+.IX Subsection "DBIX_CUSTOM_DEBUG_ENCODING"
1758
+\&\s-1DEBUG\s0 output encoding. Default to \s-1UTF\-8\s0.
1759
+.SH "DEPRECATED FUNCTIONALITIES"
1760
+.IX Header "DEPRECATED FUNCTIONALITIES"
1761
+DBIx::Custom
1762
+.Sp
1763
+.Vb 6
1764
+\&    # Attribute methods
1765
+\&    data_source # will be removed at 2017/1/1
1766
+\&    dbi_options # will be removed at 2017/1/1
1767
+\&    filter_check # will be removed at 2017/1/1
1768
+\&    reserved_word_quote # will be removed at 2017/1/1
1769
+\&    cache_method # will be removed at 2017/1/1
1770
+.Ve
1771
+.Sp
1772
+.Vb 13
1773
+\&    # Methods
1774
+\&    create_query # will be removed at 2017/1/1
1775
+\&    apply_filter # will be removed at 2017/1/1
1776
+\&    select_at # will be removed at 2017/1/1
1777
+\&    delete_at # will be removed at 2017/1/1
1778
+\&    update_at # will be removed at 2017/1/1
1779
+\&    insert_at # will be removed at 2017/1/1
1780
+\&    register_tag # will be removed at 2017/1/1
1781
+\&    default_bind_filter # will be removed at 2017/1/1
1782
+\&    default_fetch_filter # will be removed at 2017/1/1
1783
+\&    insert_param_tag # will be removed at 2017/1/1
1784
+\&    register_tag_processor # will be removed at 2017/1/1
1785
+\&    update_param_tag # will be removed at 2017/1/1
1786
+.Ve
1787
+.Sp
1788
+.Vb 5
1789
+\&    # Options
1790
+\&    select method relation option # will be removed at 2017/1/1
1791
+\&    select method param option # will be removed at 2017/1/1
1792
+\&    select method column option [COLUMN, as => ALIAS] format
1793
+\&      # will be removed at 2017/1/1
1794
+.Ve
1795
+.Sp
1796
+.Vb 5
1797
+\&    # Others
1798
+\&    execute("select * from {= title}"); # execute method's
1799
+\&                                        # tag parsing functionality
1800
+\&                                        # will be removed at 2017/1/1
1801
+\&    Query caching # will be removed at 2017/1/1
1802
+.Ve
1803
+.Sp
1804
+DBIx::Custom::Model
1805
+.Sp
1806
+.Vb 4
1807
+\&    # Attribute methods
1808
+\&    filter # will be removed at 2017/1/1
1809
+\&    name # will be removed at 2017/1/1
1810
+\&    type # will be removed at 2017/1/1
1811
+.Ve
1812
+.Sp
1813
+DBIx::Custom::Query
1814
+.Sp
1815
+.Vb 4
1816
+\&    # Attribute methods
1817
+\&    default_filter # will be removed at 2017/1/1
1818
+\&    table # will be removed at 2017/1/1
1819
+\&    filters # will be removed at 2017/1/1
1820
+.Ve
1821
+.Sp
1822
+.Vb 2
1823
+\&    # Methods
1824
+\&    filter # will be removed at 2017/1/1
1825
+.Ve
1826
+.Sp
1827
+DBIx::Custom::QueryBuilder
1828
+.Sp
1829
+.Vb 3
1830
+\&    # Attribute methods
1831
+\&    tags # will be removed at 2017/1/1
1832
+\&    tag_processors # will be removed at 2017/1/1
1833
+.Ve
1834
+.Sp
1835
+.Vb 3
1836
+\&    # Methods
1837
+\&    register_tag # will be removed at 2017/1/1
1838
+\&    register_tag_processor # will be removed at 2017/1/1
1839
+.Ve
1840
+.Sp
1841
+.Vb 3
1842
+\&    # Others
1843
+\&    build_query("select * from {= title}"); # tag parsing functionality
1844
+\&                                            # will be removed at 2017/1/1
1845
+.Ve
1846
+.Sp
1847
+DBIx::Custom::Result
1848
+.Sp
1849
+.Vb 2
1850
+\&    # Attribute methods
1851
+\&    filter_check # will be removed at 2017/1/1
1852
+.Ve
1853
+.Sp
1854
+.Vb 5
1855
+\&    # Methods
1856
+\&    end_filter # will be removed at 2017/1/1
1857
+\&    remove_end_filter # will be removed at 2017/1/1
1858
+\&    remove_filter # will be removed at 2017/1/1
1859
+\&    default_filter # will be removed at 2017/1/1
1860
+.Ve
1861
+.Sp
1862
+DBIx::Custom::Tag
1863
+.Sp
1864
+.Vb 1
1865
+\&    This module is DEPRECATED! # will be removed at 2017/1/1
1866
+.Ve
1867
+.SH "BACKWORD COMPATIBLE POLICY"
1868
+.IX Header "BACKWORD COMPATIBLE POLICY"
1869
+If a functionality is \s-1DEPRECATED\s0, you can know it by \s-1DEPRECATED\s0 warnings
1870
+except for attribute method.
1871
+You can check all \s-1DEPRECATED\s0 functionalities by document.
1872
+\&\s-1DEPRECATED\s0 functionality is removed after five years,
1873
+but if at least one person use the functionality and tell me that thing
1874
+I extend one year each time he tell me it.
1875
+.Sp
1876
+\&\s-1EXPERIMENTAL\s0 functionality will be changed without warnings.
1877
+.Sp
1878
+This policy was changed at 2011/6/28
1879
+.SH "BUGS"
1880
+.IX Header "BUGS"
1881
+Please tell me bugs if found.
1882
+.Sp
1883
+\&\f(CW\*(C`<kimoto.yuki at gmail.com>\*(C'\fR
1884
+.Sp
1885
+<http://github.com/yuki\-kimoto/DBIx\-Custom>
1886
+.SH "AUTHOR"
1887
+.IX Header "AUTHOR"
1888
+Yuki Kimoto, \f(CW\*(C`<kimoto.yuki at gmail.com>\*(C'\fR
1889
+.SH "COPYRIGHT & LICENSE"
1890
+.IX Header "COPYRIGHT & LICENSE"
1891
+Copyright 2009\-2011 Yuki Kimoto, all rights reserved.
1892
+.Sp
1893
+This program is free software; you can redistribute it and/or modify it
1894
+under the same terms as Perl itself.
+924
DBIx-Custom-0.1711/blib/man3/DBIx::Custom::Guide.3pm
... ...
@@ -0,0 +1,924 @@
1
+.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2
+.\"
3
+.\" Standard preamble:
4
+.\" ========================================================================
5
+.de Sh \" Subsection heading
6
+.br
7
+.if t .Sp
8
+.ne 5
9
+.PP
10
+\fB\\$1\fR
11
+.PP
12
+..
13
+.de Sp \" Vertical space (when we can't use .PP)
14
+.if t .sp .5v
15
+.if n .sp
16
+..
17
+.de Vb \" Begin verbatim text
18
+.ft CW
19
+.nf
20
+.ne \\$1
21
+..
22
+.de Ve \" End verbatim text
23
+.ft R
24
+.fi
25
+..
26
+.\" Set up some character translations and predefined strings.  \*(-- will
27
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
28
+.\" double quote, and \*(R" will give a right double quote.  | will give a
29
+.\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used to
30
+.\" do unbreakable dashes and therefore won't be available.  \*(C` and \*(C'
31
+.\" expand to `' in nroff, nothing in troff, for use with C<>.
32
+.tr \(*W-|\(bv\*(Tr
33
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34
+.ie n \{\
35
+.    ds -- \(*W-
36
+.    ds PI pi
37
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
38
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
39
+.    ds L" ""
40
+.    ds R" ""
41
+.    ds C` ""
42
+.    ds C' ""
43
+'br\}
44
+.el\{\
45
+.    ds -- \|\(em\|
46
+.    ds PI \(*p
47
+.    ds L" ``
48
+.    ds R" ''
49
+'br\}
50
+.\"
51
+.\" If the F register is turned on, we'll generate index entries on stderr for
52
+.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
54
+.\" output yourself in some meaningful fashion.
55
+.if \nF \{\
56
+.    de IX
57
+.    tm Index:\\$1\t\\n%\t"\\$2"
58
+..
59
+.    nr % 0
60
+.    rr F
61
+.\}
62
+.\"
63
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
64
+.\" way too many mistakes in technical documents.
65
+.hy 0
66
+.if n .na
67
+.\"
68
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
70
+.    \" fudge factors for nroff and troff
71
+.if n \{\
72
+.    ds #H 0
73
+.    ds #V .8m
74
+.    ds #F .3m
75
+.    ds #[ \f1
76
+.    ds #] \fP
77
+.\}
78
+.if t \{\
79
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80
+.    ds #V .6m
81
+.    ds #F 0
82
+.    ds #[ \&
83
+.    ds #] \&
84
+.\}
85
+.    \" simple accents for nroff and troff
86
+.if n \{\
87
+.    ds ' \&
88
+.    ds ` \&
89
+.    ds ^ \&
90
+.    ds , \&
91
+.    ds ~ ~
92
+.    ds /
93
+.\}
94
+.if t \{\
95
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
96
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
97
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
98
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
99
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
100
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
101
+.\}
102
+.    \" troff and (daisy-wheel) nroff accents
103
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
104
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
105
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
106
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
107
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
108
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
109
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
110
+.ds ae a\h'-(\w'a'u*4/10)'e
111
+.ds Ae A\h'-(\w'A'u*4/10)'E
112
+.    \" corrections for vroff
113
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
114
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
115
+.    \" for low resolution devices (crt and lpr)
116
+.if \n(.H>23 .if \n(.V>19 \
117
+\{\
118
+.    ds : e
119
+.    ds 8 ss
120
+.    ds o a
121
+.    ds d- d\h'-1'\(ga
122
+.    ds D- D\h'-1'\(hy
123
+.    ds th \o'bp'
124
+.    ds Th \o'LP'
125
+.    ds ae ae
126
+.    ds Ae AE
127
+.\}
128
+.rm #[ #] #H #V #F C
129
+.\" ========================================================================
130
+.\"
131
+.IX Title "DBIx::Custom::Guide 3"
132
+.TH DBIx::Custom::Guide 3 "2011-07-30" "perl v5.8.8" "User Contributed Perl Documentation"
133
+.SH "NAME"
134
+DBIx::Custom::Guide \- DBIx::Custom Guide
135
+.SH "FEATURES"
136
+.IX Header "FEATURES"
137
+DBIx::Custom is the wrapper class of \s-1DBI\s0 to execute \s-1SQL\s0 easily.
138
+This module have the following features.
139
+.IP "* Execute \s-1INSERT\s0, \s-1UPDATE\s0, \s-1DELETE\s0, \s-1SELECT\s0 statement easily" 4
140
+.IX Item "Execute INSERT, UPDATE, DELETE, SELECT statement easily"
141
+.PD 0
142
+.IP "* You can specify bind values by hash reference" 4
143
+.IX Item "You can specify bind values by hash reference"
144
+.IP "* Filtering by data type. and you can set filter to any column" 4
145
+.IX Item "Filtering by data type. and you can set filter to any column"
146
+.IP "* Creating where clause and order by clause flexibly" 4
147
+.IX Item "Creating where clause and order by clause flexibly"
148
+.IP "* Support model" 4
149
+.IX Item "Support model"
150
+.PD
151
+.SH "GUIDE"
152
+.IX Header "GUIDE"
153
+.Sh "Connect to database"
154
+.IX Subsection "Connect to database"
155
+.Vb 7
156
+\&    use DBIx::Custom;
157
+\&    my $dbi = DBIx::Custom->connect(
158
+\&        dsn => "dbi:mysql:database=bookshop",
159
+\&        user => 'ken',
160
+\&        password => '!LFKD%$&',
161
+\&        dbi_option => {mysql_enable_utf8 => 1}
162
+\&    );
163
+.Ve
164
+.PP
165
+You can connect to database by \f(CW\*(C`connect\*(C'\fR method.
166
+\&\f(CW\*(C`dsn\*(C'\fR is data source name, \f(CW\*(C`user\*(C'\fR is user name, \f(CW\*(C`password\*(C'\fR is password.
167
+.PP
168
+\&\f(CW\*(C`dbi_option\*(C'\fR is \s-1DBI\s0 option.
169
+By default, the following option is set.
170
+Exeption is thrown when fatal error occur and commit mode is auto commit.
171
+.PP
172
+.Vb 5
173
+\&    {
174
+\&        RaiseError  =>  1
175
+\&        PrintError  =>  0
176
+\&        AutoCommit  =>  1
177
+\&    }
178
+.Ve
179
+.Sh "Execute query"
180
+.IX Subsection "Execute query"
181
+\fIInsert Statement : \f(CI\*(C`insert\*(C'\fI\fR
182
+.IX Subsection "Insert Statement : insert"
183
+.PP
184
+If you want to execute insert statement, use \f(CW\*(C`insert\*(C'\fR method.
185
+.PP
186
+.Vb 1
187
+\&    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
188
+.Ve
189
+.PP
190
+First argument is insert row data, \f(CW\*(C`table\*(C'\fR  is table name.
191
+.PP
192
+\fIUpdate Statement : \f(CI\*(C`update\*(C'\fI\fR
193
+.IX Subsection "Update Statement : update"
194
+.PP
195
+If you want to execute update stateimuse, use \f(CW\*(C`update\*(C'\fR method.
196
+.PP
197
+.Vb 5
198
+\&    $dbi->update(
199
+\&        {title => 'Perl', author => 'Ken'},
200
+\&        table  => 'book', 
201
+\&        where  => {id => 5}
202
+\&    );
203
+.Ve
204
+.PP
205
+First argument is update row data, \f(CW\*(C`table\*(C'\fR is table name, \f(CW\*(C`where\*(C'\fR is condition.
206
+.PP
207
+Note that you can't execute \f(CW\*(C`update\*(C'\fR method without \f(CW\*(C`where\*(C'\fR.
208
+If you want to update all rows, use update_all.
209
+.PP
210
+.Vb 1
211
+\&    $dbi->update_all({title => 'Perl', author => 'Ken'}, table  => 'book');
212
+.Ve
213
+.PP
214
+\fIDelete Statement : \f(CI\*(C`delete\*(C'\fI\fR
215
+.IX Subsection "Delete Statement : delete"
216
+.PP
217
+If you want to execute delete statement, use \f(CW\*(C`delete\*(C'\fR method.
218
+.PP
219
+.Vb 1
220
+\&    $dbi->delete(table  => 'book', where  => {author => 'Ken'});
221
+.Ve
222
+.PP
223
+\&\f(CW\*(C`table\*(C'\fR is table name, \f(CW\*(C`where\*(C'\fR is condition.
224
+.PP
225
+Note that you can't execute \f(CW\*(C`delete\*(C'\fR method without \f(CW\*(C`where\*(C'\fR.
226
+If you want to delete all rows, use \f(CW\*(C`delete_all\*(C'\fR method.
227
+.PP
228
+.Vb 1
229
+\&    $dbi->delete_all(table  => 'book');
230
+.Ve
231
+.PP
232
+\fISelect Statement : \f(CI\*(C`select\*(C'\fI\fR
233
+.IX Subsection "Select Statement : select"
234
+.PP
235
+If you want to execute select statement, use \f(CW\*(C`select\*(C'\fR method.
236
+.PP
237
+.Vb 1
238
+\&    my $result = $dbi->select(table => 'book');
239
+.Ve
240
+.PP
241
+Return value is DBIx::Custom::Result object.
242
+You can fetch rows by \f(CW\*(C`fetch\*(C'\fR method.
243
+.PP
244
+.Vb 4
245
+\&    while (my $row = $result->fetch) {
246
+\&        my $title  = $row->[0];
247
+\&        my $author = $row->[1];
248
+\&    }
249
+.Ve
250
+.PP
251
+See also \*(L"Fetch row\*(R" in Fetch row about DBIx::Custom::Result.
252
+.PP
253
+You can specify column names by \f(CW\*(C`column\*(C'\fR option
254
+and condition by \f(CW\*(C`where\*(C'\fR option.
255
+.PP
256
+.Vb 5
257
+\&    my $result = $dbi->select(
258
+\&        table  => 'book',
259
+\&        column => ['author',  'title'],
260
+\&        where  => {author => 'Ken'}
261
+\&    );
262
+.Ve
263
+.PP
264
+You can specify join clause by \f(CW\*(C`join\*(C'\fR option.
265
+.PP
266
+.Vb 6
267
+\&    my $result = $dbi->select(
268
+\&        table  => 'book',
269
+\&        column => ['company.name as company_name']
270
+\&        where  => {'book.name' => 'Perl'},
271
+\&        join   => ['left outer join company on book.company_id = company.id]
272
+\&    );
273
+.Ve
274
+.PP
275
+Note that join clause is joined only when \f(CW\*(C`where\*(C'\fR or \f(CW\*(C`column\*(C'\fR option contains table name,
276
+such as book.name.
277
+.PP
278
+You can append statement to the end of whole statement by \f(CW\*(C`append\*(C'\fR option.
279
+.PP
280
+.Vb 5
281
+\&    my $result = $dbi->select(
282
+\&        table  => 'book',
283
+\&        where  => {author => 'Ken'},
284
+\&        append => 'for update',
285
+\&    );
286
+.Ve
287
+.PP
288
+\fI\f(CI\*(C`execute\*(C'\fI\fR
289
+.IX Subsection "execute"
290
+.PP
291
+If you want to execute \s-1SQL\s0, use \f(CW\*(C`execute\*(C'\fR method.
292
+.PP
293
+.Vb 1
294
+\&    $dbi->execute("select * from book;");
295
+.Ve
296
+.PP
297
+You can specify named placeholder.
298
+.PP
299
+.Vb 4
300
+\&    $dbi->execute(
301
+\&        "select * from book title = :title and author = :author;"
302
+\&        {title => 'Perl', author => 'Ken'}
303
+\&    );
304
+.Ve
305
+.PP
306
+:title and :author is named placeholder, which is replaced to placeholers.
307
+.PP
308
+.Vb 1
309
+\&    select * from book title = ? and author = ?;
310
+.Ve
311
+.PP
312
+\fI\f(CI\*(C`dbh\*(C'\fI\fR
313
+.IX Subsection "dbh"
314
+.PP
315
+.Vb 1
316
+\&    my $dbh = $dbi->dbh;
317
+.Ve
318
+.PP
319
+Get get database handle object of \s-1DBI\s0.
320
+.PP
321
+\fI\f(CI\*(C`DBI\*(C'\fI methods\fR
322
+.IX Subsection "DBI methods"
323
+.PP
324
+.Vb 2
325
+\&    $dbi->do(...);
326
+\&    $dbi->begin_work;
327
+.Ve
328
+.PP
329
+You can call all methods of \s-1DBI\s0 from DBIx::Custom object.
330
+.Sh "Fetch Rows"
331
+.IX Subsection "Fetch Rows"
332
+\&\f(CW\*(C`select\*(C'\fR method return value is DBIx::Custom::Result object.
333
+You can fetch a row or rows by various methods.
334
+.PP
335
+\fIFetch a row (array) : \f(CI\*(C`fetch\*(C'\fI\fR
336
+.IX Subsection "Fetch a row (array) : fetch"
337
+.PP
338
+.Vb 1
339
+\&    my $row = $result->fetch;
340
+.Ve
341
+.PP
342
+\&\f(CW\*(C`fetch\*(C'\fR method fetch a row and put it into array reference.
343
+You can continue to fetch 
344
+.PP
345
+.Vb 4
346
+\&    while (my $row = $result->fetch) {
347
+\&        my $title  = $row->[0];
348
+\&        my $author = $row->[1];
349
+\&    }
350
+.Ve
351
+.PP
352
+\fIFetch only first row (array) : \f(CI\*(C`fetch_first\*(C'\fI\fR
353
+.IX Subsection "Fetch only first row (array) : fetch_first"
354
+.PP
355
+.Vb 1
356
+\&    my $row = $result->fetch_first;
357
+.Ve
358
+.PP
359
+\&\f(CW\*(C`fetch_first\*(C'\fR fetch a only first row and finish statment handle,
360
+and put it into array refrence.
361
+.PP
362
+\fIFetch all rows (array) : \f(CI\*(C`fetch_all\*(C'\fI\fR
363
+.IX Subsection "Fetch all rows (array) : fetch_all"
364
+.PP
365
+.Vb 1
366
+\&    my $rows = $result->fetch_all;
367
+.Ve
368
+.PP
369
+\&\f(CW\*(C`fetch_all\*(C'\fR fetch all rows and put them into array of array reference.
370
+.PP
371
+\fIFetch a row (hash) : \f(CI\*(C`fetch_hash\*(C'\fI\fR
372
+.IX Subsection "Fetch a row (hash) : fetch_hash"
373
+.PP
374
+.Vb 1
375
+\&    my $row = $result->fetch_hash;
376
+.Ve
377
+.PP
378
+\&\f(CW\*(C`fetch_hash\*(C'\fR fetch a row and put it into hash reference.
379
+You can fetch a row while row exists.
380
+.PP
381
+.Vb 4
382
+\&    while (my $row = $result->fetch_hash) {
383
+\&        my $title  = $row->{title};
384
+\&        my $author = $row->{author};
385
+\&    }
386
+.Ve
387
+.PP
388
+\fIFetch only a first row (hash) : \f(CI\*(C`fetch_hash_first\*(C'\fI\fR
389
+.IX Subsection "Fetch only a first row (hash) : fetch_hash_first"
390
+.PP
391
+.Vb 1
392
+\&    my $row = $result->fetch_hash_first;
393
+.Ve
394
+.PP
395
+\&\f(CW\*(C`fetch_hash_first\*(C'\fR fetch only a first row and finish statement handle,
396
+and put them into hash refrence.
397
+.PP
398
+\&\f(CW\*(C`one\*(C'\fR is \f(CW\*(C`fetch_hash_first\*(C'\fR synonym to save word typing.
399
+.PP
400
+.Vb 1
401
+\&    my $row = $result->one;
402
+.Ve
403
+.PP
404
+\fIFetch all rows (hash) : \f(CI\*(C`fetch_hash_all\*(C'\fI\fR
405
+.IX Subsection "Fetch all rows (hash) : fetch_hash_all"
406
+.PP
407
+.Vb 1
408
+\&    my $rows = $result->fetch_hash_all;
409
+.Ve
410
+.PP
411
+\&\f(CW\*(C`fetch_hash_all\*(C'\fR fetch all rows and put them into array of hash reference.
412
+.PP
413
+\fIStatement Handle : \f(CI\*(C`sth\*(C'\fI\fR
414
+.IX Subsection "Statement Handle : sth"
415
+.PP
416
+.Vb 1
417
+\&    my $sth = $result->sth;
418
+.Ve
419
+.PP
420
+If you want to get statment handle, use <sth> method.
421
+.Sh "Named placeholder"
422
+.IX Subsection "Named placeholder"
423
+\fIBasic of Parameter\fR
424
+.IX Subsection "Basic of Parameter"
425
+.PP
426
+You can embedd named placeholder into \s-1SQL\s0.
427
+.PP
428
+.Vb 1
429
+\&    select * from book where title = :title and author like :author;
430
+.Ve
431
+.PP
432
+:title and :author is named placeholder
433
+.PP
434
+Named placeholder is replaced by place holder.
435
+.PP
436
+.Vb 1
437
+\&    select * from book where title = ? and author like ?;
438
+.Ve
439
+.PP
440
+use \f(CW\*(C`execute\*(C'\fR to execute \s-1SQL\s0.
441
+.PP
442
+.Vb 2
443
+\&    my $sql = "select * from book where title = :title and author like :author;"
444
+\&    $dbi->execute($sql, {title => 'Perl', author => '%Ken%'});
445
+.Ve
446
+.PP
447
+You can specify \f(CW\*(C`filter\*(C'\fR at \f(CW\*(C`execute\*(C'\fR.
448
+.PP
449
+.Vb 2
450
+\&    $dbi->execute($sql, {title => 'Perl', author => '%Ken%'}
451
+\&                  filter => {title => 'to_something');
452
+.Ve
453
+.PP
454
+\fIManipulate same name's columns\fR
455
+.IX Subsection "Manipulate same name's columns"
456
+.PP
457
+It is ok if there are same name's columns.
458
+Let's think two date comparison.
459
+.PP
460
+.Vb 1
461
+\&    my $sql = "select * from table where date > :date and date < :date;";
462
+.Ve
463
+.PP
464
+In this case, You specify parameter values as array reference.
465
+.PP
466
+.Vb 1
467
+\&    my $dbi->execute($sql, {date => ['2010-10-01', '2012-02-10']});
468
+.Ve
469
+.Sh "Create where clause"
470
+.IX Subsection "Create where clause"
471
+\fIDinamically create where clause : where\fR
472
+.IX Subsection "Dinamically create where clause : where"
473
+.PP
474
+You want to search multiple conditions in many times.
475
+Let's think the following three cases.
476
+.PP
477
+Case1: Search only \f(CW\*(C`title\*(C'\fR
478
+.PP
479
+.Vb 1
480
+\&    where title = :title
481
+.Ve
482
+.PP
483
+Case2: Search only \f(CW\*(C`author\*(C'\fR
484
+.PP
485
+.Vb 1
486
+\&    where author = :author
487
+.Ve
488
+.PP
489
+Case3: Search \f(CW\*(C`title\*(C'\fR and \f(CW\*(C`author\*(C'\fR
490
+.PP
491
+.Vb 1
492
+\&    where title = :title and author = :author
493
+.Ve
494
+.PP
495
+DBIx::Custom support dinamic where clause creating.
496
+At first, create DBIx::Custom::Where object by \f(CW\*(C`where\*(C'\fR.
497
+.PP
498
+.Vb 1
499
+\&    my $where = $dbi->where;
500
+.Ve
501
+.PP
502
+Set clause by \f(CW\*(C`clause\*(C'\fR
503
+.PP
504
+.Vb 3
505
+\&    $where->clause(
506
+\&        ['and', 'title = :title, 'author = :author']
507
+\&    );
508
+.Ve
509
+.PP
510
+\&\f(CW\*(C`clause\*(C'\fR is the following format.
511
+.PP
512
+.Vb 1
513
+\&    ['or' or 'and', PART1, PART1, PART1]
514
+.Ve
515
+.PP
516
+First argument is 'or' or 'and'.
517
+Later than first argument are part which contains named placeholder.
518
+.PP
519
+You can write more complex format.
520
+.PP
521
+.Vb 4
522
+\&    ['and', 
523
+\&      'title = :title', 
524
+\&      ['or', 'author = :author', 'date like :date']
525
+\&    ]
526
+.Ve
527
+.PP
528
+This mean \*(L"title = :title and ( author = :author or date like :date )\*(R".
529
+.PP
530
+After setting \f(CW\*(C`clause\*(C'\fR, set \f(CW\*(C`param\*(C'\fR.
531
+.PP
532
+.Vb 1
533
+\&    $where->param({title => 'Perl'});
534
+.Ve
535
+.PP
536
+In this example, parameter contains only title.
537
+.PP
538
+If you execute \f(CW\*(C`string_to\*(C'\fR, you can get where clause
539
+which contain only named placeholder.
540
+.PP
541
+.Vb 1
542
+\&    my $where_clause = $where->to_string;
543
+.Ve
544
+.PP
545
+Parameter name is only title, the following where clause is created.
546
+.PP
547
+.Vb 1
548
+\&    where title = :title
549
+.Ve
550
+.PP
551
+You can also create where clause by stringification.
552
+.PP
553
+.Vb 1
554
+\&    my $where_clause = "$where";
555
+.Ve
556
+.PP
557
+This is useful to embbed it into \s-1SQL\s0. 
558
+.PP
559
+\fIIn case where clause contains same name columns\fR
560
+.IX Subsection "In case where clause contains same name columns"
561
+.PP
562
+Even if same name parameters exists, you can create where clause.
563
+Let's think that there are starting date and ending date.
564
+.PP
565
+.Vb 1
566
+\&    my $param = {start_date => '2010-11-15', end_date => '2011-11-21'};
567
+.Ve
568
+.PP
569
+In this case, you set parameter value as array reference.
570
+.PP
571
+.Vb 1
572
+\&    my $p = {date => ['2010-11-15', '2011-11-21']};
573
+.Ve
574
+.PP
575
+You can embbed these values into same name parameters.
576
+.PP
577
+.Vb 4
578
+\&    $where->clause(
579
+\&        ['and', 'date > :date', 'date < :date']
580
+\&    );
581
+\&    $where->param($p);
582
+.Ve
583
+.PP
584
+If starting date isn't exists, create the following parameter.
585
+.PP
586
+.Vb 1
587
+\&    my $p = {date => [$dbi->not_exists, '2011-11-21']};
588
+.Ve
589
+.PP
590
+You can get DBIx::Custom::NotExists object by \f(CW\*(C`not_exists\*(C'\fR
591
+This mean correnspondinf value isn't exists.
592
+.PP
593
+If ending date isn't exists, create the following parameter.
594
+.PP
595
+.Vb 1
596
+\&    my $p = {date => ['2010-11-15']};
597
+.Ve
598
+.PP
599
+If both date isn't exists, create the following parameter.
600
+.PP
601
+.Vb 1
602
+\&    my $p = {date => []};
603
+.Ve
604
+.PP
605
+This logic is a little difficut. See the following ones.
606
+.PP
607
+.Vb 5
608
+\&    my @date;
609
+\&    push @date, exists $param->{start_date} ? $param->{start_date}
610
+\&                                            : $dbi->not_exists;
611
+\&    push @date, $param->{end_date} if exists $param->{end_date};
612
+\&    my $p = {date => \e@date};
613
+.Ve
614
+.PP
615
+\fIWith \f(CI\*(C`select\*(C'\fI\fR
616
+.IX Subsection "With select"
617
+.PP
618
+You can pass DBIx::Custom::Where object to \f(CW\*(C`where\*(C'\fR of \f(CW\*(C`select\*(C'\fR.
619
+.PP
620
+.Vb 4
621
+\&    my $where = $dbi->where;
622
+\&    $where->clause(['and', 'title = :title', 'author = :author']);
623
+\&    $where->param({title => 'Perl'});
624
+\&    my $result = $dbi->select(table => 'book', where => $where);
625
+.Ve
626
+.PP
627
+You can also pass it to \f(CW\*(C`where\*(C'\fR of \f(CW\*(C`update\*(C'\fRA\f(CW\*(C`delete\*(C'\fR
628
+.PP
629
+\fIWith \f(CI\*(C`execute\*(C'\fI\fR
630
+.IX Subsection "With execute"
631
+.PP
632
+DBIx::Custom::Where object is embedded into \s-1SQL\s0.
633
+.PP
634
+.Vb 3
635
+\&    my $where = $dbi->where;
636
+\&    $where->clause(['and', 'title = :title', 'author = :author']);
637
+\&    $where->param({title => 'Perl'});
638
+.Ve
639
+.PP
640
+.Vb 4
641
+\&    my $sql = <<"EOS";
642
+\&    select * from book;
643
+\&    $where
644
+\&    EOS
645
+.Ve
646
+.PP
647
+.Vb 1
648
+\&    $dbi->execute($sql, $param, table => 'book');
649
+.Ve
650
+.Sh "Filtering"
651
+.IX Subsection "Filtering"
652
+\fIRegister filter : \f(CI\*(C`register_filter\*(C'\fI\fR
653
+.IX Subsection "Register filter : register_filter"
654
+.PP
655
+If you want to register filter, use \f(CW\*(C`register_filter\*(C'\fR.
656
+.PP
657
+.Vb 6
658
+\&    $dbi->register_filter(
659
+\&        # Time::Piece object to DATE format
660
+\&        tp_to_date => sub {
661
+\&            my $date = shift;
662
+\&            return $tp->strftime('%Y-%m-%d');
663
+\&        },
664
+.Ve
665
+.PP
666
+.Vb 6
667
+\&        # DATE to Time::Piece object
668
+\&        date_to_tp => sub {
669
+\&            my $date = shift;
670
+\&            return Time::Piece->strptime($date, '%Y-%m-%d');
671
+\&        },
672
+\&    );
673
+.Ve
674
+.PP
675
+\fIFilter before sending data into database : \f(CI\*(C`filter\*(C'\fI option\fR
676
+.IX Subsection "Filter before sending data into database : filter option"
677
+.PP
678
+If you filter sending data, use \f(CW\*(C`filter\*(C'\fR option.
679
+.PP
680
+.Vb 5
681
+\&    $dbi->execute(
682
+\&        'insert into book (date) values (:date)',
683
+\&        {date => $tp},
684
+\&        filter => {date => 'tp_to_date'}
685
+\&    );
686
+.Ve
687
+.PP
688
+You can use \f(CW\*(C`filter\*(C'\fR option in \f(CW\*(C`insert\*(C'\fR, \f(CW\*(C`update\*(C'\fR, \f(CW\*(C`delete\*(C'\fR, \f(CW\*(C`select\*(C'\fR method.
689
+.PP
690
+.Vb 5
691
+\&    $dbi->insert(
692
+\&        {date => $tp},
693
+\&        table => 'book',
694
+\&        filter => {date => 'tp_to_date'}
695
+\&    );
696
+.Ve
697
+.PP
698
+\fIFilter after fetching data from database.\fR
699
+.IX Subsection "Filter after fetching data from database."
700
+.PP
701
+If you filter fetch data, use DBIx::Custom::Result's \f(CW\*(C`filter\*(C'\fR method.
702
+.PP
703
+.Vb 3
704
+\&    my $result = $dbi->select(column => 'date', table => 'book');
705
+\&    $result->filter(date => 'date_to_tp');
706
+\&    my $row = $result->one;
707
+.Ve
708
+.Sh "7. Model"
709
+.IX Subsection "7. Model"
710
+\fIModel\fR
711
+.IX Subsection "Model"
712
+.PP
713
+you can define model extending DBIx::Custom::Model
714
+to improve source code view.
715
+.PP
716
+At first, you create basic model class extending <DBIx::Custom::Model>.
717
+Each DBIx::Custom class inherit Object::Simple.
718
+so you can inherit the following way.
719
+.PP
720
+.Vb 2
721
+\&    package MyModel;
722
+\&    use DBIx::Custom::Model -base;
723
+.Ve
724
+.PP
725
+Next, you create each model classes.
726
+.PP
727
+MyModel::book
728
+.PP
729
+.Vb 2
730
+\&    package MyModel::book;
731
+\&    use MyModel -base;
732
+.Ve
733
+.PP
734
+.Vb 2
735
+\&    sub insert { ... }
736
+\&    sub list { ... }
737
+.Ve
738
+.PP
739
+MyModel::company
740
+.PP
741
+.Vb 2
742
+\&    package MyModel::company;
743
+\&    use MyModel -base;
744
+.Ve
745
+.PP
746
+.Vb 2
747
+\&    sub insert { ... }
748
+\&    sub list { ... }
749
+.Ve
750
+.PP
751
+The follwoing modules location is needed.
752
+.PP
753
+.Vb 3
754
+\&    MyModel.pm
755
+\&    MyModel / book.pm
756
+\&            / company.pm
757
+.Ve
758
+.PP
759
+You can include these models by \f(CW\*(C`include_model\*(C'\fR
760
+.PP
761
+.Vb 1
762
+\&    $dbi->include_model('MyModel');
763
+.Ve
764
+.PP
765
+First argument is name space of model.
766
+.PP
767
+You can use model like this.
768
+.PP
769
+.Vb 1
770
+\&    my $result = $dbi->model('book')->list;
771
+.Ve
772
+.PP
773
+In mode, You can use such as methods,
774
+\&\f(CW\*(C`insert\*(C'\fR, \f(CW\*(C`update\*(C'\fR, \f(CW\*(C`update_all\*(C'\fR,
775
+\&\f(CW\*(C`delete\*(C'\fR, \f(CW\*(C`delete_all\*(C'\fR, \f(CW\*(C`select\*(C'\fR
776
+without \f(CW\*(C`table\*(C'\fR option.
777
+.PP
778
+.Vb 1
779
+\&    $dbi->model('book')->insert($param);
780
+.Ve
781
+.PP
782
+Model is DBIx::Custom::Model.
783
+.PP
784
+If you need table nameAyou can get it by \f(CW\*(C`table\*(C'\fR.
785
+.PP
786
+.Vb 1
787
+\&    my $table = $model->table;
788
+.Ve
789
+.PP
790
+You can get DBIx::Custom.
791
+.PP
792
+.Vb 1
793
+\&    my $dbi = $model->dbi;
794
+.Ve
795
+.PP
796
+You can also call all methods of DBIx::Custom and \s-1DBI\s0. 
797
+.PP
798
+.Vb 2
799
+\&    # DBIx::Custom method
800
+\&    $model->execute($sql);
801
+.Ve
802
+.PP
803
+.Vb 3
804
+\&    # DBI method
805
+\&    $model->begin_work;
806
+\&    $model->commit;
807
+.Ve
808
+.PP
809
+If you want to get all models, you can get them by keys of \f(CW\*(C`models\*(C'\fR.
810
+.PP
811
+.Vb 1
812
+\&    my @models = keys %{$self->models};
813
+.Ve
814
+.PP
815
+You can set primary key to model.
816
+.PP
817
+.Vb 1
818
+\&   $model->primary_key(['id', 'number_id']);
819
+.Ve
820
+.PP
821
+Primary key is used by \f(CW\*(C`insert\*(C'\fR, \f(CW\*(C`update\*(C'\fR, \f(CW\*(C`delete\*(C'\fR,
822
+and \f(CW\*(C`select\*(C'\fR methods.
823
+.PP
824
+You can set column names
825
+.PP
826
+.Vb 1
827
+\&    $model->columns(['id', 'number_id']);
828
+.Ve
829
+.PP
830
+Column names is automarically set by \f(CW\*(C`setup_model\*(C'\fR.
831
+This method is needed to be call after \f(CW\*(C`include_model\*(C'\fR.
832
+.PP
833
+.Vb 1
834
+\&    $dbi->setup_model;
835
+.Ve
836
+.PP
837
+You can set \f(CW\*(C`join\*(C'\fR
838
+.PP
839
+.Vb 1
840
+\&    $model->join(['left outer join company on book.company_id = company.id']);
841
+.Ve
842
+.PP
843
+\&\f(CW\*(C`join\*(C'\fR is used by \f(CW\*(C`select\*(C'\fR method.
844
+.Sh "Create column clause automatically : mycolumn, column"
845
+.IX Subsection "Create column clause automatically : mycolumn, column"
846
+To create column clause automatically, use \f(CW\*(C`mycolumn\*(C'\fR.
847
+Valude of \f(CW\*(C`table\*(C'\fR and \f(CW\*(C`columns\*(C'\fR is used.
848
+.PP
849
+.Vb 1
850
+\&    my $mycolumns = $model->mycolumn;
851
+.Ve
852
+.PP
853
+If \f(CW\*(C`table\*(C'\fR is 'book'A\f(CW\*(C`column\*(C'\fR is ['id', 'name'],
854
+the following clause is created.
855
+.PP
856
+.Vb 1
857
+\&    book.id as id, book.name as name
858
+.Ve
859
+.PP
860
+These column name is for removing column name ambiguities.
861
+.PP
862
+You can create column clause from columns of other table.
863
+.PP
864
+.Vb 1
865
+\&    my $columns = $model->column('company');
866
+.Ve
867
+.PP
868
+If \f(CW\*(C`table\*(C'\fR is \*(L"company\*(R", \f(CW\*(C`column\*(C'\fR return ['id', 'name'],
869
+the following clause is created.
870
+.PP
871
+.Vb 1
872
+\&    company.id as "company.id", company.name as "company.name"
873
+.Ve
874
+.Sh "Model Examples"
875
+.IX Subsection "Model Examples"
876
+Model examples
877
+.PP
878
+.Vb 2
879
+\&    package MyDBI;
880
+\&    use DBIx::Custom -base;
881
+.Ve
882
+.PP
883
+.Vb 2
884
+\&    sub connect {
885
+\&        my $self = shift->SUPER::connect(@_);
886
+.Ve
887
+.PP
888
+.Vb 7
889
+\&        $self->include_model(
890
+\&            MyModel => [
891
+\&                'book',
892
+\&                'company'
893
+\&            ]
894
+\&        );
895
+\&    }
896
+.Ve
897
+.PP
898
+.Vb 2
899
+\&    package MyModel::book;
900
+\&    use DBIx::Custom::Model -base;
901
+.Ve
902
+.PP
903
+.Vb 1
904
+\&    has primary_key => sub { ['id'] };
905
+.Ve
906
+.PP
907
+.Vb 2
908
+\&    sub insert { ... }
909
+\&    sub list { ... }
910
+.Ve
911
+.PP
912
+.Vb 2
913
+\&    package MyModel::company;
914
+\&    use DBIx::Custom::Model -base;
915
+.Ve
916
+.PP
917
+.Vb 1
918
+\&    has primary_key => sub { ['id'] };
919
+.Ve
920
+.PP
921
+.Vb 2
922
+\&    sub insert { ... }
923
+\&    sub list { ... }
924
+.Ve
+139
DBIx-Custom-0.1711/blib/man3/DBIx::Custom::Guide::Ja.3pm
... ...
@@ -0,0 +1,139 @@
1
+.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2
+.\"
3
+.\" Standard preamble:
4
+.\" ========================================================================
5
+.de Sh \" Subsection heading
6
+.br
7
+.if t .Sp
8
+.ne 5
9
+.PP
10
+\fB\\$1\fR
11
+.PP
12
+..
13
+.de Sp \" Vertical space (when we can't use .PP)
14
+.if t .sp .5v
15
+.if n .sp
16
+..
17
+.de Vb \" Begin verbatim text
18
+.ft CW
19
+.nf
20
+.ne \\$1
21
+..
22
+.de Ve \" End verbatim text
23
+.ft R
24
+.fi
25
+..
26
+.\" Set up some character translations and predefined strings.  \*(-- will
27
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
28
+.\" double quote, and \*(R" will give a right double quote.  | will give a
29
+.\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used to
30
+.\" do unbreakable dashes and therefore won't be available.  \*(C` and \*(C'
31
+.\" expand to `' in nroff, nothing in troff, for use with C<>.
32
+.tr \(*W-|\(bv\*(Tr
33
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34
+.ie n \{\
35
+.    ds -- \(*W-
36
+.    ds PI pi
37
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
38
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
39
+.    ds L" ""
40
+.    ds R" ""
41
+.    ds C` ""
42
+.    ds C' ""
43
+'br\}
44
+.el\{\
45
+.    ds -- \|\(em\|
46
+.    ds PI \(*p
47
+.    ds L" ``
48
+.    ds R" ''
49
+'br\}
50
+.\"
51
+.\" If the F register is turned on, we'll generate index entries on stderr for
52
+.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
54
+.\" output yourself in some meaningful fashion.
55
+.if \nF \{\
56
+.    de IX
57
+.    tm Index:\\$1\t\\n%\t"\\$2"
58
+..
59
+.    nr % 0
60
+.    rr F
61
+.\}
62
+.\"
63
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
64
+.\" way too many mistakes in technical documents.
65
+.hy 0
66
+.if n .na
67
+.\"
68
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
70
+.    \" fudge factors for nroff and troff
71
+.if n \{\
72
+.    ds #H 0
73
+.    ds #V .8m
74
+.    ds #F .3m
75
+.    ds #[ \f1
76
+.    ds #] \fP
77
+.\}
78
+.if t \{\
79
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80
+.    ds #V .6m
81
+.    ds #F 0
82
+.    ds #[ \&
83
+.    ds #] \&
84
+.\}
85
+.    \" simple accents for nroff and troff
86
+.if n \{\
87
+.    ds ' \&
88
+.    ds ` \&
89
+.    ds ^ \&
90
+.    ds , \&
91
+.    ds ~ ~
92
+.    ds /
93
+.\}
94
+.if t \{\
95
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
96
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
97
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
98
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
99
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
100
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
101
+.\}
102
+.    \" troff and (daisy-wheel) nroff accents
103
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
104
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
105
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
106
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
107
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
108
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
109
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
110
+.ds ae a\h'-(\w'a'u*4/10)'e
111
+.ds Ae A\h'-(\w'A'u*4/10)'E
112
+.    \" corrections for vroff
113
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
114
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
115
+.    \" for low resolution devices (crt and lpr)
116
+.if \n(.H>23 .if \n(.V>19 \
117
+\{\
118
+.    ds : e
119
+.    ds 8 ss
120
+.    ds o a
121
+.    ds d- d\h'-1'\(ga
122
+.    ds D- D\h'-1'\(hy
123
+.    ds th \o'bp'
124
+.    ds Th \o'LP'
125
+.    ds ae ae
126
+.    ds Ae AE
127
+.\}
128
+.rm #[ #] #H #V #F C
129
+.\" ========================================================================
130
+.\"
131
+.IX Title "DBIx::Custom::Guide::Ja 3"
132
+.TH DBIx::Custom::Guide::Ja 3 "2011-07-11" "perl v5.8.8" "User Contributed Perl Documentation"
133
+.SH "NAME"
134
+DBIx::Custom::Guide \- DBIx::Customガイド
135
+.SH "LINK"
136
+.IX Header "LINK"
137
+ドキュメントは以下のリンクに移動しました。
138
+.PP
139
+<http://d.hatena.ne.jp/perlcodesample/20110401/1305597081>
+303
DBIx-Custom-0.1711/blib/man3/DBIx::Custom::Model.3pm
... ...
@@ -0,0 +1,303 @@
1
+.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2
+.\"
3
+.\" Standard preamble:
4
+.\" ========================================================================
5
+.de Sh \" Subsection heading
6
+.br
7
+.if t .Sp
8
+.ne 5
9
+.PP
10
+\fB\\$1\fR
11
+.PP
12
+..
13
+.de Sp \" Vertical space (when we can't use .PP)
14
+.if t .sp .5v
15
+.if n .sp
16
+..
17
+.de Vb \" Begin verbatim text
18
+.ft CW
19
+.nf
20
+.ne \\$1
21
+..
22
+.de Ve \" End verbatim text
23
+.ft R
24
+.fi
25
+..
26
+.\" Set up some character translations and predefined strings.  \*(-- will
27
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
28
+.\" double quote, and \*(R" will give a right double quote.  | will give a
29
+.\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used to
30
+.\" do unbreakable dashes and therefore won't be available.  \*(C` and \*(C'
31
+.\" expand to `' in nroff, nothing in troff, for use with C<>.
32
+.tr \(*W-|\(bv\*(Tr
33
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34
+.ie n \{\
35
+.    ds -- \(*W-
36
+.    ds PI pi
37
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
38
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
39
+.    ds L" ""
40
+.    ds R" ""
41
+.    ds C` ""
42
+.    ds C' ""
43
+'br\}
44
+.el\{\
45
+.    ds -- \|\(em\|
46
+.    ds PI \(*p
47
+.    ds L" ``
48
+.    ds R" ''
49
+'br\}
50
+.\"
51
+.\" If the F register is turned on, we'll generate index entries on stderr for
52
+.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
54
+.\" output yourself in some meaningful fashion.
55
+.if \nF \{\
56
+.    de IX
57
+.    tm Index:\\$1\t\\n%\t"\\$2"
58
+..
59
+.    nr % 0
60
+.    rr F
61
+.\}
62
+.\"
63
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
64
+.\" way too many mistakes in technical documents.
65
+.hy 0
66
+.if n .na
67
+.\"
68
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
70
+.    \" fudge factors for nroff and troff
71
+.if n \{\
72
+.    ds #H 0
73
+.    ds #V .8m
74
+.    ds #F .3m
75
+.    ds #[ \f1
76
+.    ds #] \fP
77
+.\}
78
+.if t \{\
79
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80
+.    ds #V .6m
81
+.    ds #F 0
82
+.    ds #[ \&
83
+.    ds #] \&
84
+.\}
85
+.    \" simple accents for nroff and troff
86
+.if n \{\
87
+.    ds ' \&
88
+.    ds ` \&
89
+.    ds ^ \&
90
+.    ds , \&
91
+.    ds ~ ~
92
+.    ds /
93
+.\}
94
+.if t \{\
95
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
96
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
97
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
98
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
99
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
100
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
101
+.\}
102
+.    \" troff and (daisy-wheel) nroff accents
103
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
104
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
105
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
106
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
107
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
108
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
109
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
110
+.ds ae a\h'-(\w'a'u*4/10)'e
111
+.ds Ae A\h'-(\w'A'u*4/10)'E
112
+.    \" corrections for vroff
113
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
114
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
115
+.    \" for low resolution devices (crt and lpr)
116
+.if \n(.H>23 .if \n(.V>19 \
117
+\{\
118
+.    ds : e
119
+.    ds 8 ss
120
+.    ds o a
121
+.    ds d- d\h'-1'\(ga
122
+.    ds D- D\h'-1'\(hy
123
+.    ds th \o'bp'
124
+.    ds Th \o'LP'
125
+.    ds ae ae
126
+.    ds Ae AE
127
+.\}
128
+.rm #[ #] #H #V #F C
129
+.\" ========================================================================
130
+.\"
131
+.IX Title "DBIx::Custom::Model 3"
132
+.TH DBIx::Custom::Model 3 "2011-07-30" "perl v5.8.8" "User Contributed Perl Documentation"
133
+.SH "NAME"
134
+DBIx::Custom::Model \- Model
135
+.SH "SYNOPSIS"
136
+.IX Header "SYNOPSIS"
137
+use DBIx::Custom::Table;
138
+.PP
139
+my \f(CW$table\fR = DBIx::Custom::Model\->new(table => 'books');
140
+.SH "ATTRIBUTES"
141
+.IX Header "ATTRIBUTES"
142
+.ie n .Sh """dbi"""
143
+.el .Sh "\f(CWdbi\fP"
144
+.IX Subsection "dbi"
145
+.Vb 2
146
+\&    my $dbi = $model->dbi;
147
+\&    $model = $model->dbi($dbi);
148
+.Ve
149
+.PP
150
+DBIx::Custom object.
151
+.ie n .Sh """join"""
152
+.el .Sh "\f(CWjoin\fP"
153
+.IX Subsection "join"
154
+.Vb 4
155
+\&    my $join = $model->join;
156
+\&    $model = $model->join(
157
+\&        ['left outer join company on book.company_id = company.id']
158
+\&    );
159
+.Ve
160
+.PP
161
+Join clause, this value is passed to \f(CW\*(C`select\*(C'\fR method.
162
+.ie n .Sh """primary_key"""
163
+.el .Sh "\f(CWprimary_key\fP"
164
+.IX Subsection "primary_key"
165
+.Vb 2
166
+\&    my $primary_key = $model->primary_key;
167
+\&    $model = $model->primary_key(['id', 'number']);
168
+.Ve
169
+.PP
170
+Primary key,this is passed to \f(CW\*(C`insert\*(C'\fR, \f(CW\*(C`update\*(C'\fR,
171
+\&\f(CW\*(C`delete\*(C'\fR, and \f(CW\*(C`select\*(C'\fR method.
172
+.ie n .Sh """table"""
173
+.el .Sh "\f(CWtable\fP"
174
+.IX Subsection "table"
175
+.Vb 2
176
+\&    my $table = $model->table;
177
+\&    $model = $model->table('book');
178
+.Ve
179
+.PP
180
+Table name, this is passed to \f(CW\*(C`select\*(C'\fR method.
181
+.ie n .Sh """bind_type"""
182
+.el .Sh "\f(CWbind_type\fP"
183
+.IX Subsection "bind_type"
184
+.Vb 2
185
+\&    my $type = $model->bind_type;
186
+\&    $model = $model->bind_type(['image' => DBI::SQL_BLOB]);
187
+.Ve
188
+.PP
189
+Database data type, this is used as type optioon of \f(CW\*(C`insert\*(C'\fR, 
190
+\&\f(CW\*(C`update\*(C'\fR, \f(CW\*(C`update_all\*(C'\fR, \f(CW\*(C`delete\*(C'\fR, \f(CW\*(C`delete_all\*(C'\fR,
191
+\&\f(CW\*(C`select\*(C'\fR, and \f(CW\*(C`execute\*(C'\fR method
192
+.SH "METHODS"
193
+.IX Header "METHODS"
194
+DBIx::Custom::Model inherits all methods from Object::Simple,
195
+and you can use all methods of DBIx::Custom and \s-1DBI\s0
196
+and implements the following new ones.
197
+.ie n .Sh """delete"""
198
+.el .Sh "\f(CWdelete\fP"
199
+.IX Subsection "delete"
200
+.Vb 1
201
+\&    $table->delete(...);
202
+.Ve
203
+.PP
204
+Same as \f(CW\*(C`delete\*(C'\fR of DBIx::Custom except that
205
+you don't have to specify \f(CW\*(C`table\*(C'\fR option.
206
+.ie n .Sh """delete_all"""
207
+.el .Sh "\f(CWdelete_all\fP"
208
+.IX Subsection "delete_all"
209
+.Vb 1
210
+\&    $table->delete_all(...);
211
+.Ve
212
+.PP
213
+Same as \f(CW\*(C`delete_all\*(C'\fR of DBIx::Custom except that
214
+you don't have to specify \f(CW\*(C`table\*(C'\fR option.
215
+.ie n .Sh """insert"""
216
+.el .Sh "\f(CWinsert\fP"
217
+.IX Subsection "insert"
218
+.Vb 1
219
+\&    $table->insert(...);
220
+.Ve
221
+.PP
222
+Same as \f(CW\*(C`insert\*(C'\fR of DBIx::Custom except that
223
+you don't have to specify \f(CW\*(C`table\*(C'\fR option.
224
+.ie n .Sh """method"""
225
+.el .Sh "\f(CWmethod\fP"
226
+.IX Subsection "method"
227
+.Vb 3
228
+\&    $model->method(
229
+\&        update_or_insert => sub {
230
+\&            my $self = shift;
231
+.Ve
232
+.PP
233
+.Vb 4
234
+\&            # ...
235
+\&        },
236
+\&        find_or_create   => sub {
237
+\&            my $self = shift;
238
+.Ve
239
+.PP
240
+.Vb 2
241
+\&            # ...
242
+\&    );
243
+.Ve
244
+.PP
245
+Register method. These method is called directly from DBIx::Custom::Model object.
246
+.PP
247
+.Vb 2
248
+\&    $model->update_or_insert;
249
+\&    $model->find_or_create;
250
+.Ve
251
+.ie n .Sh """mycolumn"""
252
+.el .Sh "\f(CWmycolumn\fP"
253
+.IX Subsection "mycolumn"
254
+.Vb 3
255
+\&    my $column = $self->mycolumn;
256
+\&    my $column = $self->mycolumn(book => ['author', 'title']);
257
+\&    my $column = $self->mycolumn(['author', 'title']);
258
+.Ve
259
+.PP
260
+Create column clause for myself. The follwoing column clause is created.
261
+.PP
262
+.Vb 2
263
+\&    book.author as author,
264
+\&    book.title as title
265
+.Ve
266
+.PP
267
+If table name is ommited, \f(CW\*(C`table\*(C'\fR attribute of the model is used.
268
+If column names is omitted, \f(CW\*(C`columns\*(C'\fR attribute of the model is used.
269
+.ie n .Sh """new"""
270
+.el .Sh "\f(CWnew\fP"
271
+.IX Subsection "new"
272
+.Vb 1
273
+\&    my $table = DBIx::Custom::Table->new;
274
+.Ve
275
+.PP
276
+Create a DBIx::Custom::Table object.
277
+.ie n .Sh """select"""
278
+.el .Sh "\f(CWselect\fP"
279
+.IX Subsection "select"
280
+.Vb 1
281
+\&    $table->select(...);
282
+.Ve
283
+.PP
284
+Same as \f(CW\*(C`select\*(C'\fR of DBIx::Custom except that
285
+you don't have to specify \f(CW\*(C`table\*(C'\fR option.
286
+.ie n .Sh """update"""
287
+.el .Sh "\f(CWupdate\fP"
288
+.IX Subsection "update"
289
+.Vb 1
290
+\&    $table->update(...);
291
+.Ve
292
+.PP
293
+Same as \f(CW\*(C`update\*(C'\fR of DBIx::Custom except that
294
+you don't have to specify \f(CW\*(C`table\*(C'\fR option.
295
+.ie n .Sh """update_all"""
296
+.el .Sh "\f(CWupdate_all\fP"
297
+.IX Subsection "update_all"
298
+.Vb 1
299
+\&    $table->update_all(param => \e%param);
300
+.Ve
301
+.PP
302
+Same as \f(CW\*(C`update_all\*(C'\fR of DBIx::Custom except that
303
+you don't have to specify table name.
+203
DBIx-Custom-0.1711/blib/man3/DBIx::Custom::Order.3pm
... ...
@@ -0,0 +1,203 @@
1
+.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2
+.\"
3
+.\" Standard preamble:
4
+.\" ========================================================================
5
+.de Sh \" Subsection heading
6
+.br
7
+.if t .Sp
8
+.ne 5
9
+.PP
10
+\fB\\$1\fR
11
+.PP
12
+..
13
+.de Sp \" Vertical space (when we can't use .PP)
14
+.if t .sp .5v
15
+.if n .sp
16
+..
17
+.de Vb \" Begin verbatim text
18
+.ft CW
19
+.nf
20
+.ne \\$1
21
+..
22
+.de Ve \" End verbatim text
23
+.ft R
24
+.fi
25
+..
26
+.\" Set up some character translations and predefined strings.  \*(-- will
27
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
28
+.\" double quote, and \*(R" will give a right double quote.  | will give a
29
+.\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used to
30
+.\" do unbreakable dashes and therefore won't be available.  \*(C` and \*(C'
31
+.\" expand to `' in nroff, nothing in troff, for use with C<>.
32
+.tr \(*W-|\(bv\*(Tr
33
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34
+.ie n \{\
35
+.    ds -- \(*W-
36
+.    ds PI pi
37
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
38
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
39
+.    ds L" ""
40
+.    ds R" ""
41
+.    ds C` ""
42
+.    ds C' ""
43
+'br\}
44
+.el\{\
45
+.    ds -- \|\(em\|
46
+.    ds PI \(*p
47
+.    ds L" ``
48
+.    ds R" ''
49
+'br\}
50
+.\"
51
+.\" If the F register is turned on, we'll generate index entries on stderr for
52
+.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
54
+.\" output yourself in some meaningful fashion.
55
+.if \nF \{\
56
+.    de IX
57
+.    tm Index:\\$1\t\\n%\t"\\$2"
58
+..
59
+.    nr % 0
60
+.    rr F
61
+.\}
62
+.\"
63
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
64
+.\" way too many mistakes in technical documents.
65
+.hy 0
66
+.if n .na
67
+.\"
68
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
70
+.    \" fudge factors for nroff and troff
71
+.if n \{\
72
+.    ds #H 0
73
+.    ds #V .8m
74
+.    ds #F .3m
75
+.    ds #[ \f1
76
+.    ds #] \fP
77
+.\}
78
+.if t \{\
79
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80
+.    ds #V .6m
81
+.    ds #F 0
82
+.    ds #[ \&
83
+.    ds #] \&
84
+.\}
85
+.    \" simple accents for nroff and troff
86
+.if n \{\
87
+.    ds ' \&
88
+.    ds ` \&
89
+.    ds ^ \&
90
+.    ds , \&
91
+.    ds ~ ~
92
+.    ds /
93
+.\}
94
+.if t \{\
95
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
96
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
97
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
98
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
99
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
100
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
101
+.\}
102
+.    \" troff and (daisy-wheel) nroff accents
103
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
104
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
105
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
106
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
107
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
108
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
109
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
110
+.ds ae a\h'-(\w'a'u*4/10)'e
111
+.ds Ae A\h'-(\w'A'u*4/10)'E
112
+.    \" corrections for vroff
113
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
114
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
115
+.    \" for low resolution devices (crt and lpr)
116
+.if \n(.H>23 .if \n(.V>19 \
117
+\{\
118
+.    ds : e
119
+.    ds 8 ss
120
+.    ds o a
121
+.    ds d- d\h'-1'\(ga
122
+.    ds D- D\h'-1'\(hy
123
+.    ds th \o'bp'
124
+.    ds Th \o'LP'
125
+.    ds ae ae
126
+.    ds Ae AE
127
+.\}
128
+.rm #[ #] #H #V #F C
129
+.\" ========================================================================
130
+.\"
131
+.IX Title "DBIx::Custom::Order 3"
132
+.TH DBIx::Custom::Order 3 "2011-08-02" "perl v5.8.8" "User Contributed Perl Documentation"
133
+.SH "NAME"
134
+DBIx::Custom::Order \- Order by EXPERIMENTAL
135
+.SH "SYNOPSIS"
136
+.IX Header "SYNOPSIS"
137
+.Vb 4
138
+\&    # Result
139
+\&    my $order = DBIx::Custom::Order->new;
140
+\&    $order->prepend('title', 'author desc');
141
+\&    my $order_by = "$order";
142
+.Ve
143
+.SH "ATTRIBUTES"
144
+.IX Header "ATTRIBUTES"
145
+.ie n .Sh """dbi"""
146
+.el .Sh "\f(CWdbi\fP"
147
+.IX Subsection "dbi"
148
+.Vb 2
149
+\&    my $dbi = $order->dbi;
150
+\&    $order = $order->dbi($dbi);
151
+.Ve
152
+.PP
153
+DBIx::Custom object.
154
+.ie n .Sh """orders"""
155
+.el .Sh "\f(CWorders\fP"
156
+.IX Subsection "orders"
157
+.Vb 2
158
+\&    my $orders = $result->orders;
159
+\&    $result = $result->orders(\e%orders);
160
+.Ve
161
+.PP
162
+Parts of order by clause
163
+.SH "METHODS"
164
+.IX Header "METHODS"
165
+DBIx::Custom::Result inherits all methods from Object::Simple
166
+and implements the following new ones.
167
+.ie n .Sh """prepend"""
168
+.el .Sh "\f(CWprepend\fP"
169
+.IX Subsection "prepend"
170
+.Vb 1
171
+\&    $order->prepend('title', 'author desc');
172
+.Ve
173
+.PP
174
+Prepend order parts to \f(CW\*(C`orders\*(C'\fR.
175
+.PP
176
+You can pass array reference, which contain column name and direction.
177
+Column name is quoted properly
178
+.PP
179
+.Vb 3
180
+\&    # Column name and direction
181
+\&    $order->prepend(['book-title']);
182
+\&    $order->prepend([qw/book-title desc/]);
183
+.Ve
184
+.PP
185
+This is expanded to the following way.
186
+.PP
187
+.Vb 2
188
+\&    "book-title"
189
+\&    "book-title" desc
190
+.Ve
191
+.ie n .Sh """to_string"""
192
+.el .Sh "\f(CWto_string\fP"
193
+.IX Subsection "to_string"
194
+.Vb 1
195
+\&    my $order_by = $order->to_string;
196
+.Ve
197
+.PP
198
+Create order by clause. If column name is duplicated, First one is used.
199
+\&\f(CW\*(C`to_string\*(C'\fR override stringification. so you can write the follwoing way.
200
+.PP
201
+.Vb 1
202
+\&    my $order_by = "$order";
203
+.Ve
+174
DBIx-Custom-0.1711/blib/man3/DBIx::Custom::Query.3pm
... ...
@@ -0,0 +1,174 @@
1
+.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2
+.\"
3
+.\" Standard preamble:
4
+.\" ========================================================================
5
+.de Sh \" Subsection heading
6
+.br
7
+.if t .Sp
8
+.ne 5
9
+.PP
10
+\fB\\$1\fR
11
+.PP
12
+..
13
+.de Sp \" Vertical space (when we can't use .PP)
14
+.if t .sp .5v
15
+.if n .sp
16
+..
17
+.de Vb \" Begin verbatim text
18
+.ft CW
19
+.nf
20
+.ne \\$1
21
+..
22
+.de Ve \" End verbatim text
23
+.ft R
24
+.fi
25
+..
26
+.\" Set up some character translations and predefined strings.  \*(-- will
27
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
28
+.\" double quote, and \*(R" will give a right double quote.  | will give a
29
+.\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used to
30
+.\" do unbreakable dashes and therefore won't be available.  \*(C` and \*(C'
31
+.\" expand to `' in nroff, nothing in troff, for use with C<>.
32
+.tr \(*W-|\(bv\*(Tr
33
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34
+.ie n \{\
35
+.    ds -- \(*W-
36
+.    ds PI pi
37
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
38
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
39
+.    ds L" ""
40
+.    ds R" ""
41
+.    ds C` ""
42
+.    ds C' ""
43
+'br\}
44
+.el\{\
45
+.    ds -- \|\(em\|
46
+.    ds PI \(*p
47
+.    ds L" ``
48
+.    ds R" ''
49
+'br\}
50
+.\"
51
+.\" If the F register is turned on, we'll generate index entries on stderr for
52
+.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
54
+.\" output yourself in some meaningful fashion.
55
+.if \nF \{\
56
+.    de IX
57
+.    tm Index:\\$1\t\\n%\t"\\$2"
58
+..
59
+.    nr % 0
60
+.    rr F
61
+.\}
62
+.\"
63
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
64
+.\" way too many mistakes in technical documents.
65
+.hy 0
66
+.if n .na
67
+.\"
68
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
70
+.    \" fudge factors for nroff and troff
71
+.if n \{\
72
+.    ds #H 0
73
+.    ds #V .8m
74
+.    ds #F .3m
75
+.    ds #[ \f1
76
+.    ds #] \fP
77
+.\}
78
+.if t \{\
79
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80
+.    ds #V .6m
81
+.    ds #F 0
82
+.    ds #[ \&
83
+.    ds #] \&
84
+.\}
85
+.    \" simple accents for nroff and troff
86
+.if n \{\
87
+.    ds ' \&
88
+.    ds ` \&
89
+.    ds ^ \&
90
+.    ds , \&
91
+.    ds ~ ~
92
+.    ds /
93
+.\}
94
+.if t \{\
95
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
96
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
97
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
98
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
99
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
100
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
101
+.\}
102
+.    \" troff and (daisy-wheel) nroff accents
103
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
104
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
105
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
106
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
107
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
108
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
109
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
110
+.ds ae a\h'-(\w'a'u*4/10)'e
111
+.ds Ae A\h'-(\w'A'u*4/10)'E
112
+.    \" corrections for vroff
113
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
114
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
115
+.    \" for low resolution devices (crt and lpr)
116
+.if \n(.H>23 .if \n(.V>19 \
117
+\{\
118
+.    ds : e
119
+.    ds 8 ss
120
+.    ds o a
121
+.    ds d- d\h'-1'\(ga
122
+.    ds D- D\h'-1'\(hy
123
+.    ds th \o'bp'
124
+.    ds Th \o'LP'
125
+.    ds ae ae
126
+.    ds Ae AE
127
+.\}
128
+.rm #[ #] #H #V #F C
129
+.\" ========================================================================
130
+.\"
131
+.IX Title "DBIx::Custom::Query 3"
132
+.TH DBIx::Custom::Query 3 "2011-07-30" "perl v5.8.8" "User Contributed Perl Documentation"
133
+.SH "NAME"
134
+DBIx::Custom::Query \- Query
135
+.SH "SYNOPSIS"
136
+.IX Header "SYNOPSIS"
137
+.Vb 4
138
+\&    my $query = DBIx::Custom::Query->new;
139
+\&    my $sth = $query->sth;
140
+\&    my $sql = $query->sql;
141
+\&    my $columns = $query->columns;
142
+.Ve
143
+.SH "ATTRIBUTES"
144
+.IX Header "ATTRIBUTES"
145
+.ie n .Sh """columns"""
146
+.el .Sh "\f(CWcolumns\fP"
147
+.IX Subsection "columns"
148
+.Vb 2
149
+\&    my $columns = $query->columns;
150
+\&    $query      = $query->columns(['auhtor', 'title']);
151
+.Ve
152
+.PP
153
+Column names.
154
+.ie n .Sh """sql"""
155
+.el .Sh "\f(CWsql\fP"
156
+.IX Subsection "sql"
157
+.Vb 2
158
+\&    my $sql = $query->sql;
159
+\&    $query  = $query->sql('select * from books where author = ?;');
160
+.Ve
161
+.PP
162
+\&\s-1SQL\s0 statement.
163
+.ie n .Sh """sth"""
164
+.el .Sh "\f(CWsth\fP"
165
+.IX Subsection "sth"
166
+.Vb 2
167
+\&    my $sth = $query->sth;
168
+\&    $query  = $query->sth($sth);
169
+.Ve
170
+.PP
171
+Statement handle of \s-1DBI\s0
172
+.SH "METHODS"
173
+.IX Header "METHODS"
174
+DBIx::Custom::Query inherits all methods from Object::Simple.
+165
DBIx-Custom-0.1711/blib/man3/DBIx::Custom::QueryBuilder.3pm
... ...
@@ -0,0 +1,165 @@
1
+.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2
+.\"
3
+.\" Standard preamble:
4
+.\" ========================================================================
5
+.de Sh \" Subsection heading
6
+.br
7
+.if t .Sp
8
+.ne 5
9
+.PP
10
+\fB\\$1\fR
11
+.PP
12
+..
13
+.de Sp \" Vertical space (when we can't use .PP)
14
+.if t .sp .5v
15
+.if n .sp
16
+..
17
+.de Vb \" Begin verbatim text
18
+.ft CW
19
+.nf
20
+.ne \\$1
21
+..
22
+.de Ve \" End verbatim text
23
+.ft R
24
+.fi
25
+..
26
+.\" Set up some character translations and predefined strings.  \*(-- will
27
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
28
+.\" double quote, and \*(R" will give a right double quote.  | will give a
29
+.\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used to
30
+.\" do unbreakable dashes and therefore won't be available.  \*(C` and \*(C'
31
+.\" expand to `' in nroff, nothing in troff, for use with C<>.
32
+.tr \(*W-|\(bv\*(Tr
33
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34
+.ie n \{\
35
+.    ds -- \(*W-
36
+.    ds PI pi
37
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
38
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
39
+.    ds L" ""
40
+.    ds R" ""
41
+.    ds C` ""
42
+.    ds C' ""
43
+'br\}
44
+.el\{\
45
+.    ds -- \|\(em\|
46
+.    ds PI \(*p
47
+.    ds L" ``
48
+.    ds R" ''
49
+'br\}
50
+.\"
51
+.\" If the F register is turned on, we'll generate index entries on stderr for
52
+.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
54
+.\" output yourself in some meaningful fashion.
55
+.if \nF \{\
56
+.    de IX
57
+.    tm Index:\\$1\t\\n%\t"\\$2"
58
+..
59
+.    nr % 0
60
+.    rr F
61
+.\}
62
+.\"
63
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
64
+.\" way too many mistakes in technical documents.
65
+.hy 0
66
+.if n .na
67
+.\"
68
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
70
+.    \" fudge factors for nroff and troff
71
+.if n \{\
72
+.    ds #H 0
73
+.    ds #V .8m
74
+.    ds #F .3m
75
+.    ds #[ \f1
76
+.    ds #] \fP
77
+.\}
78
+.if t \{\
79
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80
+.    ds #V .6m
81
+.    ds #F 0
82
+.    ds #[ \&
83
+.    ds #] \&
84
+.\}
85
+.    \" simple accents for nroff and troff
86
+.if n \{\
87
+.    ds ' \&
88
+.    ds ` \&
89
+.    ds ^ \&
90
+.    ds , \&
91
+.    ds ~ ~
92
+.    ds /
93
+.\}
94
+.if t \{\
95
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
96
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
97
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
98
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
99
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
100
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
101
+.\}
102
+.    \" troff and (daisy-wheel) nroff accents
103
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
104
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
105
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
106
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
107
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
108
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
109
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
110
+.ds ae a\h'-(\w'a'u*4/10)'e
111
+.ds Ae A\h'-(\w'A'u*4/10)'E
112
+.    \" corrections for vroff
113
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
114
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
115
+.    \" for low resolution devices (crt and lpr)
116
+.if \n(.H>23 .if \n(.V>19 \
117
+\{\
118
+.    ds : e
119
+.    ds 8 ss
120
+.    ds o a
121
+.    ds d- d\h'-1'\(ga
122
+.    ds D- D\h'-1'\(hy
123
+.    ds th \o'bp'
124
+.    ds Th \o'LP'
125
+.    ds ae ae
126
+.    ds Ae AE
127
+.\}
128
+.rm #[ #] #H #V #F C
129
+.\" ========================================================================
130
+.\"
131
+.IX Title "DBIx::Custom::QueryBuilder 3"
132
+.TH DBIx::Custom::QueryBuilder 3 "2011-08-02" "perl v5.8.8" "User Contributed Perl Documentation"
133
+.SH "NAME"
134
+DBIx::Custom::QueryBuilder \- Query builder
135
+.SH "SYNOPSIS"
136
+.IX Header "SYNOPSIS"
137
+.Vb 4
138
+\&    my $builder = DBIx::Custom::QueryBuilder->new;
139
+\&    my $query = $builder->build_query(
140
+\&        "select from table title = :title and author = :author"
141
+\&    );
142
+.Ve
143
+.SH "ATTRIBUTES"
144
+.IX Header "ATTRIBUTES"
145
+.ie n .Sh """dbi"""
146
+.el .Sh "\f(CWdbi\fP"
147
+.IX Subsection "dbi"
148
+.Vb 2
149
+\&    my $dbi = $builder->dbi;
150
+\&    $builder = $builder->dbi($dbi);
151
+.Ve
152
+.PP
153
+DBIx::Custom object.
154
+.SH "METHODS"
155
+.IX Header "METHODS"
156
+DBIx::Custom::QueryBuilder inherits all methods from Object::Simple
157
+and implements the following new ones.
158
+.ie n .Sh """build_query"""
159
+.el .Sh "\f(CWbuild_query\fP"
160
+.IX Subsection "build_query"
161
+.Vb 1
162
+\&    my $query = $builder->build_query($source);
163
+.Ve
164
+.PP
165
+Create a new DBIx::Custom::Query object from \s-1SQL\s0 source.
+409
DBIx-Custom-0.1711/blib/man3/DBIx::Custom::Result.3pm
... ...
@@ -0,0 +1,409 @@
1
+.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2
+.\"
3
+.\" Standard preamble:
4
+.\" ========================================================================
5
+.de Sh \" Subsection heading
6
+.br
7
+.if t .Sp
8
+.ne 5
9
+.PP
10
+\fB\\$1\fR
11
+.PP
12
+..
13
+.de Sp \" Vertical space (when we can't use .PP)
14
+.if t .sp .5v
15
+.if n .sp
16
+..
17
+.de Vb \" Begin verbatim text
18
+.ft CW
19
+.nf
20
+.ne \\$1
21
+..
22
+.de Ve \" End verbatim text
23
+.ft R
24
+.fi
25
+..
26
+.\" Set up some character translations and predefined strings.  \*(-- will
27
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
28
+.\" double quote, and \*(R" will give a right double quote.  | will give a
29
+.\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used to
30
+.\" do unbreakable dashes and therefore won't be available.  \*(C` and \*(C'
31
+.\" expand to `' in nroff, nothing in troff, for use with C<>.
32
+.tr \(*W-|\(bv\*(Tr
33
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34
+.ie n \{\
35
+.    ds -- \(*W-
36
+.    ds PI pi
37
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
38
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
39
+.    ds L" ""
40
+.    ds R" ""
41
+.    ds C` ""
42
+.    ds C' ""
43
+'br\}
44
+.el\{\
45
+.    ds -- \|\(em\|
46
+.    ds PI \(*p
47
+.    ds L" ``
48
+.    ds R" ''
49
+'br\}
50
+.\"
51
+.\" If the F register is turned on, we'll generate index entries on stderr for
52
+.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
54
+.\" output yourself in some meaningful fashion.
55
+.if \nF \{\
56
+.    de IX
57
+.    tm Index:\\$1\t\\n%\t"\\$2"
58
+..
59
+.    nr % 0
60
+.    rr F
61
+.\}
62
+.\"
63
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
64
+.\" way too many mistakes in technical documents.
65
+.hy 0
66
+.if n .na
67
+.\"
68
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
70
+.    \" fudge factors for nroff and troff
71
+.if n \{\
72
+.    ds #H 0
73
+.    ds #V .8m
74
+.    ds #F .3m
75
+.    ds #[ \f1
76
+.    ds #] \fP
77
+.\}
78
+.if t \{\
79
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80
+.    ds #V .6m
81
+.    ds #F 0
82
+.    ds #[ \&
83
+.    ds #] \&
84
+.\}
85
+.    \" simple accents for nroff and troff
86
+.if n \{\
87
+.    ds ' \&
88
+.    ds ` \&
89
+.    ds ^ \&
90
+.    ds , \&
91
+.    ds ~ ~
92
+.    ds /
93
+.\}
94
+.if t \{\
95
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
96
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
97
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
98
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
99
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
100
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
101
+.\}
102
+.    \" troff and (daisy-wheel) nroff accents
103
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
104
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
105
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
106
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
107
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
108
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
109
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
110
+.ds ae a\h'-(\w'a'u*4/10)'e
111
+.ds Ae A\h'-(\w'A'u*4/10)'E
112
+.    \" corrections for vroff
113
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
114
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
115
+.    \" for low resolution devices (crt and lpr)
116
+.if \n(.H>23 .if \n(.V>19 \
117
+\{\
118
+.    ds : e
119
+.    ds 8 ss
120
+.    ds o a
121
+.    ds d- d\h'-1'\(ga
122
+.    ds D- D\h'-1'\(hy
123
+.    ds th \o'bp'
124
+.    ds Th \o'LP'
125
+.    ds ae ae
126
+.    ds Ae AE
127
+.\}
128
+.rm #[ #] #H #V #F C
129
+.\" ========================================================================
130
+.\"
131
+.IX Title "DBIx::Custom::Result 3"
132
+.TH DBIx::Custom::Result 3 "2011-08-02" "perl v5.8.8" "User Contributed Perl Documentation"
133
+.SH "NAME"
134
+DBIx::Custom::Result \- Result of select statement
135
+.SH "SYNOPSIS"
136
+.IX Header "SYNOPSIS"
137
+.Vb 2
138
+\&    # Result
139
+\&    my $result = $dbi->select(table => 'book');
140
+.Ve
141
+.PP
142
+.Vb 5
143
+\&    # Fetch a row and put it into array reference
144
+\&    while (my $row = $result->fetch) {
145
+\&        my $author = $row->[0];
146
+\&        my $title  = $row->[1];
147
+\&    }
148
+.Ve
149
+.PP
150
+.Vb 2
151
+\&    # Fetch only a first row and put it into array reference
152
+\&    my $row = $result->fetch_first;
153
+.Ve
154
+.PP
155
+.Vb 2
156
+\&    # Fetch all rows and put them into array of array reference
157
+\&    my $rows = $result->fetch_all;
158
+.Ve
159
+.PP
160
+.Vb 5
161
+\&    # Fetch a row and put it into hash reference
162
+\&    while (my $row = $result->fetch_hash) {
163
+\&        my $title  = $row->{title};
164
+\&        my $author = $row->{author};
165
+\&    }
166
+.Ve
167
+.PP
168
+.Vb 3
169
+\&    # Fetch only a first row and put it into hash reference
170
+\&    my $row = $result->fetch_hash_first;
171
+\&    my $row = $result->one; # Same as fetch_hash_first
172
+.Ve
173
+.PP
174
+.Vb 3
175
+\&    # Fetch all rows and put them into array of hash reference
176
+\&    my $rows = $result->fetch_hash_all;
177
+\&    my $rows = $result->all; # Same as fetch_hash_all
178
+.Ve
179
+.SH "ATTRIBUTES"
180
+.IX Header "ATTRIBUTES"
181
+.ie n .Sh """dbi"""
182
+.el .Sh "\f(CWdbi\fP"
183
+.IX Subsection "dbi"
184
+.Vb 2
185
+\&    my $dbi = $result->dbi;
186
+\&    $result = $result->dbi($dbi);
187
+.Ve
188
+.PP
189
+DBIx::Custom object.
190
+.ie n .Sh """sth"""
191
+.el .Sh "\f(CWsth\fP"
192
+.IX Subsection "sth"
193
+.Vb 2
194
+\&    my $sth = $reuslt->sth
195
+\&    $result = $result->sth($sth);
196
+.Ve
197
+.PP
198
+Statement handle of \s-1DBI\s0.
199
+.SH "METHODS"
200
+.IX Header "METHODS"
201
+DBIx::Custom::Result inherits all methods from Object::Simple
202
+and implements the following new ones.
203
+.ie n .Sh """all"""
204
+.el .Sh "\f(CWall\fP"
205
+.IX Subsection "all"
206
+.Vb 1
207
+\&    my $rows = $result->all;
208
+.Ve
209
+.PP
210
+Same as \f(CW\*(C`fetch_hash_all\*(C'\fR.
211
+.ie n .Sh """fetch"""
212
+.el .Sh "\f(CWfetch\fP"
213
+.IX Subsection "fetch"
214
+.Vb 1
215
+\&    my $row = $result->fetch;
216
+.Ve
217
+.PP
218
+Fetch a row and put it into array reference.
219
+.ie n .Sh """fetch_all"""
220
+.el .Sh "\f(CWfetch_all\fP"
221
+.IX Subsection "fetch_all"
222
+.Vb 1
223
+\&    my $rows = $result->fetch_all;
224
+.Ve
225
+.PP
226
+Fetch all rows and put them into array of array reference.
227
+.ie n .Sh """fetch_first"""
228
+.el .Sh "\f(CWfetch_first\fP"
229
+.IX Subsection "fetch_first"
230
+.Vb 1
231
+\&    my $row = $result->fetch_first;
232
+.Ve
233
+.PP
234
+Fetch only a first row and put it into array reference,
235
+and finish statment handle.
236
+.ie n .Sh """fetch_hash"""
237
+.el .Sh "\f(CWfetch_hash\fP"
238
+.IX Subsection "fetch_hash"
239
+.Vb 1
240
+\&    my $row = $result->fetch_hash;
241
+.Ve
242
+.PP
243
+Fetch a row and put it into hash reference.
244
+.ie n .Sh """fetch_hash_all"""
245
+.el .Sh "\f(CWfetch_hash_all\fP"
246
+.IX Subsection "fetch_hash_all"
247
+.Vb 1
248
+\&    my $rows = $result->fetch_hash_all;
249
+.Ve
250
+.PP
251
+Fetch all rows and put them into array of hash reference.
252
+.ie n .Sh """fetch_hash_first"""
253
+.el .Sh "\f(CWfetch_hash_first\fP"
254
+.IX Subsection "fetch_hash_first"
255
+.Vb 1
256
+\&    my $row = $result->fetch_hash_first;
257
+.Ve
258
+.PP
259
+Fetch only a first row and put it into hash reference,
260
+and finish statment handle.
261
+.ie n .Sh """fetch_hash_multi"""
262
+.el .Sh "\f(CWfetch_hash_multi\fP"
263
+.IX Subsection "fetch_hash_multi"
264
+.Vb 1
265
+\&    my $rows = $result->fetch_hash_multi(5);
266
+.Ve
267
+.PP
268
+Fetch multiple rows and put them into array of hash reference.
269
+.ie n .Sh """fetch_multi"""
270
+.el .Sh "\f(CWfetch_multi\fP"
271
+.IX Subsection "fetch_multi"
272
+.Vb 1
273
+\&    my $rows = $result->fetch_multi(5);
274
+.Ve
275
+.PP
276
+Fetch multiple rows and put them into array of array reference.
277
+.ie n .Sh """filter"""
278
+.el .Sh "\f(CWfilter\fP"
279
+.IX Subsection "filter"
280
+.Vb 2
281
+\&    $result->filter(title  => sub { uc $_[0] }, author => 'to_upper');
282
+\&    $result->filter([qw/title author/] => 'to_upper');
283
+.Ve
284
+.PP
285
+Set filter for column.
286
+You can use subroutine or filter name as filter.
287
+This filter is executed after \f(CW\*(C`type_rule\*(C'\fR filter.
288
+.ie n .Sh """filter_off"" \s-1EXPERIMENTAL\s0"
289
+.el .Sh "\f(CWfilter_off\fP \s-1EXPERIMENTAL\s0"
290
+.IX Subsection "filter_off EXPERIMENTAL"
291
+.Vb 1
292
+\&    $result = $result->filter_off;
293
+.Ve
294
+.PP
295
+Turn filtering by \f(CW\*(C`filter\*(C'\fR method off.
296
+By default, filterin is on.
297
+.ie n .Sh """filter_on"" \s-1EXPERIMENTAL\s0"
298
+.el .Sh "\f(CWfilter_on\fP \s-1EXPERIMENTAL\s0"
299
+.IX Subsection "filter_on EXPERIMENTAL"
300
+.Vb 1
301
+\&    $result = $resutl->filter_on;
302
+.Ve
303
+.PP
304
+Turn filtering by \f(CW\*(C`filter\*(C'\fR method on.
305
+By default, filterin is on.
306
+.ie n .Sh """header"""
307
+.el .Sh "\f(CWheader\fP"
308
+.IX Subsection "header"
309
+.Vb 1
310
+\&    my $header = $result->header;
311
+.Ve
312
+.PP
313
+Get header column names.
314
+.ie n .Sh """one"""
315
+.el .Sh "\f(CWone\fP"
316
+.IX Subsection "one"
317
+.Vb 1
318
+\&    my $row = $result->one;
319
+.Ve
320
+.PP
321
+Same as \f(CW\*(C`fetch_hash_first\*(C'\fR.
322
+.ie n .Sh """stash"""
323
+.el .Sh "\f(CWstash\fP"
324
+.IX Subsection "stash"
325
+.Vb 3
326
+\&    my $stash = $result->stash;
327
+\&    my $foo = $result->stash->{foo};
328
+\&    $result->stash->{foo} = $foo;
329
+.Ve
330
+.PP
331
+Stash is hash reference for data.
332
+.ie n .Sh """type_rule"" \s-1EXPERIMENTAL\s0"
333
+.el .Sh "\f(CWtype_rule\fP \s-1EXPERIMENTAL\s0"
334
+.IX Subsection "type_rule EXPERIMENTAL"
335
+.Vb 7
336
+\&    # Merge type rule
337
+\&    $result->type_rule(
338
+\&        # DATE
339
+\&        9 => sub { ... },
340
+\&        # DATETIME or TIMESTAMP
341
+\&        11 => sub { ... }
342
+\&    );
343
+.Ve
344
+.PP
345
+.Vb 7
346
+\&    # Replace type rule(by reference)
347
+\&    $result->type_rule([
348
+\&        # DATE
349
+\&        9 => sub { ... },
350
+\&        # DATETIME or TIMESTAMP
351
+\&        11 => sub { ... }
352
+\&    ]);
353
+.Ve
354
+.PP
355
+This is same as DBIx::Custom's \f(CW\*(C`type_rule\*(C'\fR's <from>.
356
+.ie n .Sh """type_rule_off"" \s-1EXPERIMENTAL\s0"
357
+.el .Sh "\f(CWtype_rule_off\fP \s-1EXPERIMENTAL\s0"
358
+.IX Subsection "type_rule_off EXPERIMENTAL"
359
+.Vb 1
360
+\&    $result = $result->type_rule_off;
361
+.Ve
362
+.PP
363
+Turn \f(CW\*(C`from1\*(C'\fR and \f(CW\*(C`from2\*(C'\fR type rule off.
364
+By default, type rule is on.
365
+.ie n .Sh """type_rule_on"" \s-1EXPERIMENTAL\s0"
366
+.el .Sh "\f(CWtype_rule_on\fP \s-1EXPERIMENTAL\s0"
367
+.IX Subsection "type_rule_on EXPERIMENTAL"
368
+.Vb 1
369
+\&    $result = $result->type_rule_on;
370
+.Ve
371
+.PP
372
+Turn \f(CW\*(C`from1\*(C'\fR and \f(CW\*(C`from2\*(C'\fR type rule on.
373
+By default, type rule is on.
374
+.ie n .Sh """type_rule1_off"" \s-1EXPERIMENTAL\s0"
375
+.el .Sh "\f(CWtype_rule1_off\fP \s-1EXPERIMENTAL\s0"
376
+.IX Subsection "type_rule1_off EXPERIMENTAL"
377
+.Vb 1
378
+\&    $result = $result->type_rule1_off;
379
+.Ve
380
+.PP
381
+Turn \f(CW\*(C`from1\*(C'\fR type rule off.
382
+By default, type rule is on.
383
+.ie n .Sh """type_rule1_on"" \s-1EXPERIMENTAL\s0"
384
+.el .Sh "\f(CWtype_rule1_on\fP \s-1EXPERIMENTAL\s0"
385
+.IX Subsection "type_rule1_on EXPERIMENTAL"
386
+.Vb 1
387
+\&    $result = $result->type_rule1_on;
388
+.Ve
389
+.PP
390
+Turn \f(CW\*(C`from1\*(C'\fR type rule on.
391
+By default, type rule is on.
392
+.ie n .Sh """type_rule2_off"" \s-1EXPERIMENTAL\s0"
393
+.el .Sh "\f(CWtype_rule2_off\fP \s-1EXPERIMENTAL\s0"
394
+.IX Subsection "type_rule2_off EXPERIMENTAL"
395
+.Vb 1
396
+\&    $result = $result->type_rule2_off;
397
+.Ve
398
+.PP
399
+Turn \f(CW\*(C`from2\*(C'\fR type rule off.
400
+By default, type rule is on.
401
+.ie n .Sh """type_rule2_on"" \s-1EXPERIMENTAL\s0"
402
+.el .Sh "\f(CWtype_rule2_on\fP \s-1EXPERIMENTAL\s0"
403
+.IX Subsection "type_rule2_on EXPERIMENTAL"
404
+.Vb 1
405
+\&    $result = $result->type_rule2_on;
406
+.Ve
407
+.PP
408
+Turn \f(CW\*(C`from2\*(C'\fR type rule on.
409
+By default, type rule is on.
+134
DBIx-Custom-0.1711/blib/man3/DBIx::Custom::Tag.3pm
... ...
@@ -0,0 +1,134 @@
1
+.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2
+.\"
3
+.\" Standard preamble:
4
+.\" ========================================================================
5
+.de Sh \" Subsection heading
6
+.br
7
+.if t .Sp
8
+.ne 5
9
+.PP
10
+\fB\\$1\fR
11
+.PP
12
+..
13
+.de Sp \" Vertical space (when we can't use .PP)
14
+.if t .sp .5v
15
+.if n .sp
16
+..
17
+.de Vb \" Begin verbatim text
18
+.ft CW
19
+.nf
20
+.ne \\$1
21
+..
22
+.de Ve \" End verbatim text
23
+.ft R
24
+.fi
25
+..
26
+.\" Set up some character translations and predefined strings.  \*(-- will
27
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
28
+.\" double quote, and \*(R" will give a right double quote.  | will give a
29
+.\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used to
30
+.\" do unbreakable dashes and therefore won't be available.  \*(C` and \*(C'
31
+.\" expand to `' in nroff, nothing in troff, for use with C<>.
32
+.tr \(*W-|\(bv\*(Tr
33
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34
+.ie n \{\
35
+.    ds -- \(*W-
36
+.    ds PI pi
37
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
38
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
39
+.    ds L" ""
40
+.    ds R" ""
41
+.    ds C` ""
42
+.    ds C' ""
43
+'br\}
44
+.el\{\
45
+.    ds -- \|\(em\|
46
+.    ds PI \(*p
47
+.    ds L" ``
48
+.    ds R" ''
49
+'br\}
50
+.\"
51
+.\" If the F register is turned on, we'll generate index entries on stderr for
52
+.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
54
+.\" output yourself in some meaningful fashion.
55
+.if \nF \{\
56
+.    de IX
57
+.    tm Index:\\$1\t\\n%\t"\\$2"
58
+..
59
+.    nr % 0
60
+.    rr F
61
+.\}
62
+.\"
63
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
64
+.\" way too many mistakes in technical documents.
65
+.hy 0
66
+.if n .na
67
+.\"
68
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
70
+.    \" fudge factors for nroff and troff
71
+.if n \{\
72
+.    ds #H 0
73
+.    ds #V .8m
74
+.    ds #F .3m
75
+.    ds #[ \f1
76
+.    ds #] \fP
77
+.\}
78
+.if t \{\
79
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80
+.    ds #V .6m
81
+.    ds #F 0
82
+.    ds #[ \&
83
+.    ds #] \&
84
+.\}
85
+.    \" simple accents for nroff and troff
86
+.if n \{\
87
+.    ds ' \&
88
+.    ds ` \&
89
+.    ds ^ \&
90
+.    ds , \&
91
+.    ds ~ ~
92
+.    ds /
93
+.\}
94
+.if t \{\
95
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
96
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
97
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
98
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
99
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
100
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
101
+.\}
102
+.    \" troff and (daisy-wheel) nroff accents
103
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
104
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
105
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
106
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
107
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
108
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
109
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
110
+.ds ae a\h'-(\w'a'u*4/10)'e
111
+.ds Ae A\h'-(\w'A'u*4/10)'E
112
+.    \" corrections for vroff
113
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
114
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
115
+.    \" for low resolution devices (crt and lpr)
116
+.if \n(.H>23 .if \n(.V>19 \
117
+\{\
118
+.    ds : e
119
+.    ds 8 ss
120
+.    ds o a
121
+.    ds d- d\h'-1'\(ga
122
+.    ds D- D\h'-1'\(hy
123
+.    ds th \o'bp'
124
+.    ds Th \o'LP'
125
+.    ds ae ae
126
+.    ds Ae AE
127
+.\}
128
+.rm #[ #] #H #V #F C
129
+.\" ========================================================================
130
+.\"
131
+.IX Title "DBIx::Custom::Tag 3"
132
+.TH DBIx::Custom::Tag 3 "2011-06-15" "perl v5.8.8" "User Contributed Perl Documentation"
133
+.SH "NAME"
134
+DBIx::Custom::Tag \- DEPRECATED!
+134
DBIx-Custom-0.1711/blib/man3/DBIx::Custom::Util.3pm
... ...
@@ -0,0 +1,134 @@
1
+.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2
+.\"
3
+.\" Standard preamble:
4
+.\" ========================================================================
5
+.de Sh \" Subsection heading
6
+.br
7
+.if t .Sp
8
+.ne 5
9
+.PP
10
+\fB\\$1\fR
11
+.PP
12
+..
13
+.de Sp \" Vertical space (when we can't use .PP)
14
+.if t .sp .5v
15
+.if n .sp
16
+..
17
+.de Vb \" Begin verbatim text
18
+.ft CW
19
+.nf
20
+.ne \\$1
21
+..
22
+.de Ve \" End verbatim text
23
+.ft R
24
+.fi
25
+..
26
+.\" Set up some character translations and predefined strings.  \*(-- will
27
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
28
+.\" double quote, and \*(R" will give a right double quote.  | will give a
29
+.\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used to
30
+.\" do unbreakable dashes and therefore won't be available.  \*(C` and \*(C'
31
+.\" expand to `' in nroff, nothing in troff, for use with C<>.
32
+.tr \(*W-|\(bv\*(Tr
33
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34
+.ie n \{\
35
+.    ds -- \(*W-
36
+.    ds PI pi
37
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
38
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
39
+.    ds L" ""
40
+.    ds R" ""
41
+.    ds C` ""
42
+.    ds C' ""
43
+'br\}
44
+.el\{\
45
+.    ds -- \|\(em\|
46
+.    ds PI \(*p
47
+.    ds L" ``
48
+.    ds R" ''
49
+'br\}
50
+.\"
51
+.\" If the F register is turned on, we'll generate index entries on stderr for
52
+.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
54
+.\" output yourself in some meaningful fashion.
55
+.if \nF \{\
56
+.    de IX
57
+.    tm Index:\\$1\t\\n%\t"\\$2"
58
+..
59
+.    nr % 0
60
+.    rr F
61
+.\}
62
+.\"
63
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
64
+.\" way too many mistakes in technical documents.
65
+.hy 0
66
+.if n .na
67
+.\"
68
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
70
+.    \" fudge factors for nroff and troff
71
+.if n \{\
72
+.    ds #H 0
73
+.    ds #V .8m
74
+.    ds #F .3m
75
+.    ds #[ \f1
76
+.    ds #] \fP
77
+.\}
78
+.if t \{\
79
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80
+.    ds #V .6m
81
+.    ds #F 0
82
+.    ds #[ \&
83
+.    ds #] \&
84
+.\}
85
+.    \" simple accents for nroff and troff
86
+.if n \{\
87
+.    ds ' \&
88
+.    ds ` \&
89
+.    ds ^ \&
90
+.    ds , \&
91
+.    ds ~ ~
92
+.    ds /
93
+.\}
94
+.if t \{\
95
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
96
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
97
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
98
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
99
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
100
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
101
+.\}
102
+.    \" troff and (daisy-wheel) nroff accents
103
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
104
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
105
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
106
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
107
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
108
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
109
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
110
+.ds ae a\h'-(\w'a'u*4/10)'e
111
+.ds Ae A\h'-(\w'A'u*4/10)'E
112
+.    \" corrections for vroff
113
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
114
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
115
+.    \" for low resolution devices (crt and lpr)
116
+.if \n(.H>23 .if \n(.V>19 \
117
+\{\
118
+.    ds : e
119
+.    ds 8 ss
120
+.    ds o a
121
+.    ds d- d\h'-1'\(ga
122
+.    ds D- D\h'-1'\(hy
123
+.    ds th \o'bp'
124
+.    ds Th \o'LP'
125
+.    ds ae ae
126
+.    ds Ae AE
127
+.\}
128
+.rm #[ #] #H #V #F C
129
+.\" ========================================================================
130
+.\"
131
+.IX Title "DBIx::Custom::Util 3"
132
+.TH DBIx::Custom::Util 3 "2011-04-25" "perl v5.8.8" "User Contributed Perl Documentation"
133
+.SH "NAME"
134
+DBIx::Custom::Util \- Utility class
+198
DBIx-Custom-0.1711/blib/man3/DBIx::Custom::Where.3pm
... ...
@@ -0,0 +1,198 @@
1
+.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
2
+.\"
3
+.\" Standard preamble:
4
+.\" ========================================================================
5
+.de Sh \" Subsection heading
6
+.br
7
+.if t .Sp
8
+.ne 5
9
+.PP
10
+\fB\\$1\fR
11
+.PP
12
+..
13
+.de Sp \" Vertical space (when we can't use .PP)
14
+.if t .sp .5v
15
+.if n .sp
16
+..
17
+.de Vb \" Begin verbatim text
18
+.ft CW
19
+.nf
20
+.ne \\$1
21
+..
22
+.de Ve \" End verbatim text
23
+.ft R
24
+.fi
25
+..
26
+.\" Set up some character translations and predefined strings.  \*(-- will
27
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
28
+.\" double quote, and \*(R" will give a right double quote.  | will give a
29
+.\" real vertical bar.  \*(C+ will give a nicer C++.  Capital omega is used to
30
+.\" do unbreakable dashes and therefore won't be available.  \*(C` and \*(C'
31
+.\" expand to `' in nroff, nothing in troff, for use with C<>.
32
+.tr \(*W-|\(bv\*(Tr
33
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
34
+.ie n \{\
35
+.    ds -- \(*W-
36
+.    ds PI pi
37
+.    if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
38
+.    if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\"  diablo 12 pitch
39
+.    ds L" ""
40
+.    ds R" ""
41
+.    ds C` ""
42
+.    ds C' ""
43
+'br\}
44
+.el\{\
45
+.    ds -- \|\(em\|
46
+.    ds PI \(*p
47
+.    ds L" ``
48
+.    ds R" ''
49
+'br\}
50
+.\"
51
+.\" If the F register is turned on, we'll generate index entries on stderr for
52
+.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
53
+.\" entries marked with X<> in POD.  Of course, you'll have to process the
54
+.\" output yourself in some meaningful fashion.
55
+.if \nF \{\
56
+.    de IX
57
+.    tm Index:\\$1\t\\n%\t"\\$2"
58
+..
59
+.    nr % 0
60
+.    rr F
61
+.\}
62
+.\"
63
+.\" For nroff, turn off justification.  Always turn off hyphenation; it makes
64
+.\" way too many mistakes in technical documents.
65
+.hy 0
66
+.if n .na
67
+.\"
68
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
69
+.\" Fear.  Run.  Save yourself.  No user-serviceable parts.
70
+.    \" fudge factors for nroff and troff
71
+.if n \{\
72
+.    ds #H 0
73
+.    ds #V .8m
74
+.    ds #F .3m
75
+.    ds #[ \f1
76
+.    ds #] \fP
77
+.\}
78
+.if t \{\
79
+.    ds #H ((1u-(\\\\n(.fu%2u))*.13m)
80
+.    ds #V .6m
81
+.    ds #F 0
82
+.    ds #[ \&
83
+.    ds #] \&
84
+.\}
85
+.    \" simple accents for nroff and troff
86
+.if n \{\
87
+.    ds ' \&
88
+.    ds ` \&
89
+.    ds ^ \&
90
+.    ds , \&
91
+.    ds ~ ~
92
+.    ds /
93
+.\}
94
+.if t \{\
95
+.    ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
96
+.    ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
97
+.    ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
98
+.    ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
99
+.    ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
100
+.    ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
101
+.\}
102
+.    \" troff and (daisy-wheel) nroff accents
103
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
104
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
105
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
106
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
107
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
108
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
109
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
110
+.ds ae a\h'-(\w'a'u*4/10)'e
111
+.ds Ae A\h'-(\w'A'u*4/10)'E
112
+.    \" corrections for vroff
113
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
114
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
115
+.    \" for low resolution devices (crt and lpr)
116
+.if \n(.H>23 .if \n(.V>19 \
117
+\{\
118
+.    ds : e
119
+.    ds 8 ss
120
+.    ds o a
121
+.    ds d- d\h'-1'\(ga
122
+.    ds D- D\h'-1'\(hy
123
+.    ds th \o'bp'
124
+.    ds Th \o'LP'
125
+.    ds ae ae
126
+.    ds Ae AE
127
+.\}
128
+.rm #[ #] #H #V #F C
129
+.\" ========================================================================
130
+.\"
131
+.IX Title "DBIx::Custom::Where 3"
132
+.TH DBIx::Custom::Where 3 "2011-08-02" "perl v5.8.8" "User Contributed Perl Documentation"
133
+.SH "NAME"
134
+DBIx::Custom::Where \- Where clause
135
+.SH "SYNOPSYS"
136
+.IX Header "SYNOPSYS"
137
+.Vb 2
138
+\&    my $where = DBIx::Custom::Where->new;
139
+\&    my $string_where = "$where";
140
+.Ve
141
+.SH "ATTRIBUTES"
142
+.IX Header "ATTRIBUTES"
143
+.ie n .Sh """clause"""
144
+.el .Sh "\f(CWclause\fP"
145
+.IX Subsection "clause"
146
+.Vb 7
147
+\&    my $clause = $where->clause;
148
+\&    $where = $where->clause(
149
+\&        ['and',
150
+\&            'title = :title', 
151
+\&            ['or', 'date < :date', 'date > :date']
152
+\&        ]
153
+\&    );
154
+.Ve
155
+.PP
156
+Where clause. Above one is expanded to the following \s-1SQL\s0 by to_string
157
+If all parameter names is exists.
158
+.PP
159
+.Vb 1
160
+\&    "where ( title = :title and ( date < :date or date > :date ) )"
161
+.Ve
162
+.ie n .Sh """param"""
163
+.el .Sh "\f(CWparam\fP"
164
+.IX Subsection "param"
165
+.Vb 5
166
+\&    my $param = $where->param;
167
+\&    $where = $where->param({
168
+\&        title => 'Perl',
169
+\&        date => ['2010-11-11', '2011-03-05'],
170
+\&    });
171
+.Ve
172
+.ie n .Sh """dbi"""
173
+.el .Sh "\f(CWdbi\fP"
174
+.IX Subsection "dbi"
175
+.Vb 2
176
+\&    my $dbi = $where->dbi;
177
+\&    $where = $where->dbi($dbi);
178
+.Ve
179
+.PP
180
+DBIx::Custom object.
181
+.SH "METHODS"
182
+.IX Header "METHODS"
183
+DBIx::Custom::Where inherits all methods from Object::Simple
184
+and implements the following new ones.
185
+.ie n .Sh """to_string"""
186
+.el .Sh "\f(CWto_string\fP"
187
+.IX Subsection "to_string"
188
+.Vb 1
189
+\&    $where->to_string;
190
+.Ve
191
+.PP
192
+Convert where clause to string.
193
+.PP
194
+double quote is override to execute \f(CW\*(C`to_string\*(C'\fR method.
195
+.PP
196
+.Vb 1
197
+\&    my $string_where = "$where";
198
+.Ve
DBIx-Custom-0.1711/blib/script/.exists
No changes.
+3203
DBIx-Custom-0.1711/lib/DBIx/Custom.pm
... ...
@@ -0,0 +1,3203 @@
1
+package DBIx::Custom;
2
+use Object::Simple -base;
3
+
4
+our $VERSION = '0.1711';
5
+use 5.008001;
6
+
7
+use Carp 'croak';
8
+use DBI;
9
+use DBIx::Custom::Result;
10
+use DBIx::Custom::Query;
11
+use DBIx::Custom::QueryBuilder;
12
+use DBIx::Custom::Where;
13
+use DBIx::Custom::Model;
14
+use DBIx::Custom::Tag;
15
+use DBIx::Custom::Order;
16
+use DBIx::Custom::Util qw/_array_to_hash _subname/;
17
+use Encode qw/encode encode_utf8 decode_utf8/;
18
+
19
+use constant DEBUG => $ENV{DBIX_CUSTOM_DEBUG} || 0;
20
+use constant DEBUG_ENCODING => $ENV{DBIX_CUSTOM_DEBUG_ENCODING} || 'UTF-8';
21
+
22
+has [qw/connector dsn password quote user/],
23
+    cache => 0,
24
+    cache_method => sub {
25
+        sub {
26
+            my $self = shift;
27
+            
28
+            $self->{_cached} ||= {};
29
+            
30
+            if (@_ > 1) {
31
+                $self->{_cached}{$_[0]} = $_[1];
32
+            }
33
+            else {
34
+                return $self->{_cached}{$_[0]};
35
+            }
36
+        }
37
+    },
38
+    dbi_option => sub { {} },
39
+    default_dbi_option => sub {
40
+        {
41
+            RaiseError => 1,
42
+            PrintError => 0,
43
+            AutoCommit => 1
44
+        }
45
+    },
46
+    filters => sub {
47
+        {
48
+            encode_utf8 => sub { encode_utf8($_[0]) },
49
+            decode_utf8 => sub { decode_utf8($_[0]) }
50
+        }
51
+    },
52
+    last_sql => '',
53
+    models => sub { {} },
54
+    query_builder => sub { DBIx::Custom::QueryBuilder->new(dbi => shift) },
55
+    result_class  => 'DBIx::Custom::Result',
56
+    safety_character => '\w',
57
+    stash => sub { {} },
58
+    tag_parse => 1;
59
+
60
+our $AUTOLOAD;
61
+sub AUTOLOAD {
62
+    my $self = shift;
63
+
64
+    # Method name
65
+    my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
66
+
67
+    # Call method
68
+    $self->{_methods} ||= {};
69
+    if (my $method = $self->{_methods}->{$mname}) {
70
+        return $self->$method(@_)
71
+    }
72
+    elsif ($self->{dbh} && (my $dbh_method = $self->dbh->can($mname))) {
73
+        $self->dbh->$dbh_method(@_);
74
+    }
75
+    else {
76
+        croak qq{Can't locate object method "$mname" via "$package" }
77
+            . _subname;
78
+    }
79
+}
80
+
81
+sub assign_param {
82
+    my ($self, $param) = @_;
83
+    
84
+    # Create set tag
85
+    my @params;
86
+    my $safety = $self->safety_character;
87
+    foreach my $column (sort keys %$param) {
88
+        croak qq{"$column" is not safety column name } . _subname
89
+          unless $column =~ /^[$safety\.]+$/;
90
+        my $column_quote = $self->_q($column);
91
+        $column_quote =~ s/\./$self->_q(".")/e;
92
+        push @params, ref $param->{$column} eq 'SCALAR'
93
+          ? "$column_quote = " . ${$param->{$column}}
94
+          : "$column_quote = :$column";
95
+
96
+    }
97
+    my $tag = join(', ', @params);
98
+    
99
+    return $tag;
100
+}
101
+
102
+sub column {
103
+    my $self = shift;
104
+    my $option = pop if ref $_[-1] eq 'HASH';
105
+    my $real_table = shift;
106
+    my $columns = shift;
107
+    my $table = $option->{alias} || $real_table;
108
+    
109
+    # Columns
110
+    unless ($columns) {
111
+        $columns ||= $self->model($real_table)->columns;
112
+    }
113
+    
114
+    # Separator
115
+    my $separator = $self->separator;
116
+    
117
+    # Column clause
118
+    my @column;
119
+    $columns ||= [];
120
+    push @column, $self->_q($table) . "." . $self->_q($_) .
121
+      " as " . $self->_q("${table}${separator}$_")
122
+      for @$columns;
123
+    
124
+    return join (', ', @column);
125
+}
126
+
127
+sub connect {
128
+    my $self = ref $_[0] ? shift : shift->new(@_);;
129
+    
130
+    # Connect
131
+    $self->dbh;
132
+    
133
+    return $self;
134
+}
135
+
136
+sub dbh {
137
+    my $self = shift;
138
+    
139
+    # Set
140
+    if (@_) {
141
+        $self->{dbh} = $_[0];
142
+        
143
+        return $self;
144
+    }
145
+    
146
+    # Get
147
+    else {
148
+        # From Connction manager
149
+        if (my $connector = $self->connector) {
150
+            croak "connector must have dbh() method " . _subname
151
+              unless ref $connector && $connector->can('dbh');
152
+              
153
+            $self->{dbh} = $connector->dbh;
154
+        }
155
+        
156
+        # Connect
157
+        $self->{dbh} ||= $self->_connect;
158
+        
159
+        # Quote
160
+        if (!defined $self->reserved_word_quote && !defined $self->quote) {
161
+            my $driver = $self->{dbh}->{Driver}->{Name};
162
+            my $quote = $driver eq 'mysql' ? '`' : '"';
163
+            $self->quote($quote);
164
+        }
165
+        
166
+        return $self->{dbh};
167
+    }
168
+}
169
+
170
+sub delete {
171
+    my ($self, %args) = @_;
172
+
173
+    # Arguments
174
+    my $table = $args{table} || '';
175
+    croak qq{"table" option must be specified. } . _subname
176
+      unless $table;
177
+    my $where            = delete $args{where} || {};
178
+    my $append           = delete $args{append};
179
+    my $allow_delete_all = delete $args{allow_delete_all};
180
+    my $where_param      = delete $args{where_param} || {};
181
+    my $id = delete $args{id};
182
+    my $primary_key = delete $args{primary_key};
183
+    croak "update method primary_key option " .
184
+          "must be specified when id is specified " . _subname
185
+      if defined $id && !defined $primary_key;
186
+    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
187
+    my $prefix = delete $args{prefix};
188
+    
189
+    # Where
190
+    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
191
+    my $where_clause = '';
192
+    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
193
+        $where_clause = "where " . $where->[0];
194
+        $where_param = $where->[1];
195
+    }
196
+    elsif (ref $where) {
197
+        $where = $self->_where_to_obj($where);
198
+        $where_param = keys %$where_param
199
+                     ? $self->merge_param($where_param, $where->param)
200
+                     : $where->param;
201
+        
202
+        # String where
203
+        $where_clause = $where->to_string;
204
+    }
205
+    elsif ($where) { $where_clause = "where $where" }
206
+    croak qq{"where" must be specified } . _subname
207
+      if $where_clause eq '' && !$allow_delete_all;
208
+
209
+    # Delete statement
210
+    my @sql;
211
+    push @sql, "delete";
212
+    push @sql, $prefix if defined $prefix;
213
+    push @sql, "from " . $self->_q($table) . " $where_clause";
214
+    push @sql, $append if defined $append;
215
+    my $sql = join(' ', @sql);
216
+    
217
+    # Execute query
218
+    return $self->execute($sql, $where_param, table => $table, %args);
219
+}
220
+
221
+sub delete_all { shift->delete(allow_delete_all => 1, @_) }
222
+
223
+sub DESTROY { }
224
+
225
+sub create_model {
226
+    my $self = shift;
227
+    
228
+    # Arguments
229
+    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
230
+    $args->{dbi} = $self;
231
+    my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
232
+    my $model_name  = delete $args->{name};
233
+    my $model_table = delete $args->{table};
234
+    $model_name ||= $model_table;
235
+    
236
+    # Create model
237
+    my $model = $model_class->new($args);
238
+    $model->name($model_name) unless $model->name;
239
+    $model->table($model_table) unless $model->table;
240
+    
241
+    # Apply filter(DEPRECATED logic)
242
+    if ($model->{filter}) {
243
+        my $filter = ref $model->filter eq 'HASH'
244
+                   ? [%{$model->filter}]
245
+                   : $model->filter;
246
+        $filter ||= [];
247
+        warn "DBIx::Custom::Model filter method is DEPRECATED!"
248
+          if @$filter;
249
+        $self->_apply_filter($model->table, @$filter);
250
+    }
251
+    
252
+    # Set model
253
+    $self->model($model->name, $model);
254
+    
255
+    return $self->model($model->name);
256
+}
257
+
258
+sub each_column {
259
+    my ($self, $cb) = @_;
260
+    
261
+    # Iterate all tables
262
+    my $sth_tables = $self->dbh->table_info;
263
+    while (my $table_info = $sth_tables->fetchrow_hashref) {
264
+        
265
+        # Table
266
+        my $table = $table_info->{TABLE_NAME};
267
+        
268
+        # Iterate all columns
269
+        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
270
+        while (my $column_info = $sth_columns->fetchrow_hashref) {
271
+            my $column = $column_info->{COLUMN_NAME};
272
+            $self->$cb($table, $column, $column_info);
273
+        }
274
+    }
275
+}
276
+
277
+sub each_table {
278
+    my ($self, $cb) = @_;
279
+    
280
+    # Iterate all tables
281
+    my $sth_tables = $self->dbh->table_info;
282
+    while (my $table_info = $sth_tables->fetchrow_hashref) {
283
+        
284
+        # Table
285
+        my $table = $table_info->{TABLE_NAME};
286
+        $self->$cb($table, $table_info);
287
+    }
288
+}
289
+
290
+our %VALID_ARGS = map { $_ => 1 } qw/append allow_delete_all
291
+  allow_update_all bind_type column filter id join param prefix primary_key
292
+  query relation table table_alias type type_rule_off type_rule1_off
293
+  type_rule2_off wrap/;
294
+
295
+sub execute {
296
+    my $self = shift;
297
+    my $query = shift;
298
+    my $param;
299
+    $param = shift if @_ % 2;
300
+    my %args = @_;
301
+    
302
+    # Arguments
303
+    my $p = delete $args{param} || {};
304
+    $param ||= $p;
305
+    my $tables = delete $args{table} || [];
306
+    $tables = [$tables] unless ref $tables eq 'ARRAY';
307
+    my $filter = delete $args{filter};
308
+    $filter = _array_to_hash($filter);
309
+    my $bind_type = delete $args{bind_type} || delete $args{type};
310
+    $bind_type = _array_to_hash($bind_type);
311
+    my $type_rule_off = delete $args{type_rule_off};
312
+    my $type_rule_off_parts = {
313
+        1 => delete $args{type_rule1_off},
314
+        2 => delete $args{type_rule2_off}
315
+    };
316
+    my $query_return = delete $args{query};
317
+    my $table_alias = delete $args{table_alias} || {};
318
+    
319
+    # Check argument names
320
+    foreach my $name (keys %args) {
321
+        croak qq{"$name" is wrong option } . _subname
322
+          unless $VALID_ARGS{$name};
323
+    }
324
+    
325
+    # Create query
326
+    $query = $self->_create_query($query) unless ref $query;
327
+    
328
+    # Save query
329
+    $self->last_sql($query->sql);
330
+
331
+    return $query if $query_return;
332
+    
333
+    # DEPRECATED! Merge query filter
334
+    $filter ||= $query->{filter} || {};
335
+    
336
+    # Tables
337
+    unshift @$tables, @{$query->{tables} || []};
338
+    my $main_table = @{$tables}[-1];
339
+    
340
+    # DEPRECATED! Cleanup tables
341
+    $tables = $self->_remove_duplicate_table($tables, $main_table)
342
+      if @$tables > 1;
343
+    
344
+    # Type rule
345
+    my $type_filters = {};
346
+    unless ($type_rule_off) {
347
+        foreach my $i (1, 2) {
348
+            unless ($type_rule_off_parts->{$i}) {
349
+                $type_filters->{$i} = {};
350
+                foreach my $alias (keys %$table_alias) {
351
+                    my $table = $table_alias->{$alias};
352
+                    
353
+                    foreach my $column (keys %{$self->{"_into$i"}{key}{$table} || {}}) {
354
+                        $type_filters->{$i}->{"$alias.$column"} = $self->{"_into$i"}{key}{$table}{$column};
355
+                    }
356
+                }
357
+                $type_filters->{$i} = {%{$type_filters->{$i}}, %{$self->{"_into$i"}{key}{$main_table} || {}}}
358
+                  if $main_table;
359
+            }
360
+        }
361
+    }
362
+    
363
+    # DEPRECATED! Applied filter
364
+    if ($self->{filter}{on}) {
365
+        my $applied_filter = {};
366
+        foreach my $table (@$tables) {
367
+            $applied_filter = {
368
+                %$applied_filter,
369
+                %{$self->{filter}{out}->{$table} || {}}
370
+            }
371
+        }
372
+        $filter = {%$applied_filter, %$filter};
373
+    }
374
+    
375
+    # Replace filter name to code
376
+    foreach my $column (keys %$filter) {
377
+        my $name = $filter->{$column};
378
+        if (!defined $name) {
379
+            $filter->{$column} = undef;
380
+        }
381
+        elsif (ref $name ne 'CODE') {
382
+          croak qq{Filter "$name" is not registered" } . _subname
383
+            unless exists $self->filters->{$name};
384
+          $filter->{$column} = $self->filters->{$name};
385
+        }
386
+    }
387
+    
388
+    # Create bind values
389
+    my $bind = $self->_create_bind_values(
390
+        $param,
391
+        $query->columns,
392
+        $filter,
393
+        $type_filters,
394
+        $bind_type
395
+    );
396
+    
397
+    # Execute
398
+    my $sth = $query->sth;
399
+    my $affected;
400
+    eval {
401
+        for (my $i = 0; $i < @$bind; $i++) {
402
+            my $bind_type = $bind->[$i]->{bind_type};
403
+            $sth->bind_param(
404
+                $i + 1,
405
+                $bind->[$i]->{value},
406
+                $bind_type ? $bind_type : ()
407
+            );
408
+        }
409
+        $affected = $sth->execute;
410
+    };
411
+    
412
+    $self->_croak($@, qq{. Following SQL is executed.\n}
413
+      . qq{$query->{sql}\n} . _subname) if $@;
414
+    
415
+    # DEBUG message
416
+    if (DEBUG) {
417
+        print STDERR "SQL:\n" . $query->sql . "\n";
418
+        my @output;
419
+        foreach my $b (@$bind) {
420
+            my $value = $b->{value};
421
+            $value = 'undef' unless defined $value;
422
+            $value = encode(DEBUG_ENCODING(), $value)
423
+              if utf8::is_utf8($value);
424
+            push @output, $value;
425
+        }
426
+        print STDERR "Bind values: " . join(', ', @output) . "\n\n";
427
+    }
428
+    
429
+    # Select statement
430
+    if ($sth->{NUM_OF_FIELDS}) {
431
+        
432
+        # DEPRECATED! Filter
433
+        my $filter = {};
434
+        if ($self->{filter}{on}) {
435
+            $filter->{in}  = {};
436
+            $filter->{end} = {};
437
+            push @$tables, $main_table if $main_table;
438
+            foreach my $table (@$tables) {
439
+                foreach my $way (qw/in end/) {
440
+                    $filter->{$way} = {
441
+                        %{$filter->{$way}},
442
+                        %{$self->{filter}{$way}{$table} || {}}
443
+                    };
444
+                }
445
+            }
446
+        }
447
+        
448
+        # Result
449
+        my $result = $self->result_class->new(
450
+            sth => $sth,
451
+            dbi => $self,
452
+            default_filter => $self->{default_in_filter},
453
+            filter => $filter->{in} || {},
454
+            end_filter => $filter->{end} || {},
455
+            type_rule => {
456
+                from1 => $self->type_rule->{from1},
457
+                from2 => $self->type_rule->{from2}
458
+            },
459
+        );
460
+
461
+        return $result;
462
+    }
463
+    
464
+    # Not select statement
465
+    else { return $affected }
466
+}
467
+
468
+sub insert {
469
+    my $self = shift;
470
+    
471
+    # Arguments
472
+    my $param;
473
+    $param = shift if @_ % 2;
474
+    my %args = @_;
475
+    my $table  = delete $args{table};
476
+    croak qq{"table" option must be specified } . _subname
477
+      unless defined $table;
478
+    my $p = delete $args{param} || {};
479
+    $param  ||= $p;
480
+    my $append = delete $args{append} || '';
481
+    my $id = delete $args{id};
482
+    my $primary_key = delete $args{primary_key};
483
+    croak "insert method primary_key option " .
484
+          "must be specified when id is specified " . _subname
485
+      if defined $id && !defined $primary_key;
486
+    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
487
+    my $prefix = delete $args{prefix};
488
+
489
+    # Merge parameter
490
+    if (defined $id) {
491
+        my $id_param = $self->_create_param_from_id($id, $primary_key);
492
+        $param = $self->merge_param($id_param, $param);
493
+    }
494
+
495
+    # Insert statement
496
+    my @sql;
497
+    push @sql, "insert";
498
+    push @sql, $prefix if defined $prefix;
499
+    push @sql, "into " . $self->_q($table) . " " . $self->insert_param($param);
500
+    push @sql, $append if defined $append;
501
+    my $sql = join (' ', @sql);
502
+    
503
+    # Execute query
504
+    return $self->execute($sql, $param, table => $table, %args);
505
+}
506
+
507
+sub insert_param {
508
+    my ($self, $param) = @_;
509
+    
510
+    # Create insert parameter tag
511
+    my $safety = $self->safety_character;
512
+    my @columns;
513
+    my @placeholders;
514
+    foreach my $column (sort keys %$param) {
515
+        croak qq{"$column" is not safety column name } . _subname
516
+          unless $column =~ /^[$safety\.]+$/;
517
+        my $column_quote = $self->_q($column);
518
+        $column_quote =~ s/\./$self->_q(".")/e;
519
+        push @columns, $column_quote;
520
+        push @placeholders, ref $param->{$column} eq 'SCALAR'
521
+          ? ${$param->{$column}} : ":$column";
522
+    }
523
+    
524
+    return '(' . join(', ', @columns) . ') ' . 'values ' .
525
+           '(' . join(', ', @placeholders) . ')'
526
+}
527
+
528
+sub include_model {
529
+    my ($self, $name_space, $model_infos) = @_;
530
+    
531
+    # Name space
532
+    $name_space ||= '';
533
+    
534
+    # Get Model infomations
535
+    unless ($model_infos) {
536
+
537
+        # Load name space module
538
+        croak qq{"$name_space" is invalid class name } . _subname
539
+          if $name_space =~ /[^\w:]/;
540
+        eval "use $name_space";
541
+        croak qq{Name space module "$name_space.pm" is needed. $@ }
542
+            . _subname
543
+          if $@;
544
+        
545
+        # Search model modules
546
+        my $path = $INC{"$name_space.pm"};
547
+        $path =~ s/\.pm$//;
548
+        opendir my $dh, $path
549
+          or croak qq{Can't open directory "$path": $! } . _subname
550
+        $model_infos = [];
551
+        while (my $module = readdir $dh) {
552
+            push @$model_infos, $module
553
+              if $module =~ s/\.pm$//;
554
+        }
555
+        close $dh;
556
+    }
557
+    
558
+    # Include models
559
+    foreach my $model_info (@$model_infos) {
560
+        
561
+        # Load model
562
+        my $model_class;
563
+        my $model_name;
564
+        my $model_table;
565
+        if (ref $model_info eq 'HASH') {
566
+            $model_class = $model_info->{class};
567
+            $model_name  = $model_info->{name};
568
+            $model_table = $model_info->{table};
569
+            
570
+            $model_name  ||= $model_class;
571
+            $model_table ||= $model_name;
572
+        }
573
+        else { $model_class = $model_name = $model_table = $model_info }
574
+        my $mclass = "${name_space}::$model_class";
575
+        croak qq{"$mclass" is invalid class name } . _subname
576
+          if $mclass =~ /[^\w:]/;
577
+        unless ($mclass->can('isa')) {
578
+            eval "use $mclass";
579
+            croak "$@ " . _subname if $@;
580
+        }
581
+        
582
+        # Create model
583
+        my $args = {};
584
+        $args->{model_class} = $mclass if $mclass;
585
+        $args->{name}        = $model_name if $model_name;
586
+        $args->{table}       = $model_table if $model_table;
587
+        $self->create_model($args);
588
+    }
589
+    
590
+    return $self;
591
+}
592
+
593
+sub map_param {
594
+    my $self = shift;
595
+    my $param = shift;
596
+    my %map = @_;
597
+    
598
+    # Mapping
599
+    my $map_param = {};
600
+    foreach my $key (keys %map) {
601
+        my $value_cb;
602
+        my $condition;
603
+        my $map_key;
604
+        
605
+        # Get mapping information
606
+        if (ref $map{$key} eq 'ARRAY') {
607
+            foreach my $some (@{$map{$key}}) {
608
+                $map_key = $some unless ref $some;
609
+                $condition = $some->{if} if ref $some eq 'HASH';
610
+                $value_cb = $some if ref $some eq 'CODE';
611
+            }
612
+        }
613
+        else {
614
+            $map_key = $map{$key};
615
+        }
616
+        $value_cb ||= sub { $_[0] };
617
+        $condition ||= sub { defined $_[0] && length $_[0] };
618
+
619
+        # Map parameter
620
+        my $value;
621
+        if (ref $condition eq 'CODE') {
622
+            $map_param->{$map_key} = $value_cb->($param->{$key})
623
+              if $condition->($param->{$key});
624
+        }
625
+        elsif ($condition eq 'exists') {
626
+            $map_param->{$map_key} = $value_cb->($param->{$key})
627
+              if exists $param->{$key};
628
+        }
629
+        else { croak qq/Condition must be code reference or "exists" / . _subname }
630
+    }
631
+    
632
+    return $map_param;
633
+}
634
+
635
+sub merge_param {
636
+    my ($self, @params) = @_;
637
+    
638
+    # Merge parameters
639
+    my $merge = {};
640
+    foreach my $param (@params) {
641
+        foreach my $column (keys %$param) {
642
+            my $param_is_array = ref $param->{$column} eq 'ARRAY' ? 1 : 0;
643
+            
644
+            if (exists $merge->{$column}) {
645
+                $merge->{$column} = [$merge->{$column}]
646
+                  unless ref $merge->{$column} eq 'ARRAY';
647
+                push @{$merge->{$column}},
648
+                  ref $param->{$column} ? @{$param->{$column}} : $param->{$column};
649
+            }
650
+            else {
651
+                $merge->{$column} = $param->{$column};
652
+            }
653
+        }
654
+    }
655
+    
656
+    return $merge;
657
+}
658
+
659
+sub method {
660
+    my $self = shift;
661
+    
662
+    # Register method
663
+    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
664
+    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
665
+    
666
+    return $self;
667
+}
668
+
669
+sub model {
670
+    my ($self, $name, $model) = @_;
671
+    
672
+    # Set model
673
+    if ($model) {
674
+        $self->models->{$name} = $model;
675
+        return $self;
676
+    }
677
+    
678
+    # Check model existance
679
+    croak qq{Model "$name" is not included } . _subname
680
+      unless $self->models->{$name};
681
+    
682
+    # Get model
683
+    return $self->models->{$name};
684
+}
685
+
686
+sub mycolumn {
687
+    my ($self, $table, $columns) = @_;
688
+    
689
+    # Create column clause
690
+    my @column;
691
+    $columns ||= [];
692
+    push @column, $self->_q($table) . "." . $self->_q($_) .
693
+      " as " . $self->_q($_)
694
+      for @$columns;
695
+    
696
+    return join (', ', @column);
697
+}
698
+
699
+sub new {
700
+    my $self = shift->SUPER::new(@_);
701
+    
702
+    # Check attributes
703
+    my @attrs = keys %$self;
704
+    foreach my $attr (@attrs) {
705
+        croak qq{"$attr" is wrong name } . _subname
706
+          unless $self->can($attr);
707
+    }
708
+    
709
+    # DEPRECATED!
710
+    $self->query_builder->{tags} = {
711
+        '?'     => \&DBIx::Custom::Tag::placeholder,
712
+        '='     => \&DBIx::Custom::Tag::equal,
713
+        '<>'    => \&DBIx::Custom::Tag::not_equal,
714
+        '>'     => \&DBIx::Custom::Tag::greater_than,
715
+        '<'     => \&DBIx::Custom::Tag::lower_than,
716
+        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
717
+        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
718
+        'like'  => \&DBIx::Custom::Tag::like,
719
+        'in'    => \&DBIx::Custom::Tag::in,
720
+        'insert_param' => \&DBIx::Custom::Tag::insert_param,
721
+        'update_param' => \&DBIx::Custom::Tag::update_param
722
+    };
723
+    
724
+    return $self;
725
+}
726
+
727
+sub not_exists { bless {}, 'DBIx::Custom::NotExists' }
728
+
729
+sub order {
730
+    my $self = shift;
731
+    return DBIx::Custom::Order->new(dbi => $self, @_);
732
+}
733
+
734
+sub register_filter {
735
+    my $self = shift;
736
+    
737
+    # Register filter
738
+    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
739
+    $self->filters({%{$self->filters}, %$filters});
740
+    
741
+    return $self;
742
+}
743
+
744
+sub select {
745
+    my ($self, %args) = @_;
746
+
747
+    # Arguments
748
+    my $table = delete $args{table};
749
+    my $tables = ref $table eq 'ARRAY' ? $table
750
+               : defined $table ? [$table]
751
+               : [];
752
+    my $columns   = delete $args{column};
753
+    my $where     = delete $args{where} || {};
754
+    my $append    = delete $args{append};
755
+    my $join      = delete $args{join} || [];
756
+    croak qq{"join" must be array reference } . _subname
757
+      unless ref $join eq 'ARRAY';
758
+    my $relation = delete $args{relation};
759
+    warn "select() relation option is DEPRECATED!"
760
+      if $relation;
761
+    my $param = delete $args{param} || {}; # DEPRECATED!
762
+    warn "select() param option is DEPRECATED!"
763
+      if keys %$param;
764
+    my $where_param = delete $args{where_param} || $param || {};
765
+    my $wrap = delete $args{wrap};
766
+    my $id = delete $args{id};
767
+    my $primary_key = delete $args{primary_key};
768
+    croak "update method primary_key option " .
769
+          "must be specified when id is specified " . _subname
770
+      if defined $id && !defined $primary_key;
771
+    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
772
+    my $prefix = delete $args{prefix};
773
+    
774
+    # Add relation tables(DEPRECATED!);
775
+    $self->_add_relation_table($tables, $relation);
776
+    
777
+    # Select statement
778
+    my @sql;
779
+    push @sql, 'select';
780
+    
781
+    # Prefix
782
+    push @sql, $prefix if defined $prefix;
783
+    
784
+    # Column clause
785
+    if ($columns) {
786
+        $columns = [$columns] unless ref $columns eq 'ARRAY';
787
+        foreach my $column (@$columns) {
788
+            if (ref $column eq 'HASH') {
789
+                $column = $self->column(%$column) if ref $column eq 'HASH';
790
+            }
791
+            elsif (ref $column eq 'ARRAY') {
792
+                if (@$column == 3 && $column->[1] eq 'as') {
793
+                    warn "[COLUMN, as => ALIAS] is DEPRECATED! use [COLUMN => ALIAS]";
794
+                    splice @$column, 1, 1;
795
+                }
796
+                
797
+                $column = join(' ', $column->[0], 'as', $self->_q($column->[1]));
798
+            }
799
+            unshift @$tables, @{$self->_search_tables($column)};
800
+            push @sql, ($column, ',');
801
+        }
802
+        pop @sql if $sql[-1] eq ',';
803
+    }
804
+    else { push @sql, '*' }
805
+    
806
+    # Table
807
+    push @sql, 'from';
808
+    if ($relation) {
809
+        my $found = {};
810
+        foreach my $table (@$tables) {
811
+            push @sql, ($self->_q($table), ',') unless $found->{$table};
812
+            $found->{$table} = 1;
813
+        }
814
+    }
815
+    else {
816
+        my $main_table = $tables->[-1] || '';
817
+        push @sql, $self->_q($main_table);
818
+    }
819
+    pop @sql if ($sql[-1] || '') eq ',';
820
+    croak "Not found table name " . _subname
821
+      unless $tables->[-1];
822
+
823
+    # Add tables in parameter
824
+    unshift @$tables,
825
+            @{$self->_search_tables(join(' ', keys %$where_param) || '')};
826
+    
827
+    # Where
828
+    my $where_clause = '';
829
+    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
830
+    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
831
+        $where_clause = "where " . $where->[0];
832
+        $where_param = $where->[1];
833
+    }
834
+    elsif (ref $where) {
835
+        $where = $self->_where_to_obj($where);
836
+        $where_param = keys %$where_param
837
+                     ? $self->merge_param($where_param, $where->param)
838
+                     : $where->param;
839
+        
840
+        # String where
841
+        $where_clause = $where->to_string;
842
+    }
843
+    elsif ($where) { $where_clause = "where $where" }
844
+    
845
+    # Add table names in where clause
846
+    unshift @$tables, @{$self->_search_tables($where_clause)};
847
+    
848
+    # Push join
849
+    $self->_push_join(\@sql, $join, $tables);
850
+    
851
+    # Add where clause
852
+    push @sql, $where_clause;
853
+    
854
+    # Relation(DEPRECATED!);
855
+    $self->_push_relation(\@sql, $tables, $relation, $where_clause eq '' ? 1 : 0);
856
+    
857
+    # Append
858
+    push @sql, $append if defined $append;
859
+    
860
+    # Wrap
861
+    if ($wrap) {
862
+        croak "wrap option must be array refrence " . _subname
863
+          unless ref $wrap eq 'ARRAY';
864
+        unshift @sql, $wrap->[0];
865
+        push @sql, $wrap->[1];
866
+    }
867
+    
868
+    # SQL
869
+    my $sql = join (' ', @sql);
870
+    
871
+    # Execute query
872
+    my $result = $self->execute($sql, $where_param, table => $tables, %args);
873
+    
874
+    return $result;
875
+}
876
+
877
+sub separator {
878
+    my $self = shift;
879
+    
880
+    if (@_) {
881
+        my $separator = $_[0] || '';
882
+        croak qq{Separator must be "." or "__" or "-" } . _subname
883
+          unless $separator eq '.' || $separator eq '__'
884
+              || $separator eq '-';
885
+        
886
+        $self->{separator} = $separator;
887
+    
888
+        return $self;
889
+    }
890
+    return $self->{separator} ||= '.';
891
+}
892
+
893
+sub setup_model {
894
+    my $self = shift;
895
+    
896
+    # Setup model
897
+    $self->each_column(
898
+        sub {
899
+            my ($self, $table, $column, $column_info) = @_;
900
+            if (my $model = $self->models->{$table}) {
901
+                push @{$model->columns}, $column;
902
+            }
903
+        }
904
+    );
905
+    return $self;
906
+}
907
+
908
+sub available_data_type {
909
+    my $self = shift;
910
+    
911
+    my $data_types = '';
912
+    foreach my $i (-1000 .. 1000) {
913
+         my $type_info = $self->dbh->type_info($i);
914
+         my $data_type = $type_info->{DATA_TYPE};
915
+         my $type_name = $type_info->{TYPE_NAME};
916
+         $data_types .= "$data_type ($type_name)\n"
917
+           if defined $data_type;
918
+    }
919
+    return "Data Type maybe equal to Type Name" unless $data_types;
920
+    $data_types = "Data Type (Type name)\n" . $data_types;
921
+    return $data_types;
922
+}
923
+
924
+sub available_type_name {
925
+    my $self = shift;
926
+    
927
+    # Type Names
928
+    my $type_names = {};
929
+    $self->each_column(sub {
930
+        my ($self, $table, $column, $column_info) = @_;
931
+        $type_names->{$column_info->{TYPE_NAME}} = 1
932
+          if $column_info->{TYPE_NAME};
933
+    });
934
+    my @output = sort keys %$type_names;
935
+    unshift @output, "Type Name";
936
+    return join "\n", @output;
937
+}
938
+
939
+sub type_rule {
940
+    my $self = shift;
941
+    
942
+    if (@_) {
943
+        my $type_rule = ref $_[0] eq 'HASH' ? $_[0] : {@_};
944
+        
945
+        # Into
946
+        foreach my $i (1 .. 2) {
947
+            my $into = "into$i";
948
+            $type_rule->{$into} = _array_to_hash($type_rule->{$into});
949
+            $self->{type_rule} = $type_rule;
950
+            $self->{"_$into"} = {};
951
+            foreach my $type_name (keys %{$type_rule->{$into} || {}}) {
952
+                croak qq{type name of $into section must be lower case}
953
+                  if $type_name =~ /[A-Z]/;
954
+            }
955
+            $self->each_column(sub {
956
+                my ($dbi, $table, $column, $column_info) = @_;
957
+                
958
+                my $type_name = lc $column_info->{TYPE_NAME};
959
+                if ($type_rule->{$into} &&
960
+                    (my $filter = $type_rule->{$into}->{$type_name}))
961
+                {
962
+                    return unless exists $type_rule->{$into}->{$type_name};
963
+                    if  (defined $filter && ref $filter ne 'CODE') 
964
+                    {
965
+                        my $fname = $filter;
966
+                        croak qq{Filter "$fname" is not registered" } . _subname
967
+                          unless exists $self->filters->{$fname};
968
+                        
969
+                        $filter = $self->filters->{$fname};
970
+                    }
971
+
972
+                    $self->{"_$into"}{key}{$table}{$column} = $filter;
973
+                    $self->{"_$into"}{dot}{"$table.$column"} = $filter;
974
+                }
975
+            });
976
+        }
977
+
978
+        # From
979
+        foreach my $i (1 .. 2) {
980
+            $type_rule->{"from$i"} = _array_to_hash($type_rule->{"from$i"});
981
+            foreach my $data_type (keys %{$type_rule->{"from$i"} || {}}) {
982
+                croak qq{data type of from$i section must be lower case or number}
983
+                  if $data_type =~ /[A-Z]/;
984
+                my $fname = $type_rule->{"from$i"}{$data_type};
985
+                if (defined $fname && ref $fname ne 'CODE') {
986
+                    croak qq{Filter "$fname" is not registered" } . _subname
987
+                      unless exists $self->filters->{$fname};
988
+                    
989
+                    $type_rule->{"from$i"}{$data_type} = $self->filters->{$fname};
990
+                }
991
+            }
992
+        }
993
+        
994
+        return $self;
995
+    }
996
+    
997
+    return $self->{type_rule} || {};
998
+}
999
+
1000
+sub update {
1001
+    my $self = shift;
1002
+
1003
+    # Arguments
1004
+    my $param;
1005
+    $param = shift if @_ % 2;
1006
+    my %args = @_;
1007
+    my $table = delete $args{table} || '';
1008
+    croak qq{"table" option must be specified } . _subname
1009
+      unless $table;
1010
+    my $p = delete $args{param} || {};
1011
+    $param  ||= $p;
1012
+    my $where = delete $args{where} || {};
1013
+    my $where_param = delete $args{where_param} || {};
1014
+    my $append = delete $args{append} || '';
1015
+    my $allow_update_all = delete $args{allow_update_all};
1016
+    my $id = delete $args{id};
1017
+    my $primary_key = delete $args{primary_key};
1018
+    croak "update method primary_key option " .
1019
+          "must be specified when id is specified " . _subname
1020
+      if defined $id && !defined $primary_key;
1021
+    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
1022
+    my $prefix = delete $args{prefix};
1023
+
1024
+    # Update clause
1025
+    my $update_clause = $self->update_param($param);
1026
+
1027
+    # Where
1028
+    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
1029
+    my $where_clause = '';
1030
+    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
1031
+        $where_clause = "where " . $where->[0];
1032
+        $where_param = $where->[1];
1033
+    }
1034
+    elsif (ref $where) {
1035
+        $where = $self->_where_to_obj($where);
1036
+        $where_param = keys %$where_param
1037
+                     ? $self->merge_param($where_param, $where->param)
1038
+                     : $where->param;
1039
+        
1040
+        # String where
1041
+        $where_clause = $where->to_string;
1042
+    }
1043
+    elsif ($where) { $where_clause = "where $where" }
1044
+    croak qq{"where" must be specified } . _subname
1045
+      if "$where_clause" eq '' && !$allow_update_all;
1046
+    
1047
+    # Merge param
1048
+    $param = $self->merge_param($param, $where_param) if keys %$where_param;
1049
+    
1050
+    # Update statement
1051
+    my @sql;
1052
+    push @sql, "update";
1053
+    push @sql, $prefix if defined $prefix;
1054
+    push @sql, $self->_q($table) . " $update_clause $where_clause";
1055
+    push @sql, $append if defined $append;
1056
+    
1057
+    # SQL
1058
+    my $sql = join(' ', @sql);
1059
+    
1060
+    # Execute query
1061
+    return $self->execute($sql, $param, table => $table, %args);
1062
+}
1063
+
1064
+sub update_all { shift->update(allow_update_all => 1, @_) };
1065
+
1066
+sub update_param {
1067
+    my ($self, $param, $opt) = @_;
1068
+    
1069
+    # Create update parameter tag
1070
+    my $tag = $self->assign_param($param);
1071
+    $tag = "set $tag" unless $opt->{no_set};
1072
+
1073
+    return $tag;
1074
+}
1075
+
1076
+sub where { DBIx::Custom::Where->new(dbi => shift, @_) }
1077
+
1078
+sub _create_query {
1079
+    
1080
+    my ($self, $source) = @_;
1081
+    
1082
+    # Cache
1083
+    my $cache = $self->cache;
1084
+    
1085
+    # Query
1086
+    my $query;
1087
+    
1088
+    # Get cached query
1089
+    if ($cache) {
1090
+        
1091
+        # Get query
1092
+        my $q = $self->cache_method->($self, $source);
1093
+        
1094
+        # Create query
1095
+        if ($q) {
1096
+            $query = DBIx::Custom::Query->new($q);
1097
+            $query->{filters} = $self->filters;
1098
+        }
1099
+    }
1100
+    
1101
+    # Create query
1102
+    unless ($query) {
1103
+
1104
+        # Create query
1105
+        my $builder = $self->query_builder;
1106
+        $query = $builder->build_query($source);
1107
+
1108
+        # Remove reserved word quote
1109
+        if (my $q = $self->_quote) {
1110
+            $q = quotemeta($q);
1111
+            $_ =~ s/[$q]//g for @{$query->columns}
1112
+        }
1113
+
1114
+        # Save query to cache
1115
+        $self->cache_method->(
1116
+            $self, $source,
1117
+            {
1118
+                sql     => $query->sql, 
1119
+                columns => $query->columns,
1120
+                tables  => $query->{tables} || []
1121
+            }
1122
+        ) if $cache;
1123
+    }
1124
+    
1125
+    # Save sql
1126
+    $self->last_sql($query->sql);
1127
+    
1128
+    # Prepare statement handle
1129
+    my $sth;
1130
+    eval { $sth = $self->dbh->prepare($query->{sql})};
1131
+    
1132
+    if ($@) {
1133
+        $self->_croak($@, qq{. Following SQL is executed.\n}
1134
+                        . qq{$query->{sql}\n} . _subname);
1135
+    }
1136
+    
1137
+    # Set statement handle
1138
+    $query->sth($sth);
1139
+    
1140
+    # Set filters
1141
+    $query->{filters} = $self->filters;
1142
+    
1143
+    return $query;
1144
+}
1145
+
1146
+sub _create_bind_values {
1147
+    my ($self, $params, $columns, $filter, $type_filters, $bind_type) = @_;
1148
+    
1149
+    # Create bind values
1150
+    my $bind = [];
1151
+    my $count = {};
1152
+    my $not_exists = {};
1153
+    foreach my $column (@$columns) {
1154
+        
1155
+        # Value
1156
+        my $value;
1157
+        if(ref $params->{$column} eq 'ARRAY') {
1158
+            my $i = $count->{$column} || 0;
1159
+            $i += $not_exists->{$column} || 0;
1160
+            my $found;
1161
+            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1162
+                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1163
+                    $not_exists->{$column}++;
1164
+                }
1165
+                else  {
1166
+                    $value = $params->{$column}->[$k];
1167
+                    $found = 1;
1168
+                    last
1169
+                }
1170
+            }
1171
+            next unless $found;
1172
+        }
1173
+        else { $value = $params->{$column} }
1174
+        
1175
+        # Filter
1176
+        my $f = $filter->{$column} || $self->{default_out_filter} || '';
1177
+        $value = $f->($value) if $f;
1178
+        
1179
+        # Type rule
1180
+        foreach my $i (1 .. 2) {
1181
+            my $type_filter = $type_filters->{$i};
1182
+            my $tf = $self->{"_into$i"}->{dot}->{$column} || $type_filter->{$column};
1183
+            $value = $tf->($value) if $tf;
1184
+        }
1185
+        
1186
+        # Bind values
1187
+        push @$bind, {value => $value, bind_type => $bind_type->{$column}};
1188
+        
1189
+        # Count up 
1190
+        $count->{$column}++;
1191
+    }
1192
+    
1193
+    return $bind;
1194
+}
1195
+
1196
+sub _create_param_from_id {
1197
+    my ($self, $id, $primary_keys) = @_;
1198
+    
1199
+    # Create parameter
1200
+    my $param = {};
1201
+    if (defined $id) {
1202
+        $id = [$id] unless ref $id;
1203
+        croak qq{"id" must be constant value or array reference}
1204
+            . " (" . (caller 1)[3] . ")"
1205
+          unless !ref $id || ref $id eq 'ARRAY';
1206
+        croak qq{"id" must contain values same count as primary key}
1207
+            . " (" . (caller 1)[3] . ")"
1208
+          unless @$primary_keys eq @$id;
1209
+        for(my $i = 0; $i < @$primary_keys; $i ++) {
1210
+           $param->{$primary_keys->[$i]} = $id->[$i];
1211
+        }
1212
+    }
1213
+    
1214
+    return $param;
1215
+}
1216
+
1217
+sub _connect {
1218
+    my $self = shift;
1219
+    
1220
+    # Attributes
1221
+    my $dsn = $self->data_source;
1222
+    warn "data_source is DEPRECATED!\n"
1223
+      if $dsn;
1224
+    $dsn ||= $self->dsn;
1225
+    croak qq{"dsn" must be specified } . _subname
1226
+      unless $dsn;
1227
+    my $user        = $self->user;
1228
+    my $password    = $self->password;
1229
+    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1230
+    warn "dbi_options is DEPRECATED! use dbi_option instead\n"
1231
+      if keys %{$self->dbi_options};
1232
+    
1233
+    # Connect
1234
+    my $dbh = eval {DBI->connect(
1235
+        $dsn,
1236
+        $user,
1237
+        $password,
1238
+        {
1239
+            %{$self->default_dbi_option},
1240
+            %$dbi_option
1241
+        }
1242
+    )};
1243
+    
1244
+    # Connect error
1245
+    croak "$@ " . _subname if $@;
1246
+    
1247
+    return $dbh;
1248
+}
1249
+
1250
+sub _croak {
1251
+    my ($self, $error, $append) = @_;
1252
+    
1253
+    # Append
1254
+    $append ||= "";
1255
+    
1256
+    # Verbose
1257
+    if ($Carp::Verbose) { croak $error }
1258
+    
1259
+    # Not verbose
1260
+    else {
1261
+        
1262
+        # Remove line and module infromation
1263
+        my $at_pos = rindex($error, ' at ');
1264
+        $error = substr($error, 0, $at_pos);
1265
+        $error =~ s/\s+$//;
1266
+        croak "$error$append";
1267
+    }
1268
+}
1269
+
1270
+sub _need_tables {
1271
+    my ($self, $tree, $need_tables, $tables) = @_;
1272
+    
1273
+    # Get needed tables
1274
+    foreach my $table (@$tables) {
1275
+        if ($tree->{$table}) {
1276
+            $need_tables->{$table} = 1;
1277
+            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1278
+        }
1279
+    }
1280
+}
1281
+
1282
+sub _push_join {
1283
+    my ($self, $sql, $join, $join_tables) = @_;
1284
+    
1285
+    # No join
1286
+    return unless @$join;
1287
+    
1288
+    # Push join clause
1289
+    my $tree = {};
1290
+    for (my $i = 0; $i < @$join; $i++) {
1291
+        
1292
+        # Arrange
1293
+        my $join_clause;;
1294
+        my $option;
1295
+        if (ref $join->[$i] eq 'HASH') {
1296
+            $join_clause = $join->[$i]->{clause};
1297
+            $option = {table => $join->[$i]->{table}};
1298
+        }
1299
+        else {
1300
+            $join_clause = $join->[$i];
1301
+            $option = {};
1302
+        };
1303
+
1304
+        # Find tables in join clause
1305
+        my $table1;
1306
+        my $table2;
1307
+        if (my $table = $option->{table}) {
1308
+            $table1 = $table->[0];
1309
+            $table2 = $table->[1];
1310
+        }
1311
+        else {
1312
+            my $q = $self->_quote;
1313
+            my $j_clause = (split /\s+on\s+/, $join_clause)[-1];
1314
+            $j_clause =~ s/'.+?'//g;
1315
+            my $q_re = quotemeta($q);
1316
+            $j_clause =~ s/[$q_re]//g;
1317
+            my $c = $self->safety_character;
1318
+            my $join_re = qr/(?:^|\s)($c+)\.$c+\s+=\s+($c+)\.$c+/;
1319
+            if ($j_clause =~ $join_re) {
1320
+                $table1 = $1;
1321
+                $table2 = $2;
1322
+            }
1323
+        }
1324
+        croak qq{join clause must have two table name after "on" keyword. } .
1325
+              qq{"$join_clause" is passed }  . _subname
1326
+          unless defined $table1 && defined $table2;
1327
+        croak qq{right side table of "$join_clause" must be unique }
1328
+            . _subname
1329
+          if exists $tree->{$table2};
1330
+        croak qq{Same table "$table1" is specified} . _subname
1331
+          if $table1 eq $table2;
1332
+        $tree->{$table2}
1333
+          = {position => $i, parent => $table1, join => $join_clause};
1334
+    }
1335
+    
1336
+    # Search need tables
1337
+    my $need_tables = {};
1338
+    $self->_need_tables($tree, $need_tables, $join_tables);
1339
+    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
1340
+    
1341
+    # Add join clause
1342
+    foreach my $need_table (@need_tables) {
1343
+        push @$sql, $tree->{$need_table}{join};
1344
+    }
1345
+}
1346
+
1347
+sub _quote {
1348
+    my $self = shift;
1349
+    
1350
+    return defined $self->reserved_word_quote ? $self->reserved_word_quote
1351
+         : defined $self->quote ? $self->quote
1352
+         : '';
1353
+}
1354
+
1355
+sub _q {
1356
+    my ($self, $value) = @_;
1357
+    
1358
+    my $quote = $self->_quote;
1359
+    my $q = substr($quote, 0, 1) || '';
1360
+    my $p;
1361
+    if (defined $quote && length $quote > 1) {
1362
+        $p = substr($quote, 1, 1);
1363
+    }
1364
+    else { $p = $q }
1365
+    
1366
+    return "$q$value$p";
1367
+}
1368
+
1369
+sub _remove_duplicate_table {
1370
+    my ($self, $tables, $main_table) = @_;
1371
+    
1372
+    # Remove duplicate table
1373
+    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1374
+    delete $tables{$main_table} if $main_table;
1375
+    
1376
+    my $new_tables = [keys %tables, $main_table ? $main_table : ()];
1377
+    if (my $q = $self->_quote) {
1378
+        $q = quotemeta($q);
1379
+        $_ =~ s/[$q]//g for @$new_tables;
1380
+    }
1381
+
1382
+    return $new_tables;
1383
+}
1384
+
1385
+sub _search_tables {
1386
+    my ($self, $source) = @_;
1387
+    
1388
+    # Search tables
1389
+    my $tables = [];
1390
+    my $safety_character = $self->safety_character;
1391
+    my $q = $self->_quote;
1392
+    my $q_re = quotemeta($q);
1393
+    my $quoted_safety_character_re = $self->_q("?([$safety_character]+)");
1394
+    my $table_re = $q ? qr/(?:^|[^$safety_character])$quoted_safety_character_re?\./
1395
+                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
1396
+    while ($source =~ /$table_re/g) {
1397
+        push @$tables, $1;
1398
+    }
1399
+    
1400
+    return $tables;
1401
+}
1402
+
1403
+sub _where_to_obj {
1404
+    my ($self, $where) = @_;
1405
+    
1406
+    my $obj;
1407
+    
1408
+    # Hash
1409
+    if (ref $where eq 'HASH') {
1410
+        my $clause = ['and'];
1411
+        my $q = $self->_quote;
1412
+        foreach my $column (keys %$where) {
1413
+            my $column_quote = $self->_q($column);
1414
+            $column_quote =~ s/\./$self->_q(".")/e;
1415
+            push @$clause, "$column_quote = :$column" for keys %$where;
1416
+        }
1417
+        $obj = $self->where(clause => $clause, param => $where);
1418
+    }
1419
+    
1420
+    # DBIx::Custom::Where object
1421
+    elsif (ref $where eq 'DBIx::Custom::Where') {
1422
+        $obj = $where;
1423
+    }
1424
+    
1425
+    # Array
1426
+    elsif (ref $where eq 'ARRAY') {
1427
+        $obj = $self->where(
1428
+            clause => $where->[0],
1429
+            param  => $where->[1]
1430
+        );
1431
+    }
1432
+    
1433
+    # Check where argument
1434
+    croak qq{"where" must be hash reference or DBIx::Custom::Where object}
1435
+        . qq{or array reference, which contains where clause and parameter}
1436
+        . _subname
1437
+      unless ref $obj eq 'DBIx::Custom::Where';
1438
+    
1439
+    return $obj;
1440
+}
1441
+
1442
+sub _apply_filter {
1443
+    my ($self, $table, @cinfos) = @_;
1444
+
1445
+    # Initialize filters
1446
+    $self->{filter} ||= {};
1447
+    $self->{filter}{on} = 1;
1448
+    $self->{filter}{out} ||= {};
1449
+    $self->{filter}{in} ||= {};
1450
+    $self->{filter}{end} ||= {};
1451
+    
1452
+    # Usage
1453
+    my $usage = "Usage: \$dbi->apply_filter(" .
1454
+                "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1, end => ENDFILTER1}, " .
1455
+                "COLUMN2, {in => INFILTER2, out => OUTFILTER2, end => ENDFILTER2}, ...)";
1456
+    
1457
+    # Apply filter
1458
+    for (my $i = 0; $i < @cinfos; $i += 2) {
1459
+        
1460
+        # Column
1461
+        my $column = $cinfos[$i];
1462
+        if (ref $column eq 'ARRAY') {
1463
+            foreach my $c (@$column) {
1464
+                push @cinfos, $c, $cinfos[$i + 1];
1465
+            }
1466
+            next;
1467
+        }
1468
+        
1469
+        # Filter infomation
1470
+        my $finfo = $cinfos[$i + 1] || {};
1471
+        croak "$usage (table: $table) " . _subname
1472
+          unless  ref $finfo eq 'HASH';
1473
+        foreach my $ftype (keys %$finfo) {
1474
+            croak "$usage (table: $table) " . _subname
1475
+              unless $ftype eq 'in' || $ftype eq 'out' || $ftype eq 'end'; 
1476
+        }
1477
+        
1478
+        # Set filters
1479
+        foreach my $way (qw/in out end/) {
1480
+        
1481
+            # Filter
1482
+            my $filter = $finfo->{$way};
1483
+            
1484
+            # Filter state
1485
+            my $state = !exists $finfo->{$way} ? 'not_exists'
1486
+                      : !defined $filter        ? 'not_defined'
1487
+                      : ref $filter eq 'CODE'   ? 'code'
1488
+                      : 'name';
1489
+            
1490
+            # Filter is not exists
1491
+            next if $state eq 'not_exists';
1492
+            
1493
+            # Check filter name
1494
+            croak qq{Filter "$filter" is not registered } . _subname
1495
+              if  $state eq 'name'
1496
+               && ! exists $self->filters->{$filter};
1497
+            
1498
+            # Set filter
1499
+            my $f = $state eq 'not_defined' ? undef
1500
+                  : $state eq 'code'        ? $filter
1501
+                  : $self->filters->{$filter};
1502
+            $self->{filter}{$way}{$table}{$column} = $f;
1503
+            $self->{filter}{$way}{$table}{"$table.$column"} = $f;
1504
+            $self->{filter}{$way}{$table}{"${table}__$column"} = $f;
1505
+            $self->{filter}{$way}{$table}{"${table}-$column"} = $f;
1506
+        }
1507
+    }
1508
+    
1509
+    return $self;
1510
+}
1511
+
1512
+# DEPRECATED!
1513
+sub create_query {
1514
+    warn "create_query is DEPRECATED! use query option of each method";
1515
+    shift->_create_query(@_);
1516
+}
1517
+
1518
+# DEPRECATED!
1519
+sub apply_filter {
1520
+    my $self = shift;
1521
+    
1522
+    warn "apply_filter is DEPRECATED!";
1523
+    return $self->_apply_filter(@_);
1524
+}
1525
+
1526
+# DEPRECATED!
1527
+our %SELECT_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1528
+sub select_at {
1529
+    my ($self, %args) = @_;
1530
+
1531
+    warn "select_at is DEPRECATED! use update and id option instead";
1532
+
1533
+    # Arguments
1534
+    my $primary_keys = delete $args{primary_key};
1535
+    $primary_keys = [$primary_keys] unless ref $primary_keys;
1536
+    my $where = delete $args{where};
1537
+    my $param = delete $args{param};
1538
+    
1539
+    # Check arguments
1540
+    foreach my $name (keys %args) {
1541
+        croak qq{"$name" is wrong option } . _subname
1542
+          unless $SELECT_AT_ARGS{$name};
1543
+    }
1544
+    
1545
+    # Table
1546
+    croak qq{"table" option must be specified } . _subname
1547
+      unless $args{table};
1548
+    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
1549
+    
1550
+    # Create where parameter
1551
+    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1552
+    
1553
+    return $self->select(where => $where_param, %args);
1554
+}
1555
+
1556
+# DEPRECATED!
1557
+our %DELETE_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1558
+sub delete_at {
1559
+    my ($self, %args) = @_;
1560
+
1561
+    warn "delete_at is DEPRECATED! use update and id option instead";
1562
+    
1563
+    # Arguments
1564
+    my $primary_keys = delete $args{primary_key};
1565
+    $primary_keys = [$primary_keys] unless ref $primary_keys;
1566
+    my $where = delete $args{where};
1567
+    
1568
+    # Check arguments
1569
+    foreach my $name (keys %args) {
1570
+        croak qq{"$name" is wrong option } . _subname
1571
+          unless $DELETE_AT_ARGS{$name};
1572
+    }
1573
+    
1574
+    # Create where parameter
1575
+    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1576
+    
1577
+    return $self->delete(where => $where_param, %args);
1578
+}
1579
+
1580
+# DEPRECATED!
1581
+our %UPDATE_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1582
+sub update_at {
1583
+    my $self = shift;
1584
+
1585
+    warn "update_at is DEPRECATED! use update and id option instead";
1586
+    
1587
+    # Arguments
1588
+    my $param;
1589
+    $param = shift if @_ % 2;
1590
+    my %args = @_;
1591
+    my $primary_keys = delete $args{primary_key};
1592
+    $primary_keys = [$primary_keys] unless ref $primary_keys;
1593
+    my $where = delete $args{where};
1594
+    my $p = delete $args{param} || {};
1595
+    $param  ||= $p;
1596
+    
1597
+    # Check arguments
1598
+    foreach my $name (keys %args) {
1599
+        croak qq{"$name" is wrong option } . _subname
1600
+          unless $UPDATE_AT_ARGS{$name};
1601
+    }
1602
+    
1603
+    # Create where parameter
1604
+    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1605
+    
1606
+    return $self->update(where => $where_param, param => $param, %args);
1607
+}
1608
+
1609
+# DEPRECATED!
1610
+our %INSERT_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
1611
+sub insert_at {
1612
+    my $self = shift;
1613
+    
1614
+    warn "insert_at is DEPRECATED! use insert and id option instead";
1615
+    
1616
+    # Arguments
1617
+    my $param;
1618
+    $param = shift if @_ % 2;
1619
+    my %args = @_;
1620
+    my $primary_key = delete $args{primary_key};
1621
+    $primary_key = [$primary_key] unless ref $primary_key;
1622
+    my $where = delete $args{where};
1623
+    my $p = delete $args{param} || {};
1624
+    $param  ||= $p;
1625
+    
1626
+    # Check arguments
1627
+    foreach my $name (keys %args) {
1628
+        croak qq{"$name" is wrong option } . _subname
1629
+          unless $INSERT_AT_ARGS{$name};
1630
+    }
1631
+    
1632
+    # Create where parameter
1633
+    my $where_param = $self->_create_param_from_id($where, $primary_key);
1634
+    $param = $self->merge_param($where_param, $param);
1635
+    
1636
+    return $self->insert(param => $param, %args);
1637
+}
1638
+
1639
+# DEPRECATED!
1640
+sub register_tag {
1641
+    warn "register_tag is DEPRECATED!";
1642
+    shift->query_builder->register_tag(@_)
1643
+}
1644
+
1645
+# DEPRECATED!
1646
+has 'data_source';
1647
+has dbi_options => sub { {} };
1648
+has filter_check  => 1;
1649
+has 'reserved_word_quote';
1650
+
1651
+# DEPRECATED!
1652
+sub default_bind_filter {
1653
+    my $self = shift;
1654
+    
1655
+    warn "default_bind_filter is DEPRECATED!";
1656
+    
1657
+    if (@_) {
1658
+        my $fname = $_[0];
1659
+        
1660
+        if (@_ && !$fname) {
1661
+            $self->{default_out_filter} = undef;
1662
+        }
1663
+        else {
1664
+            croak qq{Filter "$fname" is not registered}
1665
+              unless exists $self->filters->{$fname};
1666
+        
1667
+            $self->{default_out_filter} = $self->filters->{$fname};
1668
+        }
1669
+        return $self;
1670
+    }
1671
+    
1672
+    return $self->{default_out_filter};
1673
+}
1674
+
1675
+# DEPRECATED!
1676
+sub default_fetch_filter {
1677
+    my $self = shift;
1678
+
1679
+    warn "default_fetch_filter is DEPRECATED!";
1680
+    
1681
+    if (@_) {
1682
+        my $fname = $_[0];
1683
+
1684
+        if (@_ && !$fname) {
1685
+            $self->{default_in_filter} = undef;
1686
+        }
1687
+        else {
1688
+            croak qq{Filter "$fname" is not registered}
1689
+              unless exists $self->filters->{$fname};
1690
+        
1691
+            $self->{default_in_filter} = $self->filters->{$fname};
1692
+        }
1693
+        
1694
+        return $self;
1695
+    }
1696
+    
1697
+    return $self->{default_in_filter};
1698
+}
1699
+
1700
+# DEPRECATED!
1701
+sub insert_param_tag {
1702
+    warn "insert_param_tag is DEPRECATED! " .
1703
+         "use insert_param instead!";
1704
+    return shift->insert_param(@_);
1705
+}
1706
+
1707
+# DEPRECATED!
1708
+sub register_tag_processor {
1709
+    warn "register_tag_processor is DEPRECATED!";
1710
+    return shift->query_builder->register_tag_processor(@_);
1711
+}
1712
+
1713
+# DEPRECATED!
1714
+sub update_param_tag {
1715
+    warn "update_param_tag is DEPRECATED! " .
1716
+         "use update_param instead";
1717
+    return shift->update_param(@_);
1718
+}
1719
+# DEPRECATED!
1720
+sub _push_relation {
1721
+    my ($self, $sql, $tables, $relation, $need_where) = @_;
1722
+    
1723
+    if (keys %{$relation || {}}) {
1724
+        push @$sql, $need_where ? 'where' : 'and';
1725
+        foreach my $rcolumn (keys %$relation) {
1726
+            my $table1 = (split (/\./, $rcolumn))[0];
1727
+            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1728
+            push @$tables, ($table1, $table2);
1729
+            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1730
+        }
1731
+    }
1732
+    pop @$sql if $sql->[-1] eq 'and';    
1733
+}
1734
+
1735
+# DEPRECATED!
1736
+sub _add_relation_table {
1737
+    my ($self, $tables, $relation) = @_;
1738
+    
1739
+    if (keys %{$relation || {}}) {
1740
+        foreach my $rcolumn (keys %$relation) {
1741
+            my $table1 = (split (/\./, $rcolumn))[0];
1742
+            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1743
+            my $table1_exists;
1744
+            my $table2_exists;
1745
+            foreach my $table (@$tables) {
1746
+                $table1_exists = 1 if $table eq $table1;
1747
+                $table2_exists = 1 if $table eq $table2;
1748
+            }
1749
+            unshift @$tables, $table1 unless $table1_exists;
1750
+            unshift @$tables, $table2 unless $table2_exists;
1751
+        }
1752
+    }
1753
+}
1754
+
1755
+1;
1756
+
1757
+=head1 NAME
1758
+
1759
+DBIx::Custom - Execute insert, update, delete, and select statement easily
1760
+
1761
+=head1 SYNOPSYS
1762
+
1763
+    use DBIx::Custom;
1764
+    
1765
+    # Connect
1766
+    my $dbi = DBIx::Custom->connect(
1767
+        dsn => "dbi:mysql:database=dbname",
1768
+        user => 'ken',
1769
+        password => '!LFKD%$&',
1770
+        dbi_option => {mysql_enable_utf8 => 1}
1771
+    );
1772
+
1773
+    # Insert 
1774
+    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
1775
+    
1776
+    # Update 
1777
+    $dbi->update({title => 'Perl', author => 'Ken'}, table  => 'book',
1778
+      where  => {id => 5});
1779
+    
1780
+    # Delete
1781
+    $dbi->delete(table  => 'book', where => {author => 'Ken'});
1782
+
1783
+    # Select
1784
+    my $result = $dbi->select(table  => 'book',
1785
+      column => ['title', 'author'], where  => {author => 'Ken'});
1786
+
1787
+    # Select, more complex
1788
+    my $result = $dbi->select(
1789
+        table  => 'book',
1790
+        column => [
1791
+            {book => [qw/title author/]},
1792
+            {company => ['name']}
1793
+        ],
1794
+        where  => {'book.author' => 'Ken'},
1795
+        join => ['left outer join company on book.company_id = company.id'],
1796
+        append => 'order by id limit 5'
1797
+    );
1798
+    
1799
+    # Fetch
1800
+    while (my $row = $result->fetch) {
1801
+        
1802
+    }
1803
+    
1804
+    # Fetch as hash
1805
+    while (my $row = $result->fetch_hash) {
1806
+        
1807
+    }
1808
+    
1809
+    # Execute SQL with parameter.
1810
+    $dbi->execute(
1811
+        "select id from book where author = :author and title like :title",
1812
+        {author => 'ken', title => '%Perl%'}
1813
+    );
1814
+    
1815
+=head1 DESCRIPTIONS
1816
+
1817
+L<DBIx::Custom> is L<DBI> wrapper module to execute SQL easily.
1818
+This module have the following features.
1819
+
1820
+=over 4
1821
+
1822
+=item *
1823
+
1824
+Execute C<insert>, C<update>, C<delete>, or C<select> statement easily
1825
+
1826
+=item *
1827
+
1828
+Create C<where> clause flexibly
1829
+
1830
+=item *
1831
+
1832
+Named place holder support
1833
+
1834
+=item *
1835
+
1836
+Model support
1837
+
1838
+=item *
1839
+
1840
+Connection manager support
1841
+
1842
+=item *
1843
+
1844
+Choice your favorite relational database management system,
1845
+C<MySQL>, C<SQLite>, C<PostgreSQL>, C<Oracle>,
1846
+C<Microsoft SQL Server>, C<Microsoft Access>, C<DB2> or anything, 
1847
+
1848
+=item *
1849
+
1850
+Filtering by data type or column name(EXPERIMENTAL)
1851
+
1852
+=item *
1853
+
1854
+Create C<order by> clause flexibly(EXPERIMENTAL)
1855
+
1856
+=back
1857
+
1858
+=head1 DOCUMENTATIONS
1859
+
1860
+L<DBIx::Custom::Guide> - How to use L<DBIx::Custom>
1861
+
1862
+L<DBIx::Custom Wiki|https://github.com/yuki-kimoto/DBIx-Custom/wiki>
1863
+- Theare are various examples.
1864
+
1865
+Module documentations - 
1866
+L<DBIx::Custom::Result>,
1867
+L<DBIx::Custom::Query>,
1868
+L<DBIx::Custom::Where>,
1869
+L<DBIx::Custom::Model>,
1870
+L<DBIx::Custom::Order>
1871
+
1872
+=head1 ATTRIBUTES
1873
+
1874
+=head2 C<connector>
1875
+
1876
+    my $connector = $dbi->connector;
1877
+    $dbi = $dbi->connector($connector);
1878
+
1879
+Connection manager object. if C<connector> is set, you can get C<dbh>
1880
+through connection manager. Conection manager object must have C<dbh> mehtod.
1881
+
1882
+This is L<DBIx::Connector> example. Please pass
1883
+C<default_dbi_option> to L<DBIx::Connector> C<new> method.
1884
+
1885
+    my $connector = DBIx::Connector->new(
1886
+        "dbi:mysql:database=$DATABASE",
1887
+        $USER,
1888
+        $PASSWORD,
1889
+        DBIx::Custom->new->default_dbi_option
1890
+    );
1891
+    
1892
+    my $dbi = DBIx::Custom->connect(connector => $connector);
1893
+
1894
+=head2 C<dsn>
1895
+
1896
+    my $dsn = $dbi->dsn;
1897
+    $dbi = $dbi->dsn("DBI:mysql:database=dbname");
1898
+
1899
+Data source name, used when C<connect> method is executed.
1900
+
1901
+=head2 C<dbi_option>
1902
+
1903
+    my $dbi_option = $dbi->dbi_option;
1904
+    $dbi = $dbi->dbi_option($dbi_option);
1905
+
1906
+L<DBI> option, used when C<connect> method is executed.
1907
+Each value in option override the value of C<default_dbi_option>.
1908
+
1909
+=head2 C<default_dbi_option>
1910
+
1911
+    my $default_dbi_option = $dbi->default_dbi_option;
1912
+    $dbi = $dbi->default_dbi_option($default_dbi_option);
1913
+
1914
+L<DBI> default option, used when C<connect> method is executed,
1915
+default to the following values.
1916
+
1917
+    {
1918
+        RaiseError => 1,
1919
+        PrintError => 0,
1920
+        AutoCommit => 1,
1921
+    }
1922
+
1923
+=head2 C<filters>
1924
+
1925
+    my $filters = $dbi->filters;
1926
+    $dbi = $dbi->filters(\%filters);
1927
+
1928
+Filters, registered by C<register_filter> method.
1929
+
1930
+=head2 C<last_sql>
1931
+
1932
+    my $last_sql = $dbi->last_sql;
1933
+    $dbi = $dbi->last_sql($last_sql);
1934
+
1935
+Get last successed SQL executed by C<execute> method.
1936
+
1937
+=head2 C<models>
1938
+
1939
+    my $models = $dbi->models;
1940
+    $dbi = $dbi->models(\%models);
1941
+
1942
+Models, included by C<include_model> method.
1943
+
1944
+=head2 C<password>
1945
+
1946
+    my $password = $dbi->password;
1947
+    $dbi = $dbi->password('lkj&le`@s');
1948
+
1949
+Password, used when C<connect> method is executed.
1950
+
1951
+=head2 C<query_builder>
1952
+
1953
+    my $sql_class = $dbi->query_builder;
1954
+    $dbi = $dbi->query_builder(DBIx::Custom::QueryBuilder->new);
1955
+
1956
+Query builder, default to L<DBIx::Custom::QueryBuilder> object.
1957
+
1958
+=head2 C<quote>
1959
+
1960
+     my quote = $dbi->quote;
1961
+     $dbi = $dbi->quote('"');
1962
+
1963
+Reserved word quote.
1964
+Default to double quote '"' except for mysql.
1965
+In mysql, default to back quote '`'
1966
+
1967
+You can set quote pair.
1968
+
1969
+    $dbi->quote('[]');
1970
+
1971
+=head2 C<result_class>
1972
+
1973
+    my $result_class = $dbi->result_class;
1974
+    $dbi = $dbi->result_class('DBIx::Custom::Result');
1975
+
1976
+Result class, default to L<DBIx::Custom::Result>.
1977
+
1978
+=head2 C<safety_character>
1979
+
1980
+    my $safety_character = $self->safety_character;
1981
+    $dbi = $self->safety_character($character);
1982
+
1983
+Regex of safety character for table and column name, default to '\w'.
1984
+Note that you don't have to specify like '[\w]'.
1985
+
1986
+=head2 C<tag_parse>
1987
+
1988
+    my $tag_parse = $dbi->tag_parse(0);
1989
+    $dbi = $dbi->tag_parse;
1990
+
1991
+Enable DEPRECATED tag parsing functionality, default to 1.
1992
+If you want to disable tag parsing functionality, set to 0.
1993
+
1994
+=head2 C<user>
1995
+
1996
+    my $user = $dbi->user;
1997
+    $dbi = $dbi->user('Ken');
1998
+
1999
+User name, used when C<connect> method is executed.
2000
+
2001
+=head1 METHODS
2002
+
2003
+L<DBIx::Custom> inherits all methods from L<Object::Simple>
2004
+and use all methods of L<DBI>
2005
+and implements the following new ones.
2006
+
2007
+=head2 C<available_data_type> EXPERIMENTAL
2008
+
2009
+    print $dbi->available_data_type;
2010
+
2011
+Get available data types. You can use these data types
2012
+in C<type rule>'s C<from1> and C<from2> section.
2013
+
2014
+=head2 C<available_type_name> EXPERIMENTAL
2015
+
2016
+    print $dbi->available_type_name;
2017
+
2018
+Get available type names. You can use these type names in
2019
+C<type_rule>'s C<into1> and C<into2> section.
2020
+
2021
+=head2 C<assign_param> EXPERIMENTAL
2022
+
2023
+    my $assign_param = $dbi->assign_param({title => 'a', age => 2});
2024
+
2025
+Create assign parameter.
2026
+
2027
+    title = :title, author = :author
2028
+
2029
+This is equal to C<update_param> exept that set is not added.
2030
+
2031
+=head2 C<column>
2032
+
2033
+    my $column = $dbi->column(book => ['author', 'title']);
2034
+
2035
+Create column clause. The follwoing column clause is created.
2036
+
2037
+    book.author as "book.author",
2038
+    book.title as "book.title"
2039
+
2040
+You can change separator by C<separator> method.
2041
+
2042
+    # Separator is double underbar
2043
+    $dbi->separator('__');
2044
+    
2045
+    book.author as "book__author",
2046
+    book.title as "book__title"
2047
+
2048
+    # Separator is hyphen
2049
+    $dbi->separator('-');
2050
+    
2051
+    book.author as "book-author",
2052
+    book.title as "book-title"
2053
+    
2054
+=head2 C<connect>
2055
+
2056
+    my $dbi = DBIx::Custom->connect(
2057
+        dsn => "dbi:mysql:database=dbname",
2058
+        user => 'ken',
2059
+        password => '!LFKD%$&',
2060
+        dbi_option => {mysql_enable_utf8 => 1}
2061
+    );
2062
+
2063
+Connect to the database and create a new L<DBIx::Custom> object.
2064
+
2065
+L<DBIx::Custom> is a wrapper of L<DBI>.
2066
+C<AutoCommit> and C<RaiseError> options are true, 
2067
+and C<PrintError> option is false by default.
2068
+
2069
+=head2 create_model
2070
+
2071
+    my $model = $dbi->create_model(
2072
+        table => 'book',
2073
+        primary_key => 'id',
2074
+        join => [
2075
+            'inner join company on book.comparny_id = company.id'
2076
+        ],
2077
+    );
2078
+
2079
+Create L<DBIx::Custom::Model> object and initialize model.
2080
+the module is also used from C<model> method.
2081
+
2082
+   $dbi->model('book')->select(...);
2083
+
2084
+=head2 C<dbh>
2085
+
2086
+    my $dbh = $dbi->dbh;
2087
+
2088
+Get L<DBI> database handle. if C<connector> is set, you can get
2089
+database handle through C<connector> object.
2090
+
2091
+=head2 C<each_column>
2092
+
2093
+    $dbi->each_column(
2094
+        sub {
2095
+            my ($dbi, $table, $column, $column_info) = @_;
2096
+            
2097
+            my $type = $column_info->{TYPE_NAME};
2098
+            
2099
+            if ($type eq 'DATE') {
2100
+                # ...
2101
+            }
2102
+        }
2103
+    );
2104
+
2105
+Iterate all column informations of all table from database.
2106
+Argument is callback when one column is found.
2107
+Callback receive four arguments, dbi object, table name,
2108
+column name and column information.
2109
+
2110
+=head2 C<each_table>
2111
+
2112
+    $dbi->each_table(
2113
+        sub {
2114
+            my ($dbi, $table, $table_info) = @_;
2115
+            
2116
+            my $table_name = $table_info->{TABLE_NAME};
2117
+        }
2118
+    );
2119
+
2120
+Iterate all table informationsfrom database.
2121
+Argument is callback when one table is found.
2122
+Callback receive three arguments, dbi object, table name,
2123
+table information.
2124
+
2125
+=head2 C<execute>
2126
+
2127
+    my $result = $dbi->execute(
2128
+      "select * from book where title = :title and author like :author",
2129
+      {title => 'Perl', author => '%Ken%'}
2130
+    );
2131
+
2132
+    my $result = $dbi->execute(
2133
+      "select * from book where title = :book.title and author like :book.author",
2134
+      {'book.title' => 'Perl', 'book.author' => '%Ken%'}
2135
+    );
2136
+
2137
+Execute SQL. SQL can contain column parameter such as :author and :title.
2138
+You can append table name to column name such as :book.title and :book.author.
2139
+Second argunet is data, embedded into column parameter.
2140
+Return value is L<DBIx::Custom::Result> object when select statement is executed,
2141
+or the count of affected rows when insert, update, delete statement is executed.
2142
+
2143
+Named placeholder such as C<:title> is replaced by placeholder C<?>.
2144
+    
2145
+    # Original
2146
+    select * from book where title = :title and author like :author
2147
+    
2148
+    # Replaced
2149
+    select * from where title = ? and author like ?;
2150
+
2151
+You can specify operator with named placeholder
2152
+ by C<name{operator}> syntax.
2153
+
2154
+    # Original
2155
+    select * from book where :title{=} and :author{like}
2156
+    
2157
+    # Replaced
2158
+    select * from where title = ? and author like ?;
2159
+
2160
+Note that colons in time format such as 12:13:15 is exeption,
2161
+it is not parsed as named placeholder.
2162
+If you want to use colon generally, you must escape it by C<\\>
2163
+
2164
+    select * from where title = "aa\\:bb";
2165
+
2166
+The following opitons are available.
2167
+
2168
+=over 4
2169
+
2170
+=item C<filter>
2171
+    
2172
+    filter => {
2173
+        title  => sub { uc $_[0] }
2174
+        author => sub { uc $_[0] }
2175
+    }
2176
+
2177
+    # Filter name
2178
+    filter => {
2179
+        title  => 'upper_case',
2180
+        author => 'upper_case'
2181
+    }
2182
+        
2183
+    # At once
2184
+    filter => [
2185
+        [qw/title author/]  => sub { uc $_[0] }
2186
+    ]
2187
+
2188
+Filter. You can set subroutine or filter name
2189
+registered by by C<register_filter>.
2190
+This filter is executed before data is saved into database.
2191
+and before type rule filter is executed.
2192
+
2193
+=item C<query>
2194
+
2195
+    query => 1
2196
+
2197
+C<execute> method return L<DBIx::Custom::Query> object, not executing SQL.
2198
+You can check SQL or get statment handle.
2199
+
2200
+    my $sql = $query->sql;
2201
+    my $sth = $query->sth;
2202
+    my $columns = $query->columns;
2203
+    
2204
+If you want to execute SQL fast, you can do the following way.
2205
+
2206
+    my $query;
2207
+    foreach my $row (@$rows) {
2208
+      $query ||= $dbi->insert($row, table => 'table1', query => 1);
2209
+      $dbi->execute($query, $row, filter => {ab => sub { $_[0] * 2 }});
2210
+    }
2211
+
2212
+Statement handle is reused and SQL parsing is finished,
2213
+so you can get more performance than normal way.
2214
+
2215
+If you want to execute SQL as possible as fast and don't need filtering.
2216
+You can do the following way.
2217
+    
2218
+    my $query;
2219
+    my $sth;
2220
+    foreach my $row (@$rows) {
2221
+      $query ||= $dbi->insert($row, table => 'book', query => 1);
2222
+      $sth ||= $query->sth;
2223
+      $sth->execute(map { $row->{$_} } sort keys %$row);
2224
+    }
2225
+
2226
+Note that $row must be simple hash reference, such as
2227
+{title => 'Perl', author => 'Ken'}.
2228
+and don't forget to sort $row values by $row key asc order.
2229
+
2230
+=item C<table>
2231
+    
2232
+    table => 'author'
2233
+
2234
+If you want to omit table name in column name
2235
+and enable C<into1> and C<into2> type filter,
2236
+You must set C<table> option.
2237
+
2238
+    $dbi->execute("select * from book where title = :title and author = :author",
2239
+        {title => 'Perl', author => 'Ken', table => 'book');
2240
+
2241
+    # Same
2242
+    $dbi->execute(
2243
+      "select * from book where title = :book.title and author = :book.author",
2244
+      {title => 'Perl', author => 'Ken');
2245
+
2246
+=item C<bind_type>
2247
+
2248
+Specify database bind data type.
2249
+
2250
+    bind_type => [image => DBI::SQL_BLOB]
2251
+    bind_type => [[qw/image audio/] => DBI::SQL_BLOB]
2252
+
2253
+This is used to bind parameter by C<bind_param> of statment handle.
2254
+
2255
+    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2256
+
2257
+=item C<table_alias> EXPERIMENTAL
2258
+
2259
+    table_alias => {user => 'hiker'}
2260
+
2261
+Table alias. Key is real table name, value is alias table name.
2262
+If you set C<table_alias>, you can enable C<into1> and C<into2> type rule
2263
+on alias table name.
2264
+
2265
+=item C<type_rule_off> EXPERIMENTAL
2266
+
2267
+    type_rule_off => 1
2268
+
2269
+Turn C<into1> and C<into2> type rule off.
2270
+
2271
+=item C<type_rule1_off> EXPERIMENTAL
2272
+
2273
+    type_rule1_off => 1
2274
+
2275
+Turn C<into1> type rule off.
2276
+
2277
+=item C<type_rule2_off> EXPERIMENTAL
2278
+
2279
+    type_rule2_off => 1
2280
+
2281
+Turn C<into2> type rule off.
2282
+
2283
+=back
2284
+
2285
+=head2 C<delete>
2286
+
2287
+    $dbi->delete(table => 'book', where => {title => 'Perl'});
2288
+
2289
+Execute delete statement.
2290
+
2291
+The following opitons are available.
2292
+
2293
+=over 4
2294
+
2295
+=item C<append>
2296
+
2297
+Same as C<select> method's C<append> option.
2298
+
2299
+=item C<filter>
2300
+
2301
+Same as C<execute> method's C<filter> option.
2302
+
2303
+=item C<id>
2304
+
2305
+    id => 4
2306
+    id => [4, 5]
2307
+
2308
+ID corresponding to C<primary_key>.
2309
+You can delete rows by C<id> and C<primary_key>.
2310
+
2311
+    $dbi->delete(
2312
+        parimary_key => ['id1', 'id2'],
2313
+        id => [4, 5],
2314
+        table => 'book',
2315
+    );
2316
+
2317
+The above is same as the followin one.
2318
+
2319
+    $dbi->delete(where => {id1 => 4, id2 => 5}, table => 'book');
2320
+
2321
+=item C<prefix>
2322
+
2323
+    prefix => 'some'
2324
+
2325
+prefix before table name section.
2326
+
2327
+    delete some from book
2328
+
2329
+=item C<query>
2330
+
2331
+Same as C<execute> method's C<query> option.
2332
+
2333
+=item C<table>
2334
+
2335
+    table => 'book'
2336
+
2337
+Table name.
2338
+
2339
+=item C<where>
2340
+
2341
+Same as C<select> method's C<where> option.
2342
+
2343
+=item C<primary_key>
2344
+
2345
+See C<id> option.
2346
+
2347
+=item C<bind_type>
2348
+
2349
+Same as C<execute> method's C<bind_type> option.
2350
+
2351
+=item C<type_rule_off> EXPERIMENTAL
2352
+
2353
+Same as C<execute> method's C<type_rule_off> option.
2354
+
2355
+=item C<type_rule1_off> EXPERIMENTAL
2356
+
2357
+    type_rule1_off => 1
2358
+
2359
+Same as C<execute> method's C<type_rule1_off> option.
2360
+
2361
+=item C<type_rule2_off> EXPERIMENTAL
2362
+
2363
+    type_rule2_off => 1
2364
+
2365
+Same as C<execute> method's C<type_rule2_off> option.
2366
+
2367
+=back
2368
+
2369
+=head2 C<delete_all>
2370
+
2371
+    $dbi->delete_all(table => $table);
2372
+
2373
+Execute delete statement for all rows.
2374
+Options is same as C<delete>.
2375
+
2376
+=head2 C<insert>
2377
+
2378
+    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
2379
+
2380
+Execute insert statement. First argument is row data. Return value is
2381
+affected row count.
2382
+
2383
+If you want to set constant value to row data, use scalar reference
2384
+as parameter value.
2385
+
2386
+    {date => \"NOW()"}
2387
+
2388
+The following opitons are available.
2389
+
2390
+=over 4
2391
+
2392
+=item C<append>
2393
+
2394
+Same as C<select> method's C<append> option.
2395
+
2396
+=item C<filter>
2397
+
2398
+Same as C<execute> method's C<filter> option.
2399
+
2400
+=item C<id>
2401
+
2402
+    id => 4
2403
+    id => [4, 5]
2404
+
2405
+ID corresponding to C<primary_key>.
2406
+You can insert a row by C<id> and C<primary_key>.
2407
+
2408
+    $dbi->insert(
2409
+        {title => 'Perl', author => 'Ken'}
2410
+        parimary_key => ['id1', 'id2'],
2411
+        id => [4, 5],
2412
+        table => 'book'
2413
+    );
2414
+
2415
+The above is same as the followin one.
2416
+
2417
+    $dbi->insert(
2418
+        {id1 => 4, id2 => 5, title => 'Perl', author => 'Ken'},
2419
+        table => 'book'
2420
+    );
2421
+
2422
+=item C<prefix>
2423
+
2424
+    prefix => 'or replace'
2425
+
2426
+prefix before table name section
2427
+
2428
+    insert or replace into book
2429
+
2430
+=item C<primary_key>
2431
+
2432
+    primary_key => 'id'
2433
+    primary_key => ['id1', 'id2']
2434
+
2435
+Primary key. This is used by C<id> option.
2436
+
2437
+=item C<query>
2438
+
2439
+Same as C<execute> method's C<query> option.
2440
+
2441
+=item C<table>
2442
+
2443
+    table => 'book'
2444
+
2445
+Table name.
2446
+
2447
+=item C<bind_type>
2448
+
2449
+Same as C<execute> method's C<bind_type> option.
2450
+
2451
+=item C<type_rule_off> EXPERIMENTAL
2452
+
2453
+Same as C<execute> method's C<type_rule_off> option.
2454
+
2455
+=item C<type_rule1_off> EXPERIMENTAL
2456
+
2457
+    type_rule1_off => 1
2458
+
2459
+Same as C<execute> method's C<type_rule1_off> option.
2460
+
2461
+=item C<type_rule2_off> EXPERIMENTAL
2462
+
2463
+    type_rule2_off => 1
2464
+
2465
+Same as C<execute> method's C<type_rule2_off> option.
2466
+
2467
+=back
2468
+
2469
+=over 4
2470
+
2471
+=head2 C<insert_param>
2472
+
2473
+    my $insert_param = $dbi->insert_param({title => 'a', age => 2});
2474
+
2475
+Create insert parameters.
2476
+
2477
+    (title, author) values (title = :title, age = :age);
2478
+
2479
+=head2 C<include_model>
2480
+
2481
+    $dbi->include_model('MyModel');
2482
+
2483
+Include models from specified namespace,
2484
+the following layout is needed to include models.
2485
+
2486
+    lib / MyModel.pm
2487
+        / MyModel / book.pm
2488
+                  / company.pm
2489
+
2490
+Name space module, extending L<DBIx::Custom::Model>.
2491
+
2492
+B<MyModel.pm>
2493
+
2494
+    package MyModel;
2495
+    use DBIx::Custom::Model -base;
2496
+    
2497
+    1;
2498
+
2499
+Model modules, extending name space module.
2500
+
2501
+B<MyModel/book.pm>
2502
+
2503
+    package MyModel::book;
2504
+    use MyModel -base;
2505
+    
2506
+    1;
2507
+
2508
+B<MyModel/company.pm>
2509
+
2510
+    package MyModel::company;
2511
+    use MyModel -base;
2512
+    
2513
+    1;
2514
+    
2515
+MyModel::book and MyModel::company is included by C<include_model>.
2516
+
2517
+You can get model object by C<model>.
2518
+
2519
+    my $book_model = $dbi->model('book');
2520
+    my $company_model = $dbi->model('company');
2521
+
2522
+See L<DBIx::Custom::Model> to know model features.
2523
+
2524
+=head2 C<map_param> EXPERIMENTAL
2525
+
2526
+    my $map_param = $dbi->map_param(
2527
+        {id => 1, authro => 'Ken', price => 1900},
2528
+        'id' => 'book.id',
2529
+        'author' => ['book.author' => sub { '%' . $_[0] . '%' }],
2530
+        'price' => [
2531
+            'book.price', {if => sub { length $_[0] }}
2532
+        ]
2533
+    );
2534
+
2535
+Map paramters to other key and value. First argument is original
2536
+parameter. this is hash reference. Rest argument is mapping.
2537
+By default, Mapping is done if the value length is not zero.
2538
+
2539
+=over 4
2540
+
2541
+=item Key mapping
2542
+
2543
+    'id' => 'book.id'
2544
+
2545
+This is only key mapping. Value is same as original one.
2546
+
2547
+    (id => 1) is mapped to ('book.id' => 1) if value length is not zero.
2548
+
2549
+=item Key and value mapping
2550
+
2551
+    'author' => ['book.author' => sub { '%' . $_[0] . '%' }]
2552
+
2553
+This is key and value mapping. Frist element of array reference
2554
+is mapped key name, second element is code reference to map the value.
2555
+
2556
+    (author => 'Ken') is mapped to ('book.author' => '%Ken%')
2557
+      if value length is not zero.
2558
+
2559
+=item Condition
2560
+
2561
+    'price' => ['book.price', {if => 'exists'}]
2562
+    'price' => ['book.price', sub { '%' . $_[0] . '%' }, {if => 'exists'}]
2563
+    'price' => ['book.price', {if => sub { defined shift }}]
2564
+
2565
+If you need condition, you can sepecify it. this is code reference
2566
+or 'exists'. By default, condition is the following one.
2567
+
2568
+    sub { defined $_[0] && length $_[0] }
2569
+
2570
+=back
2571
+
2572
+=head2 C<merge_param>
2573
+
2574
+    my $param = $dbi->merge_param({key1 => 1}, {key1 => 1, key2 => 2});
2575
+
2576
+Merge parameters.
2577
+
2578
+    {key1 => [1, 1], key2 => 2}
2579
+
2580
+=head2 C<method>
2581
+
2582
+    $dbi->method(
2583
+        update_or_insert => sub {
2584
+            my $self = shift;
2585
+            
2586
+            # Process
2587
+        },
2588
+        find_or_create   => sub {
2589
+            my $self = shift;
2590
+            
2591
+            # Process
2592
+        }
2593
+    );
2594
+
2595
+Register method. These method is called directly from L<DBIx::Custom> object.
2596
+
2597
+    $dbi->update_or_insert;
2598
+    $dbi->find_or_create;
2599
+
2600
+=head2 C<model>
2601
+
2602
+    my $model = $dbi->model('book');
2603
+
2604
+Get a L<DBIx::Custom::Model> object,
2605
+
2606
+=head2 C<mycolumn>
2607
+
2608
+    my $column = $self->mycolumn(book => ['author', 'title']);
2609
+
2610
+Create column clause for myself. The follwoing column clause is created.
2611
+
2612
+    book.author as author,
2613
+    book.title as title
2614
+
2615
+=head2 C<new>
2616
+
2617
+    my $dbi = DBIx::Custom->new(
2618
+        dsn => "dbi:mysql:database=dbname",
2619
+        user => 'ken',
2620
+        password => '!LFKD%$&',
2621
+        dbi_option => {mysql_enable_utf8 => 1}
2622
+    );
2623
+
2624
+Create a new L<DBIx::Custom> object.
2625
+
2626
+=head2 C<not_exists>
2627
+
2628
+    my $not_exists = $dbi->not_exists;
2629
+
2630
+DBIx::Custom::NotExists object, indicating the column is not exists.
2631
+This is used by C<clause> of L<DBIx::Custom::Where> .
2632
+
2633
+=head2 C<order> EXPERIMENTAL
2634
+
2635
+    my $order = $dbi->order;
2636
+
2637
+Create a new L<DBIx::Custom::Order> object.
2638
+
2639
+=head2 C<register_filter>
2640
+
2641
+    $dbi->register_filter(
2642
+        # Time::Piece object to database DATE format
2643
+        tp_to_date => sub {
2644
+            my $tp = shift;
2645
+            return $tp->strftime('%Y-%m-%d');
2646
+        },
2647
+        # database DATE format to Time::Piece object
2648
+        date_to_tp => sub {
2649
+           my $date = shift;
2650
+           return Time::Piece->strptime($date, '%Y-%m-%d');
2651
+        }
2652
+    );
2653
+    
2654
+Register filters, used by C<filter> option of many methods.
2655
+
2656
+=head2 C<type_rule> EXPERIMENTAL
2657
+
2658
+    $dbi->type_rule(
2659
+        into1 => {
2660
+            date => sub { ... },
2661
+            datetime => sub { ... }
2662
+        },
2663
+        into2 => {
2664
+            date => sub { ... },
2665
+            datetime => sub { ... }
2666
+        },
2667
+        from1 => {
2668
+            # DATE
2669
+            9 => sub { ... },
2670
+            # DATETIME or TIMESTAMP
2671
+            11 => sub { ... },
2672
+        }
2673
+        from2 => {
2674
+            # DATE
2675
+            9 => sub { ... },
2676
+            # DATETIME or TIMESTAMP
2677
+            11 => sub { ... },
2678
+        }
2679
+    );
2680
+
2681
+Filtering rule when data is send into and get from database.
2682
+This has a little complex problem.
2683
+
2684
+In C<into1> and C<into2> you can specify
2685
+type name as same as type name defined
2686
+by create table, such as C<DATETIME> or C<DATE>.
2687
+
2688
+Note that type name and data type don't contain upper case.
2689
+If these contain upper case charactor, you convert it to lower case.
2690
+
2691
+C<into2> is executed after C<into1>.
2692
+
2693
+Type rule of C<into1> and C<into2> is enabled on the following
2694
+column name.
2695
+
2696
+=over 4
2697
+
2698
+=item 1. column name
2699
+
2700
+    issue_date
2701
+    issue_datetime
2702
+
2703
+This need C<table> option in each method.
2704
+
2705
+=item 2. table name and column name, separator is dot
2706
+
2707
+    book.issue_date
2708
+    book.issue_datetime
2709
+
2710
+=back
2711
+
2712
+You get all type name used in database by C<available_type_name>.
2713
+
2714
+    print $dbi->available_type_name;
2715
+
2716
+In C<from1> and C<from2> you specify data type, not type name.
2717
+C<from2> is executed after C<from1>.
2718
+You get all data type by C<available_data_type>.
2719
+
2720
+    print $dbi->available_data_type;
2721
+
2722
+You can also specify multiple types at once.
2723
+
2724
+    $dbi->type_rule(
2725
+        into1 => [
2726
+            [qw/DATE DATETIME/] => sub { ... },
2727
+        ],
2728
+    );
2729
+
2730
+=head2 C<select>
2731
+
2732
+    my $result = $dbi->select(
2733
+        table  => 'book',
2734
+        column => ['author', 'title'],
2735
+        where  => {author => 'Ken'},
2736
+    );
2737
+    
2738
+Execute select statement.
2739
+
2740
+The following opitons are available.
2741
+
2742
+=over 4
2743
+
2744
+=item C<append>
2745
+
2746
+    append => 'order by title'
2747
+
2748
+Append statement to last of SQL.
2749
+    
2750
+=item C<column>
2751
+    
2752
+    column => 'author'
2753
+    column => ['author', 'title']
2754
+
2755
+Column clause.
2756
+    
2757
+if C<column> is not specified, '*' is set.
2758
+
2759
+    column => '*'
2760
+
2761
+You can specify hash of array reference.
2762
+
2763
+    column => [
2764
+        {book => [qw/author title/]},
2765
+        {person => [qw/name age/]}
2766
+    ]
2767
+
2768
+This is expanded to the following one by using C<colomn> method.
2769
+
2770
+    book.author as "book.author",
2771
+    book.title as "book.title",
2772
+    person.name as "person.name",
2773
+    person.age as "person.age"
2774
+
2775
+You can specify array of array reference, first argument is
2776
+column name, second argument is alias.
2777
+
2778
+    column => [
2779
+        ['date(book.register_datetime)' => 'book.register_date']
2780
+    ];
2781
+
2782
+Alias is quoted properly and joined.
2783
+
2784
+    date(book.register_datetime) as "book.register_date"
2785
+
2786
+=item C<filter>
2787
+
2788
+Same as C<execute> method's C<filter> option.
2789
+
2790
+=item C<id>
2791
+
2792
+    id => 4
2793
+    id => [4, 5]
2794
+
2795
+ID corresponding to C<primary_key>.
2796
+You can select rows by C<id> and C<primary_key>.
2797
+
2798
+    $dbi->select(
2799
+        parimary_key => ['id1', 'id2'],
2800
+        id => [4, 5],
2801
+        table => 'book'
2802
+    );
2803
+
2804
+The above is same as the followin one.
2805
+
2806
+    $dbi->select(
2807
+        where => {id1 => 4, id2 => 5},
2808
+        table => 'book'
2809
+    );
2810
+    
2811
+=item C<param> EXPERIMETNAL
2812
+
2813
+    param => {'table2.key3' => 5}
2814
+
2815
+Parameter shown before where clause.
2816
+    
2817
+For example, if you want to contain tag in join clause, 
2818
+you can pass parameter by C<param> option.
2819
+
2820
+    join  => ['inner join (select * from table2 where table2.key3 = :table2.key3)' . 
2821
+              ' as table2 on table1.key1 = table2.key1']
2822
+
2823
+=itme C<prefix>
2824
+
2825
+    prefix => 'SQL_CALC_FOUND_ROWS'
2826
+
2827
+Prefix of column cluase
2828
+
2829
+    select SQL_CALC_FOUND_ROWS title, author from book;
2830
+
2831
+=item C<join>
2832
+
2833
+    join => [
2834
+        'left outer join company on book.company_id = company_id',
2835
+        'left outer join location on company.location_id = location.id'
2836
+    ]
2837
+        
2838
+Join clause. If column cluase or where clause contain table name like "company.name",
2839
+join clausees needed when SQL is created is used automatically.
2840
+
2841
+    $dbi->select(
2842
+        table => 'book',
2843
+        column => ['company.location_id as location_id'],
2844
+        where => {'company.name' => 'Orange'},
2845
+        join => [
2846
+            'left outer join company on book.company_id = company.id',
2847
+            'left outer join location on company.location_id = location.id'
2848
+        ]
2849
+    );
2850
+
2851
+In above select, column and where clause contain "company" table,
2852
+the following SQL is created
2853
+
2854
+    select company.location_id as location_id
2855
+    from book
2856
+      left outer join company on book.company_id = company.id
2857
+    where company.name = ?;
2858
+
2859
+You can specify two table by yourself. This is useful when join parser can't parse
2860
+the join clause correctly. This is EXPERIMENTAL.
2861
+
2862
+    $dbi->select(
2863
+        table => 'book',
2864
+        column => ['company.location_id as location_id'],
2865
+        where => {'company.name' => 'Orange'},
2866
+        join => [
2867
+            {
2868
+                clause => 'left outer join location on company.location_id = location.id',
2869
+                table => ['company', 'location']
2870
+            }
2871
+        ]
2872
+    );
2873
+
2874
+=item C<primary_key>
2875
+
2876
+    primary_key => 'id'
2877
+    primary_key => ['id1', 'id2']
2878
+
2879
+Primary key. This is used by C<id> option.
2880
+
2881
+=item C<query>
2882
+
2883
+Same as C<execute> method's C<query> option.
2884
+
2885
+=item C<bind_type>
2886
+
2887
+Same as C<execute> method's C<bind_type> option.
2888
+
2889
+=item C<table>
2890
+
2891
+    table => 'book'
2892
+
2893
+Table name.
2894
+
2895
+=item C<type_rule_off> EXPERIMENTAL
2896
+
2897
+Same as C<execute> method's C<type_rule_off> option.
2898
+
2899
+=item C<type_rule1_off> EXPERIMENTAL
2900
+
2901
+    type_rule1_off => 1
2902
+
2903
+Same as C<execute> method's C<type_rule1_off> option.
2904
+
2905
+=item C<type_rule2_off> EXPERIMENTAL
2906
+
2907
+    type_rule2_off => 1
2908
+
2909
+Same as C<execute> method's C<type_rule2_off> option.
2910
+
2911
+=item C<where>
2912
+    
2913
+    # Hash refrence
2914
+    where => {author => 'Ken', 'title' => 'Perl'}
2915
+    
2916
+    # DBIx::Custom::Where object
2917
+    where => $dbi->where(
2918
+        clause => ['and', 'author = :author', 'title like :title'],
2919
+        param  => {author => 'Ken', title => '%Perl%'}
2920
+    );
2921
+    
2922
+    # Array reference 1 (array reference, hash referenc). same as above
2923
+    where => [
2924
+        ['and', 'author = :author', 'title like :title'],
2925
+        {author => 'Ken', title => '%Perl%'}
2926
+    ];    
2927
+    
2928
+    # Array reference 2 (String, hash reference)
2929
+    where => [
2930
+        'title like :title',
2931
+        {title => '%Perl%'}
2932
+    ]
2933
+    
2934
+    # String
2935
+    where => 'title is null'
2936
+
2937
+Where clause.
2938
+    
2939
+=item C<wrap> EXPERIMENTAL
2940
+
2941
+Wrap statement. This is array reference.
2942
+
2943
+    $dbi->select(wrap => ['select * from (', ') as t where ROWNUM < 10']);
2944
+
2945
+This option is for Oracle and SQL Server paging process.
2946
+
2947
+=back
2948
+
2949
+=head2 C<update>
2950
+
2951
+    $dbi->update({title => 'Perl'}, table  => 'book', where  => {id => 4});
2952
+
2953
+Execute update statement. First argument is update row data.
2954
+
2955
+If you want to set constant value to row data, use scalar reference
2956
+as parameter value.
2957
+
2958
+    {date => \"NOW()"}
2959
+
2960
+The following opitons are available.
2961
+
2962
+=over 4
2963
+
2964
+=item C<append>
2965
+
2966
+Same as C<select> method's C<append> option.
2967
+
2968
+=item C<filter>
2969
+
2970
+Same as C<execute> method's C<filter> option.
2971
+
2972
+=item C<id>
2973
+
2974
+    id => 4
2975
+    id => [4, 5]
2976
+
2977
+ID corresponding to C<primary_key>.
2978
+You can update rows by C<id> and C<primary_key>.
2979
+
2980
+    $dbi->update(
2981
+        {title => 'Perl', author => 'Ken'}
2982
+        parimary_key => ['id1', 'id2'],
2983
+        id => [4, 5],
2984
+        table => 'book'
2985
+    );
2986
+
2987
+The above is same as the followin one.
2988
+
2989
+    $dbi->update(
2990
+        {title => 'Perl', author => 'Ken'}
2991
+        where => {id1 => 4, id2 => 5},
2992
+        table => 'book'
2993
+    );
2994
+
2995
+=item C<prefix>
2996
+
2997
+    prefix => 'or replace'
2998
+
2999
+prefix before table name section
3000
+
3001
+    update or replace book
3002
+
3003
+=item C<primary_key>
3004
+
3005
+    primary_key => 'id'
3006
+    primary_key => ['id1', 'id2']
3007
+
3008
+Primary key. This is used by C<id> option.
3009
+
3010
+=item C<query>
3011
+
3012
+Same as C<execute> method's C<query> option.
3013
+
3014
+=item C<table>
3015
+
3016
+    table => 'book'
3017
+
3018
+Table name.
3019
+
3020
+=item C<where>
3021
+
3022
+Same as C<select> method's C<where> option.
3023
+
3024
+=item C<bind_type>
3025
+
3026
+Same as C<execute> method's C<bind_type> option.
3027
+
3028
+=item C<type_rule_off> EXPERIMENTAL
3029
+
3030
+Same as C<execute> method's C<type_rule_off> option.
3031
+
3032
+=item C<type_rule1_off> EXPERIMENTAL
3033
+
3034
+    type_rule1_off => 1
3035
+
3036
+Same as C<execute> method's C<type_rule1_off> option.
3037
+
3038
+=item C<type_rule2_off> EXPERIMENTAL
3039
+
3040
+    type_rule2_off => 1
3041
+
3042
+Same as C<execute> method's C<type_rule2_off> option.
3043
+
3044
+=back
3045
+
3046
+=head2 C<update_all>
3047
+
3048
+    $dbi->update_all({title => 'Perl'}, table => 'book', );
3049
+
3050
+Execute update statement for all rows.
3051
+Options is same as C<update> method.
3052
+
3053
+=head2 C<update_param>
3054
+
3055
+    my $update_param = $dbi->update_param({title => 'a', age => 2});
3056
+
3057
+Create update parameter tag.
3058
+
3059
+    set title = :title, author = :author
3060
+
3061
+=head2 C<where>
3062
+
3063
+    my $where = $dbi->where(
3064
+        clause => ['and', 'title = :title', 'author = :author'],
3065
+        param => {title => 'Perl', author => 'Ken'}
3066
+    );
3067
+
3068
+Create a new L<DBIx::Custom::Where> object.
3069
+
3070
+=head2 C<setup_model>
3071
+
3072
+    $dbi->setup_model;
3073
+
3074
+Setup all model objects.
3075
+C<columns> of model object is automatically set, parsing database information.
3076
+
3077
+=head1 ENVIRONMENT VARIABLE
3078
+
3079
+=head2 C<DBIX_CUSTOM_DEBUG>
3080
+
3081
+If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
3082
+executed SQL and bind values are printed to STDERR.
3083
+
3084
+=head2 C<DBIX_CUSTOM_DEBUG_ENCODING>
3085
+
3086
+DEBUG output encoding. Default to UTF-8.
3087
+
3088
+=head1 DEPRECATED FUNCTIONALITIES
3089
+
3090
+L<DBIx::Custom>
3091
+
3092
+    # Attribute methods
3093
+    data_source # will be removed at 2017/1/1
3094
+    dbi_options # will be removed at 2017/1/1
3095
+    filter_check # will be removed at 2017/1/1
3096
+    reserved_word_quote # will be removed at 2017/1/1
3097
+    cache_method # will be removed at 2017/1/1
3098
+    
3099
+    # Methods
3100
+    create_query # will be removed at 2017/1/1
3101
+    apply_filter # will be removed at 2017/1/1
3102
+    select_at # will be removed at 2017/1/1
3103
+    delete_at # will be removed at 2017/1/1
3104
+    update_at # will be removed at 2017/1/1
3105
+    insert_at # will be removed at 2017/1/1
3106
+    register_tag # will be removed at 2017/1/1
3107
+    default_bind_filter # will be removed at 2017/1/1
3108
+    default_fetch_filter # will be removed at 2017/1/1
3109
+    insert_param_tag # will be removed at 2017/1/1
3110
+    register_tag_processor # will be removed at 2017/1/1
3111
+    update_param_tag # will be removed at 2017/1/1
3112
+    
3113
+    # Options
3114
+    select method relation option # will be removed at 2017/1/1
3115
+    select method param option # will be removed at 2017/1/1
3116
+    select method column option [COLUMN, as => ALIAS] format
3117
+      # will be removed at 2017/1/1
3118
+    
3119
+    # Others
3120
+    execute("select * from {= title}"); # execute method's
3121
+                                        # tag parsing functionality
3122
+                                        # will be removed at 2017/1/1
3123
+    Query caching # will be removed at 2017/1/1
3124
+
3125
+L<DBIx::Custom::Model>
3126
+
3127
+    # Attribute methods
3128
+    filter # will be removed at 2017/1/1
3129
+    name # will be removed at 2017/1/1
3130
+    type # will be removed at 2017/1/1
3131
+
3132
+L<DBIx::Custom::Query>
3133
+    
3134
+    # Attribute methods
3135
+    default_filter # will be removed at 2017/1/1
3136
+    table # will be removed at 2017/1/1
3137
+    filters # will be removed at 2017/1/1
3138
+    
3139
+    # Methods
3140
+    filter # will be removed at 2017/1/1
3141
+
3142
+L<DBIx::Custom::QueryBuilder>
3143
+    
3144
+    # Attribute methods
3145
+    tags # will be removed at 2017/1/1
3146
+    tag_processors # will be removed at 2017/1/1
3147
+    
3148
+    # Methods
3149
+    register_tag # will be removed at 2017/1/1
3150
+    register_tag_processor # will be removed at 2017/1/1
3151
+    
3152
+    # Others
3153
+    build_query("select * from {= title}"); # tag parsing functionality
3154
+                                            # will be removed at 2017/1/1
3155
+
3156
+L<DBIx::Custom::Result>
3157
+    
3158
+    # Attribute methods
3159
+    filter_check # will be removed at 2017/1/1
3160
+    
3161
+    # Methods
3162
+    end_filter # will be removed at 2017/1/1
3163
+    remove_end_filter # will be removed at 2017/1/1
3164
+    remove_filter # will be removed at 2017/1/1
3165
+    default_filter # will be removed at 2017/1/1
3166
+
3167
+L<DBIx::Custom::Tag>
3168
+
3169
+    This module is DEPRECATED! # will be removed at 2017/1/1
3170
+
3171
+=head1 BACKWORD COMPATIBLE POLICY
3172
+
3173
+If a functionality is DEPRECATED, you can know it by DEPRECATED warnings
3174
+except for attribute method.
3175
+You can check all DEPRECATED functionalities by document.
3176
+DEPRECATED functionality is removed after five years,
3177
+but if at least one person use the functionality and tell me that thing
3178
+I extend one year each time he tell me it.
3179
+
3180
+EXPERIMENTAL functionality will be changed without warnings.
3181
+
3182
+This policy was changed at 2011/6/28
3183
+
3184
+=head1 BUGS
3185
+
3186
+Please tell me bugs if found.
3187
+
3188
+C<< <kimoto.yuki at gmail.com> >>
3189
+
3190
+L<http://github.com/yuki-kimoto/DBIx-Custom>
3191
+
3192
+=head1 AUTHOR
3193
+
3194
+Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
3195
+
3196
+=head1 COPYRIGHT & LICENSE
3197
+
3198
+Copyright 2009-2011 Yuki Kimoto, all rights reserved.
3199
+
3200
+This program is free software; you can redistribute it and/or modify it
3201
+under the same terms as Perl itself.
3202
+
3203
+=cut
+603
DBIx-Custom-0.1711/lib/DBIx/Custom/Guide.pod
... ...
@@ -0,0 +1,603 @@
1
+=encoding utf8
2
+
3
+=head1 NAME
4
+
5
+DBIx::Custom::Guide - DBIx::Custom Guide
6
+
7
+=head1 FEATURES
8
+
9
+L<DBIx::Custom> is the wrapper class of L<DBI> to execute SQL easily.
10
+This module have the following features.
11
+
12
+=over 4
13
+
14
+=item * Execute INSERT, UPDATE, DELETE, SELECT statement easily
15
+
16
+=item * You can specify bind values by hash reference
17
+
18
+=item * Filtering by data type. and you can set filter to any column
19
+
20
+=item * Creating where clause and order by clause flexibly
21
+
22
+=item * Support model
23
+
24
+=back
25
+
26
+=head1 GUIDE
27
+
28
+=head2 Connect to database
29
+
30
+    use DBIx::Custom;
31
+    my $dbi = DBIx::Custom->connect(
32
+        dsn => "dbi:mysql:database=bookshop",
33
+        user => 'ken',
34
+        password => '!LFKD%$&',
35
+        dbi_option => {mysql_enable_utf8 => 1}
36
+    );
37
+
38
+You can connect to database by C<connect> method.
39
+C<dsn> is data source name, C<user> is user name, C<password> is password.
40
+
41
+C<dbi_option> is L<DBI> option.
42
+By default, the following option is set.
43
+Exeption is thrown when fatal error occur and commit mode is auto commit.
44
+
45
+    {
46
+        RaiseError  =>  1
47
+        PrintError  =>  0
48
+        AutoCommit  =>  1
49
+    }
50
+
51
+=head2 Execute query
52
+
53
+=head3 Insert Statement : C<insert>
54
+
55
+If you want to execute insert statement, use C<insert> method.
56
+
57
+    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
58
+
59
+First argument is insert row data, C<table>  is table name.
60
+
61
+=head3 Update Statement : C<update>
62
+
63
+If you want to execute update stateimuse, use C<update> method.
64
+
65
+    $dbi->update(
66
+        {title => 'Perl', author => 'Ken'},
67
+        table  => 'book', 
68
+        where  => {id => 5}
69
+    );
70
+
71
+First argument is update row data, C<table> is table name, C<where> is condition.
72
+
73
+Note that you can't execute C<update> method without C<where>.
74
+If you want to update all rows, use update_all.
75
+
76
+    $dbi->update_all({title => 'Perl', author => 'Ken'}, table  => 'book');
77
+
78
+=head3 Delete Statement : C<delete>
79
+
80
+If you want to execute delete statement, use C<delete> method.
81
+
82
+    $dbi->delete(table  => 'book', where  => {author => 'Ken'});
83
+
84
+C<table> is table name, C<where> is condition.
85
+
86
+Note that you can't execute C<delete> method without C<where>.
87
+If you want to delete all rows, use C<delete_all> method.
88
+
89
+    $dbi->delete_all(table  => 'book');
90
+
91
+=head3 Select Statement : C<select>
92
+
93
+If you want to execute select statement, use C<select> method.
94
+
95
+    my $result = $dbi->select(table => 'book');
96
+
97
+Return value is L<DBIx::Custom::Result> object.
98
+You can fetch rows by C<fetch> method.
99
+
100
+    while (my $row = $result->fetch) {
101
+        my $title  = $row->[0];
102
+        my $author = $row->[1];
103
+    }
104
+
105
+See also L<Fetch row/"Fetch row"> about L<DBIx::Custom::Result>.
106
+
107
+You can specify column names by C<column> option
108
+and condition by C<where> option.
109
+
110
+    my $result = $dbi->select(
111
+        table  => 'book',
112
+        column => ['author',  'title'],
113
+        where  => {author => 'Ken'}
114
+    );
115
+
116
+You can specify join clause by C<join> option.
117
+
118
+    my $result = $dbi->select(
119
+        table  => 'book',
120
+        column => ['company.name as company_name']
121
+        where  => {'book.name' => 'Perl'},
122
+        join   => ['left outer join company on book.company_id = company.id]
123
+    );
124
+
125
+Note that join clause is joined only when C<where> or C<column> option contains table name,
126
+such as book.name.
127
+
128
+You can append statement to the end of whole statement by C<append> option.
129
+
130
+    my $result = $dbi->select(
131
+        table  => 'book',
132
+        where  => {author => 'Ken'},
133
+        append => 'for update',
134
+    );
135
+
136
+=head3 C<execute>
137
+
138
+If you want to execute SQL, use C<execute> method.
139
+
140
+    $dbi->execute("select * from book;");
141
+
142
+You can specify named placeholder.
143
+
144
+    $dbi->execute(
145
+        "select * from book title = :title and author = :author;"
146
+        {title => 'Perl', author => 'Ken'}
147
+    );
148
+
149
+:title and :author is named placeholder, which is replaced to placeholers.
150
+
151
+    select * from book title = ? and author = ?;
152
+
153
+=head3 C<dbh>
154
+
155
+    my $dbh = $dbi->dbh;
156
+
157
+Get get database handle object of L<DBI>.
158
+
159
+=head3 C<DBI> methods
160
+
161
+    $dbi->do(...);
162
+    $dbi->begin_work;
163
+
164
+You can call all methods of L<DBI> from L<DBIx::Custom> object.
165
+
166
+=head2 Fetch Rows
167
+
168
+C<select> method return value is L<DBIx::Custom::Result> object.
169
+You can fetch a row or rows by various methods.
170
+
171
+=head3 Fetch a row (array) : C<fetch>
172
+
173
+    my $row = $result->fetch;
174
+
175
+C<fetch> method fetch a row and put it into array reference.
176
+You can continue to fetch 
177
+
178
+    while (my $row = $result->fetch) {
179
+        my $title  = $row->[0];
180
+        my $author = $row->[1];
181
+    }
182
+
183
+=head3 Fetch only first row (array) : C<fetch_first>
184
+
185
+    my $row = $result->fetch_first;
186
+
187
+C<fetch_first> fetch a only first row and finish statment handle,
188
+and put it into array refrence.
189
+
190
+=head3 Fetch all rows (array) : C<fetch_all>
191
+
192
+    my $rows = $result->fetch_all;
193
+
194
+C<fetch_all> fetch all rows and put them into array of array reference.
195
+
196
+=head3 Fetch a row (hash) : C<fetch_hash>
197
+
198
+    my $row = $result->fetch_hash;
199
+
200
+C<fetch_hash> fetch a row and put it into hash reference.
201
+You can fetch a row while row exists.
202
+
203
+    while (my $row = $result->fetch_hash) {
204
+        my $title  = $row->{title};
205
+        my $author = $row->{author};
206
+    }
207
+
208
+=head3 Fetch only a first row (hash) : C<fetch_hash_first>
209
+
210
+    my $row = $result->fetch_hash_first;
211
+
212
+C<fetch_hash_first> fetch only a first row and finish statement handle,
213
+and put them into hash refrence.
214
+
215
+C<one> is C<fetch_hash_first> synonym to save word typing.
216
+
217
+    my $row = $result->one;
218
+
219
+=head3 Fetch all rows (hash) : C<fetch_hash_all>
220
+
221
+    my $rows = $result->fetch_hash_all;
222
+
223
+C<fetch_hash_all> fetch all rows and put them into array of hash reference.
224
+
225
+=head3 Statement Handle : C<sth>
226
+
227
+    my $sth = $result->sth;
228
+
229
+If you want to get statment handle, use <sth> method.
230
+
231
+=head2 Named placeholder
232
+
233
+=head3 Basic of Parameter
234
+
235
+You can embedd named placeholder into SQL.
236
+
237
+    select * from book where title = :title and author like :author;
238
+
239
+:title and :author is named placeholder
240
+
241
+Named placeholder is replaced by place holder.
242
+
243
+    select * from book where title = ? and author like ?;
244
+
245
+use C<execute> to execute SQL.
246
+
247
+    my $sql = "select * from book where title = :title and author like :author;"
248
+    $dbi->execute($sql, {title => 'Perl', author => '%Ken%'});
249
+
250
+You can specify C<filter> at C<execute>.
251
+
252
+    $dbi->execute($sql, {title => 'Perl', author => '%Ken%'}
253
+                  filter => {title => 'to_something');
254
+
255
+=head3 Manipulate same name's columns
256
+
257
+It is ok if there are same name's columns.
258
+Let's think two date comparison.
259
+
260
+    my $sql = "select * from table where date > :date and date < :date;";
261
+
262
+In this case, You specify parameter values as array reference.
263
+
264
+    my $dbi->execute($sql, {date => ['2010-10-01', '2012-02-10']});
265
+
266
+=head2 Create where clause
267
+
268
+=head3 Dinamically create where clause : where
269
+
270
+You want to search multiple conditions in many times.
271
+Let's think the following three cases.
272
+
273
+Case1: Search only C<title>
274
+
275
+    where title = :title
276
+
277
+Case2: Search only C<author>
278
+
279
+    where author = :author
280
+
281
+Case3: Search C<title> and C<author>
282
+
283
+    where title = :title and author = :author
284
+
285
+L<DBIx::Custom> support dinamic where clause creating.
286
+At first, create L<DBIx::Custom::Where> object by C<where>.
287
+
288
+    my $where = $dbi->where;
289
+
290
+Set clause by C<clause>
291
+
292
+    $where->clause(
293
+        ['and', 'title = :title, 'author = :author']
294
+    );
295
+
296
+C<clause> is the following format.
297
+
298
+    ['or' or 'and', PART1, PART1, PART1]
299
+
300
+First argument is 'or' or 'and'.
301
+Later than first argument are part which contains named placeholder.
302
+
303
+You can write more complex format.
304
+
305
+    ['and', 
306
+      'title = :title', 
307
+      ['or', 'author = :author', 'date like :date']
308
+    ]
309
+
310
+This mean "title = :title and ( author = :author or date like :date )".
311
+
312
+After setting C<clause>, set C<param>.
313
+    
314
+    $where->param({title => 'Perl'});
315
+
316
+In this example, parameter contains only title.
317
+
318
+If you execute C<string_to>, you can get where clause
319
+which contain only named placeholder.
320
+
321
+    my $where_clause = $where->to_string;
322
+
323
+Parameter name is only title, the following where clause is created.
324
+
325
+    where title = :title
326
+
327
+You can also create where clause by stringification.
328
+
329
+    my $where_clause = "$where";
330
+
331
+This is useful to embbed it into SQL. 
332
+
333
+=head3 In case where clause contains same name columns
334
+
335
+Even if same name parameters exists, you can create where clause.
336
+Let's think that there are starting date and ending date.
337
+
338
+    my $param = {start_date => '2010-11-15', end_date => '2011-11-21'};
339
+
340
+In this case, you set parameter value as array reference.
341
+
342
+    my $p = {date => ['2010-11-15', '2011-11-21']};
343
+
344
+You can embbed these values into same name parameters.
345
+
346
+    $where->clause(
347
+        ['and', 'date > :date', 'date < :date']
348
+    );
349
+    $where->param($p);
350
+
351
+If starting date isn't exists, create the following parameter.
352
+
353
+    my $p = {date => [$dbi->not_exists, '2011-11-21']};
354
+
355
+You can get DBIx::Custom::NotExists object by C<not_exists>
356
+This mean correnspondinf value isn't exists.
357
+
358
+If ending date isn't exists, create the following parameter.
359
+
360
+    my $p = {date => ['2010-11-15']};
361
+
362
+If both date isn't exists, create the following parameter.
363
+
364
+    my $p = {date => []};
365
+
366
+This logic is a little difficut. See the following ones.
367
+
368
+    my @date;
369
+    push @date, exists $param->{start_date} ? $param->{start_date}
370
+                                            : $dbi->not_exists;
371
+    push @date, $param->{end_date} if exists $param->{end_date};
372
+    my $p = {date => \@date};
373
+
374
+=head3 With C<select>
375
+
376
+You can pass L<DBIx::Custom::Where> object to C<where> of C<select>.
377
+    
378
+    my $where = $dbi->where;
379
+    $where->clause(['and', 'title = :title', 'author = :author']);
380
+    $where->param({title => 'Perl'});
381
+    my $result = $dbi->select(table => 'book', where => $where);
382
+
383
+You can also pass it to C<where> of C<update>AC<delete>
384
+
385
+=head3 With C<execute>
386
+
387
+L<DBIx::Custom::Where> object is embedded into SQL.
388
+
389
+    my $where = $dbi->where;
390
+    $where->clause(['and', 'title = :title', 'author = :author']);
391
+    $where->param({title => 'Perl'});
392
+
393
+    my $sql = <<"EOS";
394
+    select * from book;
395
+    $where
396
+    EOS
397
+
398
+    $dbi->execute($sql, $param, table => 'book');
399
+
400
+=head2 Filtering
401
+
402
+=head3 Register filter : C<register_filter>
403
+
404
+If you want to register filter, use C<register_filter>.
405
+
406
+    $dbi->register_filter(
407
+        # Time::Piece object to DATE format
408
+        tp_to_date => sub {
409
+            my $date = shift;
410
+            return $tp->strftime('%Y-%m-%d');
411
+        },
412
+        
413
+        # DATE to Time::Piece object
414
+        date_to_tp => sub {
415
+            my $date = shift;
416
+            return Time::Piece->strptime($date, '%Y-%m-%d');
417
+        },
418
+    );
419
+
420
+=head3 Filter before sending data into database : C<filter> option
421
+
422
+If you filter sending data, use C<filter> option.
423
+
424
+    $dbi->execute(
425
+        'insert into book (date) values (:date)',
426
+        {date => $tp},
427
+        filter => {date => 'tp_to_date'}
428
+    );
429
+
430
+You can use C<filter> option in C<insert>, C<update>, C<delete>, C<select> method.
431
+
432
+    $dbi->insert(
433
+        {date => $tp},
434
+        table => 'book',
435
+        filter => {date => 'tp_to_date'}
436
+    );
437
+
438
+=head3 Filter after fetching data from database.
439
+
440
+If you filter fetch data, use L<DBIx::Custom::Result>'s C<filter> method.
441
+
442
+    my $result = $dbi->select(column => 'date', table => 'book');
443
+    $result->filter(date => 'date_to_tp');
444
+    my $row = $result->one;
445
+
446
+=head2 7. Model
447
+
448
+=head3 Model
449
+
450
+you can define model extending L<DBIx::Custom::Model>
451
+to improve source code view.
452
+
453
+At first, you create basic model class extending <DBIx::Custom::Model>.
454
+Each L<DBIx::Custom> class inherit L<Object::Simple>.
455
+so you can inherit the following way.
456
+
457
+    package MyModel;
458
+    use DBIx::Custom::Model -base;
459
+
460
+Next, you create each model classes.
461
+
462
+MyModel::book
463
+
464
+    package MyModel::book;
465
+    use MyModel -base;
466
+    
467
+    sub insert { ... }
468
+    sub list { ... }
469
+
470
+MyModel::company
471
+
472
+    package MyModel::company;
473
+    use MyModel -base;
474
+    
475
+    sub insert { ... }
476
+    sub list { ... }
477
+
478
+The follwoing modules location is needed.
479
+
480
+    MyModel.pm
481
+    MyModel / book.pm
482
+            / company.pm
483
+
484
+You can include these models by C<include_model>
485
+
486
+    $dbi->include_model('MyModel');
487
+
488
+First argument is name space of model.
489
+
490
+You can use model like this.
491
+
492
+    my $result = $dbi->model('book')->list;
493
+
494
+In mode, You can use such as methods,
495
+C<insert>, C<update>, C<update_all>,
496
+C<delete>, C<delete_all>, C<select>
497
+without C<table> option.
498
+
499
+    $dbi->model('book')->insert($param);
500
+
501
+Model is L<DBIx::Custom::Model>.
502
+
503
+If you need table nameAyou can get it by C<table>.
504
+
505
+    my $table = $model->table;
506
+
507
+You can get L<DBIx::Custom>.
508
+
509
+    my $dbi = $model->dbi;
510
+
511
+You can also call all methods of L<DBIx::Custom> and L<DBI>. 
512
+
513
+    # DBIx::Custom method
514
+    $model->execute($sql);
515
+    
516
+    # DBI method
517
+    $model->begin_work;
518
+    $model->commit;
519
+
520
+If you want to get all models, you can get them by keys of C<models>.
521
+
522
+    my @models = keys %{$self->models};
523
+
524
+You can set primary key to model.
525
+
526
+   $model->primary_key(['id', 'number_id']);
527
+
528
+Primary key is used by C<insert>, C<update>, C<delete>,
529
+and C<select> methods.
530
+
531
+You can set column names
532
+
533
+    $model->columns(['id', 'number_id']);
534
+
535
+Column names is automarically set by C<setup_model>.
536
+This method is needed to be call after C<include_model>.
537
+
538
+    $dbi->setup_model;
539
+
540
+You can set C<join>
541
+
542
+    $model->join(['left outer join company on book.company_id = company.id']);
543
+
544
+C<join> is used by C<select> method.
545
+
546
+=head2 Create column clause automatically : mycolumn, column
547
+
548
+To create column clause automatically, use C<mycolumn>.
549
+Valude of C<table> and C<columns> is used.
550
+
551
+    my $mycolumns = $model->mycolumn;
552
+
553
+If C<table> is 'book'AC<column> is ['id', 'name'],
554
+the following clause is created.
555
+
556
+    book.id as id, book.name as name
557
+
558
+These column name is for removing column name ambiguities.
559
+
560
+You can create column clause from columns of other table.
561
+
562
+    my $columns = $model->column('company');
563
+
564
+If C<table> is "company", C<column> return ['id', 'name'],
565
+the following clause is created.
566
+
567
+    company.id as "company.id", company.name as "company.name"
568
+
569
+=head2 Model Examples
570
+
571
+Model examples
572
+
573
+    package MyDBI;
574
+    use DBIx::Custom -base;
575
+    
576
+    sub connect {
577
+        my $self = shift->SUPER::connect(@_);
578
+        
579
+        $self->include_model(
580
+            MyModel => [
581
+                'book',
582
+                'company'
583
+            ]
584
+        );
585
+    }
586
+    
587
+    package MyModel::book;
588
+    use DBIx::Custom::Model -base;
589
+    
590
+    has primary_key => sub { ['id'] };
591
+    
592
+    sub insert { ... }
593
+    sub list { ... }
594
+    
595
+    package MyModel::company;
596
+    use DBIx::Custom::Model -base;
597
+
598
+    has primary_key => sub { ['id'] };
599
+    
600
+    sub insert { ... }
601
+    sub list { ... }
602
+
603
+=cut
+13
DBIx-Custom-0.1711/lib/DBIx/Custom/Guide/Ja.pod
... ...
@@ -0,0 +1,13 @@
1
+=encoding utf8
2
+
3
+=head1 NAME
4
+
5
+DBIx::Custom::Guide - DBIx::Customガイド
6
+
7
+=head1 LINK
8
+
9
+ドキュメントは以下のリンクに移動しました。
10
+
11
+L<http://d.hatena.ne.jp/perlcodesample/20110401/1305597081>
12
+
13
+=cut
+247
DBIx-Custom-0.1711/lib/DBIx/Custom/Model.pm
... ...
@@ -0,0 +1,247 @@
1
+package DBIx::Custom::Model;
2
+use Object::Simple -base;
3
+
4
+use Carp 'croak';
5
+use DBIx::Custom::Util '_subname';
6
+
7
+# Carp trust relationship
8
+push @DBIx::Custom::CARP_NOT, __PACKAGE__;
9
+
10
+has [qw/dbi table/],
11
+    bind_type => sub { [] },
12
+    columns => sub { [] },
13
+    join => sub { [] },
14
+    primary_key => sub { [] };
15
+
16
+our $AUTOLOAD;
17
+
18
+sub AUTOLOAD {
19
+    my $self = shift;
20
+
21
+    # Method name
22
+    my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
23
+
24
+    # Method
25
+    $self->{_methods} ||= {};
26
+    if (my $method = $self->{_methods}->{$mname}) {
27
+        return $self->$method(@_)
28
+    }
29
+    elsif (my $dbi_method = $self->dbi->can($mname)) {
30
+        $self->dbi->$dbi_method(@_);
31
+    }
32
+    elsif ($self->{dbh} && (my $dbh_method = $self->dbh->can($mname))) {
33
+        $self->dbi->dbh->$dbh_method(@_);
34
+    }
35
+    else {
36
+        croak qq{Can't locate object method "$mname" via "$package" }
37
+            . _subname;
38
+    }
39
+}
40
+
41
+my @methods = qw/insert insert_at update update_at update_all
42
+                 delete delete_at delete_all select select_at/;
43
+foreach my $method (@methods) {
44
+
45
+    my $code = sub {
46
+        my $self = shift;
47
+
48
+        my @args = (
49
+            table => $self->table,
50
+            bind_type => $self->bind_type,
51
+            primary_key => $self->primary_key,
52
+            type => $self->type, # DEPRECATED!
53
+        );
54
+        push @args, (join => $self->join) if $method =~ /^select/;
55
+        unshift @args, shift if @_ % 2;
56
+        
57
+        $self->dbi->$method(@args, @_);
58
+    };
59
+    
60
+    no strict 'refs';
61
+    my $class = __PACKAGE__;
62
+    *{"${class}::$method"} = $code;
63
+}
64
+
65
+sub DESTROY { }
66
+
67
+sub method {
68
+    my $self = shift;
69
+    
70
+    # Merge
71
+    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
72
+    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
73
+    
74
+    return $self;
75
+}
76
+
77
+sub mycolumn {
78
+    my $self = shift;
79
+    my $table = shift unless ref $_[0];
80
+    my $columns = shift;
81
+    
82
+    $table ||= $self->table || '';
83
+    $columns ||= $self->columns;
84
+    
85
+    return $self->dbi->mycolumn($table, $columns);
86
+}
87
+
88
+sub new {
89
+    my $self = shift->SUPER::new(@_);
90
+    
91
+    # Check attribute names
92
+    my @attrs = keys %$self;
93
+    foreach my $attr (@attrs) {
94
+        croak qq{"$attr" is invalid attribute name } . _subname
95
+          unless $self->can($attr);
96
+    }
97
+    
98
+    return $self;
99
+}
100
+
101
+# DEPRECATED!
102
+has 'filter';
103
+has 'name';
104
+has type => sub { [] };
105
+
106
+1;
107
+
108
+=head1 NAME
109
+
110
+DBIx::Custom::Model - Model
111
+
112
+=head1 SYNOPSIS
113
+
114
+use DBIx::Custom::Table;
115
+
116
+my $table = DBIx::Custom::Model->new(table => 'books');
117
+
118
+=head1 ATTRIBUTES
119
+
120
+=head2 C<dbi>
121
+
122
+    my $dbi = $model->dbi;
123
+    $model = $model->dbi($dbi);
124
+
125
+L<DBIx::Custom> object.
126
+
127
+=head2 C<join>
128
+
129
+    my $join = $model->join;
130
+    $model = $model->join(
131
+        ['left outer join company on book.company_id = company.id']
132
+    );
133
+    
134
+Join clause, this value is passed to C<select> method.
135
+
136
+=head2 C<primary_key>
137
+
138
+    my $primary_key = $model->primary_key;
139
+    $model = $model->primary_key(['id', 'number']);
140
+
141
+Primary key,this is passed to C<insert>, C<update>,
142
+C<delete>, and C<select> method.
143
+
144
+=head2 C<table>
145
+
146
+    my $table = $model->table;
147
+    $model = $model->table('book');
148
+
149
+Table name, this is passed to C<select> method.
150
+
151
+=head2 C<bind_type>
152
+
153
+    my $type = $model->bind_type;
154
+    $model = $model->bind_type(['image' => DBI::SQL_BLOB]);
155
+    
156
+Database data type, this is used as type optioon of C<insert>, 
157
+C<update>, C<update_all>, C<delete>, C<delete_all>,
158
+C<select>, and C<execute> method
159
+
160
+=head1 METHODS
161
+
162
+L<DBIx::Custom::Model> inherits all methods from L<Object::Simple>,
163
+and you can use all methods of L<DBIx::Custom> and L<DBI>
164
+and implements the following new ones.
165
+
166
+=head2 C<delete>
167
+
168
+    $table->delete(...);
169
+    
170
+Same as C<delete> of L<DBIx::Custom> except that
171
+you don't have to specify C<table> option.
172
+
173
+=head2 C<delete_all>
174
+
175
+    $table->delete_all(...);
176
+    
177
+Same as C<delete_all> of L<DBIx::Custom> except that
178
+you don't have to specify C<table> option.
179
+
180
+=head2 C<insert>
181
+
182
+    $table->insert(...);
183
+    
184
+Same as C<insert> of L<DBIx::Custom> except that
185
+you don't have to specify C<table> option.
186
+
187
+=head2 C<method>
188
+
189
+    $model->method(
190
+        update_or_insert => sub {
191
+            my $self = shift;
192
+            
193
+            # ...
194
+        },
195
+        find_or_create   => sub {
196
+            my $self = shift;
197
+            
198
+            # ...
199
+    );
200
+
201
+Register method. These method is called directly from L<DBIx::Custom::Model> object.
202
+
203
+    $model->update_or_insert;
204
+    $model->find_or_create;
205
+
206
+=head2 C<mycolumn>
207
+
208
+    my $column = $self->mycolumn;
209
+    my $column = $self->mycolumn(book => ['author', 'title']);
210
+    my $column = $self->mycolumn(['author', 'title']);
211
+
212
+Create column clause for myself. The follwoing column clause is created.
213
+
214
+    book.author as author,
215
+    book.title as title
216
+
217
+If table name is ommited, C<table> attribute of the model is used.
218
+If column names is omitted, C<columns> attribute of the model is used.
219
+
220
+=head2 C<new>
221
+
222
+    my $table = DBIx::Custom::Table->new;
223
+
224
+Create a L<DBIx::Custom::Table> object.
225
+
226
+=head2 C<select>
227
+
228
+    $table->select(...);
229
+    
230
+Same as C<select> of L<DBIx::Custom> except that
231
+you don't have to specify C<table> option.
232
+
233
+=head2 C<update>
234
+
235
+    $table->update(...);
236
+    
237
+Same as C<update> of L<DBIx::Custom> except that
238
+you don't have to specify C<table> option.
239
+
240
+=head2 C<update_all>
241
+
242
+    $table->update_all(param => \%param);
243
+    
244
+Same as C<update_all> of L<DBIx::Custom> except that
245
+you don't have to specify table name.
246
+
247
+=cut
+108
DBIx-Custom-0.1711/lib/DBIx/Custom/Order.pm
... ...
@@ -0,0 +1,108 @@
1
+package DBIx::Custom::Order;
2
+use Object::Simple -base;
3
+use overload
4
+  'bool'   => sub {1},
5
+  '""'     => sub { shift->to_string },
6
+  fallback => 1;
7
+
8
+has 'dbi',
9
+    orders => sub { [] };
10
+
11
+sub prepend {
12
+    my $self = shift;
13
+    
14
+    foreach my $order (reverse @_) {
15
+        if (ref $order eq 'ARRAY') {
16
+            my $column = shift @$order;
17
+            $column = $self->dbi->_q($column) if defined $column;
18
+            my $derection = shift @$order;
19
+            $order = $column;
20
+            $order .= " $derection" if $derection;
21
+        }
22
+        unshift @{$self->orders}, $order;
23
+    }
24
+    
25
+    return $self;
26
+}
27
+
28
+sub to_string {
29
+    my $self = shift;
30
+    
31
+    my $exists = {};
32
+    my @orders;
33
+    foreach my $order (@{$self->orders}) {
34
+        next unless defined $order;
35
+        $order =~ s/^\s+//;
36
+        $order =~ s/\s+$//;
37
+        my ($column, $direction) = split /\s+/, $order;
38
+        push @orders, $order unless $exists->{$column};
39
+        $exists->{$column} = 1;
40
+    }
41
+    
42
+    return '' unless @orders;
43
+    return 'order by ' . join(', ', @orders);
44
+}
45
+
46
+1;
47
+
48
+=head1 NAME
49
+
50
+DBIx::Custom::Order - Order by EXPERIMENTAL
51
+
52
+=head1 SYNOPSIS
53
+
54
+    # Result
55
+    my $order = DBIx::Custom::Order->new;
56
+    $order->prepend('title', 'author desc');
57
+    my $order_by = "$order";
58
+    
59
+=head1 ATTRIBUTES
60
+
61
+=head2 C<dbi>
62
+
63
+    my $dbi = $order->dbi;
64
+    $order = $order->dbi($dbi);
65
+
66
+L<DBIx::Custom> object.
67
+
68
+=head2 C<orders>
69
+
70
+    my $orders = $result->orders;
71
+    $result = $result->orders(\%orders);
72
+
73
+Parts of order by clause
74
+
75
+=head1 METHODS
76
+
77
+L<DBIx::Custom::Result> inherits all methods from L<Object::Simple>
78
+and implements the following new ones.
79
+
80
+=head2 C<prepend>
81
+
82
+    $order->prepend('title', 'author desc');
83
+
84
+Prepend order parts to C<orders>.
85
+
86
+You can pass array reference, which contain column name and direction.
87
+Column name is quoted properly
88
+    
89
+    # Column name and direction
90
+    $order->prepend(['book-title']);
91
+    $order->prepend([qw/book-title desc/]);
92
+
93
+This is expanded to the following way.
94
+
95
+    "book-title"
96
+    "book-title" desc
97
+
98
+=head2 C<to_string>
99
+
100
+    my $order_by = $order->to_string;
101
+
102
+Create order by clause. If column name is duplicated, First one is used.
103
+C<to_string> override stringification. so you can write the follwoing way.
104
+
105
+    my $order_by = "$order";
106
+
107
+=cut
108
+
+116
DBIx-Custom-0.1711/lib/DBIx/Custom/Query.pm
... ...
@@ -0,0 +1,116 @@
1
+package DBIx::Custom::Query;
2
+use Object::Simple -base;
3
+
4
+use Carp 'croak';
5
+use DBIx::Custom::Util '_subname';
6
+
7
+has 'sth',
8
+    sql => '',
9
+    columns => sub { [] };
10
+
11
+# DEPRECATED!
12
+has 'default_filter';
13
+sub filters {
14
+    warn "DBIx::Custom::Query filters attribute method is DEPRECATED!";
15
+    my $self = shift;
16
+    if (@_) {
17
+        $self->{filters} = $_[0];
18
+        return $self;
19
+    }
20
+    return $self->{filters};
21
+}
22
+
23
+# DEPRECATED!
24
+sub tables {
25
+    warn "DBIx::Custom::Query tables attribute method is DEPRECATED!";
26
+    my $self = shift;
27
+    if (@_) {
28
+        $self->{tables} = $_[0];
29
+        return $self;
30
+    }
31
+    return $self->{tables} ||= [];
32
+}
33
+
34
+#DEPRECATED!
35
+sub filter {
36
+    Carp::carp "DBIx::Custom::Query filter method is DEPRECATED!";
37
+    my $self = shift;
38
+    if (@_) {
39
+        my $filter = {};
40
+        if (ref $_[0] eq 'HASH') {
41
+            $filter = $_[0];
42
+        }
43
+        else {
44
+            my $ef = @_ > 1 ? [@_] : $_[0];
45
+            for (my $i = 0; $i < @$ef; $i += 2) {
46
+                my $column = $ef->[$i];
47
+                my $f = $ef->[$i + 1];
48
+                if (ref $column eq 'ARRAY') {
49
+                    foreach my $c (@$column) {
50
+                        $filter->{$c} = $f;
51
+                    }
52
+                }
53
+                else {
54
+                    $filter->{$column} = $f;
55
+                }
56
+            }
57
+        }
58
+        foreach my $column (keys %$filter) {
59
+            my $fname = $filter->{$column};
60
+            if  (exists $filter->{$column}
61
+              && defined $fname
62
+              && ref $fname ne 'CODE') 
63
+            {
64
+                my $filters = $self->{filters} || {};
65
+                croak qq{Filter "$fname" is not registered" } . _subname
66
+                  unless exists $filters->{$fname};
67
+                $filter->{$column} = $filters->{$fname};
68
+            }
69
+        }
70
+        $self->{filter} = {%{$self->{filter} || {}}, %$filter};
71
+        return $self;
72
+    }
73
+    return $self->{filter} ||= {};
74
+}
75
+
76
+1;
77
+
78
+=head1 NAME
79
+
80
+DBIx::Custom::Query - Query
81
+
82
+=head1 SYNOPSIS
83
+    
84
+    my $query = DBIx::Custom::Query->new;
85
+    my $sth = $query->sth;
86
+    my $sql = $query->sql;
87
+    my $columns = $query->columns;
88
+    
89
+=head1 ATTRIBUTES
90
+
91
+=head2 C<columns>
92
+
93
+    my $columns = $query->columns;
94
+    $query      = $query->columns(['auhtor', 'title']);
95
+
96
+Column names.
97
+
98
+=head2 C<sql>
99
+
100
+    my $sql = $query->sql;
101
+    $query  = $query->sql('select * from books where author = ?;');
102
+
103
+SQL statement.
104
+
105
+=head2 C<sth>
106
+
107
+    my $sth = $query->sth;
108
+    $query  = $query->sth($sth);
109
+
110
+Statement handle of L<DBI>
111
+
112
+=head1 METHODS
113
+
114
+L<DBIx::Custom::Query> inherits all methods from L<Object::Simple>.
115
+
116
+=cut
+329
DBIx-Custom-0.1711/lib/DBIx/Custom/QueryBuilder.pm
... ...
@@ -0,0 +1,329 @@
1
+package DBIx::Custom::QueryBuilder;
2
+
3
+use Object::Simple -base;
4
+
5
+use Carp 'croak';
6
+use DBIx::Custom::Query;
7
+use DBIx::Custom::Util '_subname';
8
+
9
+# Carp trust relationship
10
+push @DBIx::Custom::CARP_NOT, __PACKAGE__;
11
+push @DBIx::Custom::Where::CARP_NOT, __PACKAGE__;
12
+
13
+has 'dbi';
14
+
15
+sub build_query {
16
+    my ($self, $source) = @_;
17
+    
18
+    my $query;
19
+    
20
+    # Parse tag. tag is DEPRECATED!
21
+    if ($self->dbi->tag_parse && $source =~ /(\s|^)\{/) {
22
+        $query = $self->_parse_tag($source);
23
+        my $tag_count = delete $query->{tag_count};
24
+        warn qq/Tag system such as {? name} is DEPRECATED! / .
25
+             qq/use parameter system such as :name instead/
26
+          if $tag_count;
27
+        my $query2 = $self->_parse_parameter($query->sql);
28
+        $query->sql($query2->sql);
29
+        for (my $i =0; $i < @{$query->columns}; $i++) {
30
+            my $column = $query->columns->[$i];
31
+            if ($column eq 'RESERVED_PARAMETER') {
32
+                my $column2 = shift @{$query2->columns};
33
+                croak ":name syntax is wrong"
34
+                  unless defined $column2;
35
+                $query->columns->[$i] = $column2;
36
+            }
37
+        }
38
+    }
39
+    
40
+    # Parse parameter
41
+    else { $query = $self->_parse_parameter($source) }
42
+    
43
+    my $sql = $query->sql;
44
+    $sql .= ';' unless $source =~ /;$/;
45
+    $query->sql($sql);
46
+
47
+    # Check placeholder count
48
+    croak qq{Placeholder count in "$sql" must be same as column count}
49
+        . _subname
50
+      unless $self->_placeholder_count($sql) eq @{$query->columns};
51
+        
52
+    return $query;
53
+}
54
+
55
+sub _placeholder_count {
56
+    my ($self, $sql) = @_;
57
+    
58
+    # Count
59
+    $sql ||= '';
60
+    my $count = 0;
61
+    my $pos   = -1;
62
+    while (($pos = index($sql, '?', $pos + 1)) != -1) {
63
+        $count++;
64
+    }
65
+    return $count;
66
+}
67
+
68
+sub _parse_parameter {
69
+    my ($self, $source) = @_;
70
+    
71
+    # Get and replace parameters
72
+    my $sql = $source || '';
73
+    my $columns = [];
74
+    my $c = $self->dbi->safety_character;
75
+    # Parameter regex
76
+    $sql =~ s/([^:]):(\d+):([^:])/$1\\:$2\\:$3/g;
77
+    my $re = qr/(^|.*?[^\\]):([$c\.]+)(?:\{(.*?)\})?(.*)/s;
78
+    while ($sql =~ /$re/g) {
79
+        push @$columns, $2;
80
+        $sql = defined $3 ? "$1$2 $3 ?$4" : "$1?$4";
81
+    }
82
+    $sql =~ s/\\:/:/g;
83
+
84
+    # Create query
85
+    my $query = DBIx::Custom::Query->new(
86
+        sql => $sql,
87
+        columns => $columns
88
+    );
89
+    
90
+    return $query;
91
+}
92
+    
93
+# DEPRECATED!
94
+has tags => sub { {} };
95
+
96
+# DEPRECATED!
97
+sub register_tag {
98
+    my $self = shift;
99
+    
100
+    warn "register_tag is DEPRECATED!";
101
+    
102
+    # Merge tag
103
+    my $tags = ref $_[0] eq 'HASH' ? $_[0] : {@_};
104
+    $self->tags({%{$self->tags}, %$tags});
105
+    
106
+    return $self;
107
+}
108
+
109
+# DEPRECATED!
110
+sub _parse_tag {
111
+    my ($self, $source) = @_;
112
+    # Source
113
+    $source ||= '';
114
+    # Tree
115
+    my @tree;
116
+    # Value
117
+    my $value = '';
118
+    # State
119
+    my $state = 'text';
120
+    # Before charactor
121
+    my $before = '';
122
+    # Position
123
+    my $pos = 0;
124
+    # Parse
125
+    my $original = $source;
126
+    my $tag_count = 0;
127
+    while (defined(my $c = substr($source, $pos, 1))) {
128
+        # Last
129
+        last unless length $c;
130
+        # Parameter
131
+        if ($c eq ':' && (substr($source, $pos + 1, 1) || '') =~ /\w/) {
132
+            push @tree, {type => 'param'};;
133
+        }
134
+        # State is text
135
+        if ($state eq 'text') {
136
+            # Tag start charactor
137
+            if ($c eq '{') {
138
+                # Escaped charactor
139
+                if ($before eq "\\") {
140
+                    substr($value, -1, 1, '');
141
+                    $value .= $c;
142
+                }
143
+                # Tag start
144
+                else {
145
+                    # Change state
146
+                    $state = 'tag';
147
+                    # Add text
148
+                    push @tree, {type => 'text', value => $value}
149
+                      if $value;
150
+                    # Clear
151
+                    $value = '';
152
+                }
153
+            }
154
+            # Tag end charactor
155
+            elsif ($c eq '}') {
156
+                # Escaped charactor
157
+                if ($before eq "\\") {
158
+                    substr($value, -1, 1, '');
159
+                    $value .= $c;
160
+                }
161
+                # Unexpected
162
+                else {
163
+                    croak qq{Parsing error. unexpected "\}". }
164
+                        . qq{pos $pos of "$original" } . _subname
165
+                }
166
+            }
167
+            # Normal charactor
168
+            else { $value .= $c }
169
+        }
170
+        # State is tags
171
+        else {
172
+            # Tag start charactor
173
+            if ($c eq '{') {
174
+                # Escaped charactor
175
+                if ($before eq "\\") {
176
+                    substr($value, -1, 1, '');
177
+                    $value .= $c;
178
+                }
179
+                # Unexpected
180
+                else {
181
+                    croak qq{Parsing error. unexpected "\{". }
182
+                        . qq{pos $pos of "$original" } . _subname
183
+                }
184
+            }
185
+            # Tag end charactor
186
+            elsif ($c eq '}') {
187
+                # Escaped charactor
188
+                if ($before eq "\\") {
189
+                    substr($value, -1, 1, '');
190
+                    $value .= $c;
191
+                }
192
+                # Tag end
193
+                else {
194
+                    # Change state
195
+                    $state = 'text';
196
+                    # Add tag
197
+                    my ($tag_name, @tag_args) = split /\s+/, $value;
198
+                    push @tree, {type => 'tag', tag_name => $tag_name, 
199
+                                 tag_args => \@tag_args};
200
+                    # Clear
201
+                    $value = '';
202
+                    # Countup
203
+                    $tag_count++;
204
+                }
205
+            }
206
+            # Normal charactor
207
+            else { $value .= $c }
208
+        }
209
+        # Save before charactor
210
+        $before = $c;
211
+        # increment position
212
+        $pos++;
213
+    }
214
+    # Tag not finished
215
+    croak qq{Tag not finished. "$original" } . _subname
216
+      if $state eq 'tag';
217
+    # Not contains tag
218
+    return DBIx::Custom::Query->new(sql => $source, tag_count => $tag_count)
219
+      if $tag_count == 0;
220
+    # Add rest text
221
+    push @tree, {type => 'text', value => $value}
222
+      if $value;
223
+    # SQL
224
+    my $sql = '';
225
+    # All Columns
226
+    my $all_columns = [];
227
+    # Tables
228
+    my $tables = [];
229
+    # Build SQL 
230
+    foreach my $node (@tree) {
231
+        # Text
232
+        if ($node->{type} eq 'text') { $sql .= $node->{value} }
233
+        # Parameter
234
+        elsif ($node->{type} eq 'param') {
235
+            push @$all_columns, 'RESERVED_PARAMETER';
236
+        }
237
+        # Tag
238
+        else {
239
+            # Tag name
240
+            my $tag_name = $node->{tag_name};
241
+            # Tag arguments
242
+            my $tag_args = $node->{tag_args};
243
+            # Table
244
+            if ($tag_name eq 'table') {
245
+                my $table = $tag_args->[0];
246
+                push @$tables, $table;
247
+                $sql .= $table;
248
+                next;
249
+            }
250
+            # Get tag
251
+            my $tag = $self->tag_processors->{$tag_name}
252
+                             || $self->tags->{$tag_name};
253
+            # Tag is not registered
254
+            croak qq{Tag "$tag_name" is not registered } . _subname
255
+              unless $tag;
256
+            # Tag not sub reference
257
+            croak qq{Tag "$tag_name" must be sub reference } . _subname
258
+              unless ref $tag eq 'CODE';
259
+            # Execute tag
260
+            my $r = $tag->(@$tag_args);
261
+            # Check tag return value
262
+            croak qq{Tag "$tag_name" must return [STRING, ARRAY_REFERENCE] }
263
+                . _subname
264
+              unless ref $r eq 'ARRAY' && defined $r->[0] && ref $r->[1] eq 'ARRAY';
265
+            # Part of SQL statement and colum names
266
+            my ($part, $columns) = @$r;
267
+            # Add columns
268
+            push @$all_columns, @$columns;
269
+            # Join part tag to SQL
270
+            $sql .= $part;
271
+        }
272
+    }
273
+    # Query
274
+    my $query = DBIx::Custom::Query->new(
275
+        sql => $sql,
276
+        columns => $all_columns,
277
+        tables => $tables,
278
+        tag_count => $tag_count
279
+    );
280
+    return $query;
281
+}
282
+
283
+# DEPRECATED!
284
+has tag_processors => sub { {} };
285
+
286
+# DEPRECATED!
287
+sub register_tag_processor {
288
+    my $self = shift;
289
+    warn "register_tag_processor is DEPRECATED!";
290
+    # Merge tag
291
+    my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
292
+    $self->tag_processors({%{$self->tag_processors}, %{$tag_processors}});
293
+    return $self;
294
+}
295
+
296
+1;
297
+
298
+=head1 NAME
299
+
300
+DBIx::Custom::QueryBuilder - Query builder
301
+
302
+=head1 SYNOPSIS
303
+    
304
+    my $builder = DBIx::Custom::QueryBuilder->new;
305
+    my $query = $builder->build_query(
306
+        "select from table title = :title and author = :author"
307
+    );
308
+
309
+=head1 ATTRIBUTES
310
+
311
+=head2 C<dbi>
312
+
313
+    my $dbi = $builder->dbi;
314
+    $builder = $builder->dbi($dbi);
315
+
316
+L<DBIx::Custom> object.
317
+
318
+=head1 METHODS
319
+
320
+L<DBIx::Custom::QueryBuilder> inherits all methods from L<Object::Simple>
321
+and implements the following new ones.
322
+
323
+=head2 C<build_query>
324
+    
325
+    my $query = $builder->build_query($source);
326
+
327
+Create a new L<DBIx::Custom::Query> object from SQL source.
328
+
329
+=cut
+573
DBIx-Custom-0.1711/lib/DBIx/Custom/Result.pm
... ...
@@ -0,0 +1,573 @@
1
+package DBIx::Custom::Result;
2
+use Object::Simple -base;
3
+
4
+use Carp 'croak';
5
+use DBIx::Custom::Util qw/_array_to_hash _subname/;
6
+
7
+has [qw/dbi sth/],
8
+    stash => sub { {} };
9
+
10
+*all = \&fetch_hash_all;
11
+
12
+sub filter {
13
+    my $self = shift;
14
+    
15
+    # Set
16
+    if (@_) {
17
+        
18
+        # Convert filter name to subroutine
19
+        my $filter = @_ == 1 ? $_[0] : [@_];
20
+        $filter = _array_to_hash($filter);
21
+        foreach my $column (keys %$filter) {
22
+            my $fname = $filter->{$column};
23
+            if  (exists $filter->{$column}
24
+              && defined $fname
25
+              && ref $fname ne 'CODE') 
26
+            {
27
+              croak qq{Filter "$fname" is not registered" } . _subname
28
+                unless exists $self->dbi->filters->{$fname};
29
+              $filter->{$column} = $self->dbi->filters->{$fname};
30
+            }
31
+        }
32
+        
33
+        # Merge
34
+        $self->{filter} = {%{$self->filter}, %$filter};
35
+        
36
+        return $self;
37
+    }
38
+    
39
+    return $self->{filter} ||= {};
40
+}
41
+
42
+sub filter_off {
43
+    my $self = shift;
44
+    $self->{filter_off} = 1;
45
+    return $self;
46
+}
47
+
48
+sub filter_on {
49
+    my $self = shift;
50
+    $self->{filter_off} = 0;
51
+    return $self;
52
+}
53
+
54
+sub fetch {
55
+    my $self = shift;
56
+    
57
+    # Info
58
+    my $columns = $self->{sth}->{NAME};
59
+    my $types = $self->{sth}->{TYPE};
60
+    
61
+    # Fetch
62
+    my @row = $self->{sth}->fetchrow_array;
63
+    return unless @row;
64
+    
65
+    # Filtering
66
+    my $type_rule1 = $self->type_rule->{from1} || {};
67
+    my $type_rule2 = $self->type_rule->{from2} || {};
68
+    my $filter = $self->filter;
69
+    my $end_filter = $self->{end_filter} || {};
70
+    for (my $i = 0; $i < @$columns; $i++) {
71
+        
72
+        # Column
73
+        my $column = $columns->[$i];
74
+        
75
+        # Type rule
76
+        my $type_filter1 = $type_rule1->{lc($types->[$i])};
77
+        $row[$i] = $type_filter1->($row[$i])
78
+          if  $type_filter1 && !$self->{type_rule_off}
79
+           && !$self->{type_rule1_off};
80
+        my $type_filter2 = $type_rule2->{lc($types->[$i])};
81
+        $row[$i] = $type_filter2->($row[$i])
82
+          if  $type_filter2 && !$self->{type_rule_off}
83
+           && !$self->{type_rule2_off};
84
+        
85
+        # Filter
86
+        my $filter  = $filter->{$column} || $self->{default_filter};
87
+        $row[$i] = $filter->($row[$i])
88
+          if $filter && !$self->{filter_off};
89
+        $row[$i] = $end_filter->{$column}->($row[$i])
90
+          if $end_filter->{$column} && !$self->{filter_off};
91
+    }
92
+
93
+    return \@row;
94
+}
95
+
96
+sub fetch_all {
97
+    my $self = shift;
98
+    
99
+    # Fetch all rows
100
+    my $rows = [];
101
+    while(my $row = $self->fetch) { push @$rows, $row}
102
+    
103
+    return $rows;
104
+}
105
+
106
+sub fetch_first {
107
+    my $self = shift;
108
+    
109
+    # Fetch
110
+    my $row = $self->fetch;
111
+    return unless $row;
112
+    
113
+    # Finish statement handle
114
+    $self->sth->finish;
115
+    
116
+    return $row;
117
+}
118
+
119
+sub fetch_hash {
120
+    my $self = shift;
121
+    
122
+    # Info
123
+    my $columns = $self->{sth}->{NAME};
124
+    my $types = $self->{sth}->{TYPE};
125
+    
126
+    # Fetch
127
+    my $row = $self->{sth}->fetchrow_arrayref;
128
+    return unless $row;
129
+
130
+    # Filter
131
+    my $hash_row = {};
132
+    my $filter  = $self->filter;
133
+    my $end_filter = $self->{end_filter} || {};
134
+    my $type_rule1 = $self->type_rule->{from1} || {};
135
+    my $type_rule2 = $self->type_rule->{from2} || {};
136
+    for (my $i = 0; $i < @$columns; $i++) {
137
+        
138
+        # Column
139
+        my $column = $columns->[$i];
140
+        $hash_row->{$column} = $row->[$i];
141
+        
142
+        # Type rule
143
+        my $type_filter1 = $type_rule1->{lc($types->[$i])};
144
+        $hash_row->{$column} = $type_filter1->($hash_row->{$column})
145
+        if  !$self->{type_rule_off} && !$self->{type_rule1_off}
146
+         && $type_filter1;
147
+        my $type_filter2 = $type_rule2->{lc($types->[$i])};
148
+        $hash_row->{$column} = $type_filter2->($hash_row->{$column})
149
+        if  !$self->{type_rule_off} && !$self->{type_rule2_off}
150
+         && $type_filter2;
151
+        
152
+        # Filter
153
+        my $f = $filter->{$column} || $self->{default_filter};
154
+        $hash_row->{$column} = $f->($hash_row->{$column})
155
+          if $f && !$self->{filter_off};
156
+        $hash_row->{$column} = $end_filter->{$column}->($hash_row->{$column})
157
+          if $end_filter->{$column} && !$self->{filter_off};
158
+    }
159
+    
160
+    return $hash_row;
161
+}
162
+
163
+sub fetch_hash_all {
164
+    my $self = shift;
165
+    
166
+    # Fetch all rows as hash
167
+    my $rows = [];
168
+    while(my $row = $self->fetch_hash) { push @$rows, $row }
169
+    
170
+    return $rows;
171
+}
172
+
173
+sub fetch_hash_first {
174
+    my $self = shift;
175
+    
176
+    # Fetch hash
177
+    my $row = $self->fetch_hash;
178
+    return unless $row;
179
+    
180
+    # Finish statement handle
181
+    $self->sth->finish;
182
+    
183
+    return $row;
184
+}
185
+
186
+sub fetch_hash_multi {
187
+    my ($self, $count) = @_;
188
+    
189
+    # Fetch multiple rows
190
+    croak 'Row count must be specified ' . _subname
191
+      unless $count;
192
+    my $rows = [];
193
+    for (my $i = 0; $i < $count; $i++) {
194
+        my $row = $self->fetch_hash;
195
+        last unless $row;
196
+        push @$rows, $row;
197
+    }
198
+    
199
+    return unless @$rows;
200
+    return $rows;
201
+}
202
+
203
+sub fetch_multi {
204
+    my ($self, $count) = @_;
205
+    
206
+    # Row count not specifed
207
+    croak 'Row count must be specified ' . _subname
208
+      unless $count;
209
+    
210
+    # Fetch multi rows
211
+    my $rows = [];
212
+    for (my $i = 0; $i < $count; $i++) {
213
+        my $row = $self->fetch;
214
+        last unless $row;
215
+        push @$rows, $row;
216
+    }
217
+    
218
+    return unless @$rows;
219
+    return $rows;
220
+}
221
+
222
+sub header { shift->sth->{NAME} }
223
+
224
+*one = \&fetch_hash_first;
225
+
226
+sub type_rule {
227
+    my $self = shift;
228
+    
229
+    if (@_) {
230
+        my $type_rule = ref $_[0] eq 'HASH' ? $_[0] : {@_};
231
+
232
+        # From
233
+        foreach my $i (1 .. 2) {
234
+            $type_rule->{"from$i"} = _array_to_hash($type_rule->{"from$i"});
235
+            foreach my $data_type (keys %{$type_rule->{"from$i"} || {}}) {
236
+                croak qq{data type of from$i section must be lower case or number}
237
+                  if $data_type =~ /[A-Z]/;
238
+                my $fname = $type_rule->{"from$i"}{$data_type};
239
+                if (defined $fname && ref $fname ne 'CODE') {
240
+                    croak qq{Filter "$fname" is not registered" } . _subname
241
+                      unless exists $self->dbi->filters->{$fname};
242
+                    
243
+                    $type_rule->{"from$i"}{$data_type} = $self->dbi->filters->{$fname};
244
+                }
245
+            }
246
+        }
247
+        $self->{type_rule} = $type_rule;
248
+        
249
+        return $self;
250
+    }
251
+    
252
+    return $self->{type_rule} || {};
253
+}
254
+
255
+sub type_rule_off {
256
+    my $self = shift;
257
+    $self->{type_rule_off} = 1;
258
+    return $self;
259
+}
260
+
261
+sub type_rule_on {
262
+    my $self = shift;
263
+    $self->{type_rule_off} = 0;
264
+    return $self;
265
+}
266
+
267
+sub type_rule1_off {
268
+    my $self = shift;
269
+    $self->{type_rule1_off} = 1;
270
+    return $self;
271
+}
272
+
273
+sub type_rule1_on {
274
+    my $self = shift;
275
+    $self->{type_rule1_off} = 0;
276
+    return $self;
277
+}
278
+
279
+sub type_rule2_off {
280
+    my $self = shift;
281
+    $self->{type_rule2_off} = 1;
282
+    return $self;
283
+}
284
+
285
+sub type_rule2_on {
286
+    my $self = shift;
287
+    $self->{type_rule2_off} = 0;
288
+    return $self;
289
+}
290
+
291
+# DEPRECATED!
292
+sub end_filter {
293
+    warn "end_filter method is DEPRECATED!";
294
+    my $self = shift;
295
+    if (@_) {
296
+        my $end_filter = {};
297
+        if (ref $_[0] eq 'HASH') { $end_filter = $_[0] }
298
+        else { 
299
+            $end_filter = _array_to_hash(
300
+                @_ > 1 ? [@_] : $_[0]
301
+            );
302
+        }
303
+        foreach my $column (keys %$end_filter) {
304
+            my $fname = $end_filter->{$column};
305
+            if  (exists $end_filter->{$column}
306
+              && defined $fname
307
+              && ref $fname ne 'CODE') 
308
+            {
309
+              croak qq{Filter "$fname" is not registered" } . _subname
310
+                unless exists $self->dbi->filters->{$fname};
311
+              $end_filter->{$column} = $self->dbi->filters->{$fname};
312
+            }
313
+        }
314
+        $self->{end_filter} = {%{$self->end_filter}, %$end_filter};
315
+        return $self;
316
+    }
317
+    return $self->{end_filter} ||= {};
318
+}
319
+# DEPRECATED!
320
+sub remove_end_filter {
321
+    warn "remove_end_filter is DEPRECATED!";
322
+    my $self = shift;
323
+    $self->{end_filter} = {};
324
+    return $self;
325
+}
326
+# DEPRECATED!
327
+sub remove_filter {
328
+    warn "remove_filter is DEPRECATED!";
329
+    my $self = shift;
330
+    $self->{filter} = {};
331
+    return $self;
332
+}
333
+# DEPRECATED!
334
+sub default_filter {
335
+    warn "default_filter is DEPRECATED!";
336
+    my $self = shift;
337
+    if (@_) {
338
+        my $fname = $_[0];
339
+        if (@_ && !$fname) {
340
+            $self->{default_filter} = undef;
341
+        }
342
+        else {
343
+            croak qq{Filter "$fname" is not registered}
344
+              unless exists $self->dbi->filters->{$fname};
345
+            $self->{default_filter} = $self->dbi->filters->{$fname};
346
+        }
347
+        return $self;
348
+    }
349
+    return $self->{default_filter};
350
+}
351
+# DEPRECATED!
352
+has 'filter_check'; 
353
+
354
+1;
355
+
356
+=head1 NAME
357
+
358
+DBIx::Custom::Result - Result of select statement
359
+
360
+=head1 SYNOPSIS
361
+
362
+    # Result
363
+    my $result = $dbi->select(table => 'book');
364
+
365
+    # Fetch a row and put it into array reference
366
+    while (my $row = $result->fetch) {
367
+        my $author = $row->[0];
368
+        my $title  = $row->[1];
369
+    }
370
+    
371
+    # Fetch only a first row and put it into array reference
372
+    my $row = $result->fetch_first;
373
+    
374
+    # Fetch all rows and put them into array of array reference
375
+    my $rows = $result->fetch_all;
376
+
377
+    # Fetch a row and put it into hash reference
378
+    while (my $row = $result->fetch_hash) {
379
+        my $title  = $row->{title};
380
+        my $author = $row->{author};
381
+    }
382
+    
383
+    # Fetch only a first row and put it into hash reference
384
+    my $row = $result->fetch_hash_first;
385
+    my $row = $result->one; # Same as fetch_hash_first
386
+    
387
+    # Fetch all rows and put them into array of hash reference
388
+    my $rows = $result->fetch_hash_all;
389
+    my $rows = $result->all; # Same as fetch_hash_all
390
+
391
+=head1 ATTRIBUTES
392
+
393
+=head2 C<dbi>
394
+
395
+    my $dbi = $result->dbi;
396
+    $result = $result->dbi($dbi);
397
+
398
+L<DBIx::Custom> object.
399
+
400
+=head2 C<sth>
401
+
402
+    my $sth = $reuslt->sth
403
+    $result = $result->sth($sth);
404
+
405
+Statement handle of L<DBI>.
406
+
407
+=head1 METHODS
408
+
409
+L<DBIx::Custom::Result> inherits all methods from L<Object::Simple>
410
+and implements the following new ones.
411
+
412
+=head2 C<all>
413
+
414
+    my $rows = $result->all;
415
+
416
+Same as C<fetch_hash_all>.
417
+
418
+=head2 C<fetch>
419
+
420
+    my $row = $result->fetch;
421
+
422
+Fetch a row and put it into array reference.
423
+
424
+=head2 C<fetch_all>
425
+
426
+    my $rows = $result->fetch_all;
427
+
428
+Fetch all rows and put them into array of array reference.
429
+
430
+=head2 C<fetch_first>
431
+
432
+    my $row = $result->fetch_first;
433
+
434
+Fetch only a first row and put it into array reference,
435
+and finish statment handle.
436
+
437
+=head2 C<fetch_hash>
438
+
439
+    my $row = $result->fetch_hash;
440
+
441
+Fetch a row and put it into hash reference.
442
+
443
+=head2 C<fetch_hash_all>
444
+
445
+    my $rows = $result->fetch_hash_all;
446
+
447
+Fetch all rows and put them into array of hash reference.
448
+
449
+=head2 C<fetch_hash_first>
450
+    
451
+    my $row = $result->fetch_hash_first;
452
+
453
+Fetch only a first row and put it into hash reference,
454
+and finish statment handle.
455
+
456
+=head2 C<fetch_hash_multi>
457
+
458
+    my $rows = $result->fetch_hash_multi(5);
459
+    
460
+Fetch multiple rows and put them into array of hash reference.
461
+
462
+=head2 C<fetch_multi>
463
+
464
+    my $rows = $result->fetch_multi(5);
465
+    
466
+Fetch multiple rows and put them into array of array reference.
467
+
468
+=head2 C<filter>
469
+
470
+    $result->filter(title  => sub { uc $_[0] }, author => 'to_upper');
471
+    $result->filter([qw/title author/] => 'to_upper');
472
+
473
+Set filter for column.
474
+You can use subroutine or filter name as filter.
475
+This filter is executed after C<type_rule> filter.
476
+
477
+=head2 C<filter_off> EXPERIMENTAL
478
+
479
+    $result = $result->filter_off;
480
+
481
+Turn filtering by C<filter> method off.
482
+By default, filterin is on.
483
+
484
+=head2 C<filter_on> EXPERIMENTAL
485
+
486
+    $result = $resutl->filter_on;
487
+
488
+Turn filtering by C<filter> method on.
489
+By default, filterin is on.
490
+
491
+=head2 C<header>
492
+
493
+    my $header = $result->header;
494
+
495
+Get header column names.
496
+
497
+=head2 C<one>
498
+
499
+    my $row = $result->one;
500
+
501
+Same as C<fetch_hash_first>.
502
+
503
+=head2 C<stash>
504
+
505
+    my $stash = $result->stash;
506
+    my $foo = $result->stash->{foo};
507
+    $result->stash->{foo} = $foo;
508
+
509
+Stash is hash reference for data.
510
+
511
+=head2 C<type_rule> EXPERIMENTAL
512
+    
513
+    # Merge type rule
514
+    $result->type_rule(
515
+        # DATE
516
+        9 => sub { ... },
517
+        # DATETIME or TIMESTAMP
518
+        11 => sub { ... }
519
+    );
520
+
521
+    # Replace type rule(by reference)
522
+    $result->type_rule([
523
+        # DATE
524
+        9 => sub { ... },
525
+        # DATETIME or TIMESTAMP
526
+        11 => sub { ... }
527
+    ]);
528
+
529
+This is same as L<DBIx::Custom>'s C<type_rule>'s <from>.
530
+
531
+=head2 C<type_rule_off> EXPERIMENTAL
532
+
533
+    $result = $result->type_rule_off;
534
+
535
+Turn C<from1> and C<from2> type rule off.
536
+By default, type rule is on.
537
+
538
+=head2 C<type_rule_on> EXPERIMENTAL
539
+
540
+    $result = $result->type_rule_on;
541
+
542
+Turn C<from1> and C<from2> type rule on.
543
+By default, type rule is on.
544
+
545
+=head2 C<type_rule1_off> EXPERIMENTAL
546
+
547
+    $result = $result->type_rule1_off;
548
+
549
+Turn C<from1> type rule off.
550
+By default, type rule is on.
551
+
552
+=head2 C<type_rule1_on> EXPERIMENTAL
553
+
554
+    $result = $result->type_rule1_on;
555
+
556
+Turn C<from1> type rule on.
557
+By default, type rule is on.
558
+
559
+=head2 C<type_rule2_off> EXPERIMENTAL
560
+
561
+    $result = $result->type_rule2_off;
562
+
563
+Turn C<from2> type rule off.
564
+By default, type rule is on.
565
+
566
+=head2 C<type_rule2_on> EXPERIMENTAL
567
+
568
+    $result = $result->type_rule2_on;
569
+
570
+Turn C<from2> type rule on.
571
+By default, type rule is on.
572
+
573
+=cut
+98
DBIx-Custom-0.1711/lib/DBIx/Custom/Tag.pm
... ...
@@ -0,0 +1,98 @@
1
+package DBIx::Custom::Tag;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use Carp 'croak';
7
+use DBIx::Custom::Util '_subname';
8
+
9
+# Carp trust relationship
10
+push @DBIx::Custom::QueryBuilder::CARP_NOT, __PACKAGE__;
11
+
12
+sub equal              { _basic('=',  @_) }
13
+sub greater_than_equal { _basic('>=', @_) }
14
+sub greater_than       { _basic('>',  @_) }
15
+
16
+sub in {
17
+    my ($column, $count) = @_;
18
+    
19
+    # Check arguments
20
+    croak qq{Column name and count of values must be specified in tag "{in }" }
21
+        . _subname
22
+      unless $column && $count && $count =~ /^\d+$/;
23
+
24
+    # Part of statement
25
+    my $s = "$column in (";
26
+    for (my $i = 0; $i < $count; $i++) {
27
+        $s .= '?, ';
28
+    }
29
+    $s =~ s/, $//;
30
+    $s .= ')';
31
+    
32
+    # Columns
33
+    my $columns = [];
34
+    push @$columns, $column for (0 .. $count - 1);
35
+    
36
+    return [$s, $columns];
37
+}
38
+
39
+sub insert_param {
40
+    my @columns = @_;
41
+    
42
+    # Insert parameters
43
+    my $s = '(';
44
+    $s .= "$_, " for @columns;
45
+    $s =~ s/, $//;
46
+    $s .= ') ';
47
+    $s .= 'values (';
48
+    $s .= "?, " for @columns;
49
+    $s =~ s/, $//;
50
+    $s .= ')';
51
+    
52
+    return [$s, \@columns];
53
+}
54
+
55
+sub like               { _basic('like', @_) }
56
+sub lower_than_equal   { _basic('<=',   @_) }
57
+sub lower_than         { _basic('<',    @_) }
58
+sub not_equal          { _basic('<>',   @_) }
59
+
60
+sub placeholder {
61
+    my $column = shift;
62
+    
63
+    # Check arguments
64
+    croak qq{Column name must be specified in tag "{? }" } . _subname
65
+      unless $column;
66
+    
67
+    return ['?', [$column]];
68
+}
69
+
70
+sub update_param {
71
+    my @columns = @_;
72
+    
73
+    # Update parameters
74
+    my $s = 'set ';
75
+    $s .= "$_ = ?, " for @columns;
76
+    $s =~ s/, $//;
77
+    
78
+    return [$s, \@columns];
79
+}
80
+
81
+sub _basic {
82
+    my ($name, $column) = @_;
83
+    
84
+    # Check arguments
85
+    croak qq{Column name must be specified in tag "{$name }" } . _subname
86
+      unless $column;
87
+    
88
+    return ["$column $name ?", [$column]];
89
+}
90
+
91
+1;
92
+
93
+=head1 NAME
94
+
95
+DBIx::Custom::Tag - DEPRECATED!
96
+
97
+=cut
98
+
+41
DBIx-Custom-0.1711/lib/DBIx/Custom/Util.pm
... ...
@@ -0,0 +1,41 @@
1
+package DBIx::Custom::Util;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use base 'Exporter';
7
+
8
+our @EXPORT_OK = qw/_array_to_hash _subname/;
9
+
10
+sub _array_to_hash {
11
+    my $array = shift;
12
+    
13
+    return $array if ref $array eq 'HASH';
14
+    return unless $array;
15
+    
16
+    my $hash = {};
17
+    
18
+    for (my $i = 0; $i < @$array; $i += 2) {
19
+        my $key = $array->[$i];
20
+        my $f = $array->[$i + 1];
21
+        
22
+        if (ref $key eq 'ARRAY') {
23
+            foreach my $k (@$key) {
24
+                $hash->{$k} = $f;
25
+            }
26
+        }
27
+        else {
28
+            $hash->{$key} = $f;
29
+        }
30
+    }
31
+    return $hash;
32
+}
33
+
34
+sub _subname { '(' . (caller 1)[3] . ')' }
35
+
36
+1;
37
+
38
+=head1 NAME
39
+
40
+DBIx::Custom::Util - Utility class
41
+
+208
DBIx-Custom-0.1711/lib/DBIx/Custom/Where.pm
... ...
@@ -0,0 +1,208 @@
1
+package DBIx::Custom::Where;
2
+use Object::Simple -base;
3
+
4
+use Carp 'croak';
5
+use DBIx::Custom::Util '_subname';
6
+use overload 'bool' => sub {1}, fallback => 1;
7
+use overload '""' => sub { shift->to_string }, fallback => 1;
8
+
9
+# Carp trust relationship
10
+push @DBIx::Custom::CARP_NOT, __PACKAGE__;
11
+
12
+has [qw/dbi param/],
13
+    clause => sub { [] };
14
+
15
+sub new {
16
+    my $self = shift->SUPER::new(@_);
17
+    
18
+    # Check attribute names
19
+    my @attrs = keys %$self;
20
+    foreach my $attr (@attrs) {
21
+        croak qq{"$attr" is invalid attribute name (} . _subname . ")"
22
+          unless $self->can($attr);
23
+    }
24
+    
25
+    return $self;
26
+}
27
+
28
+sub to_string {
29
+    my $self = shift;
30
+    
31
+    # Check if column name is safety character;
32
+    my $safety = $self->dbi->safety_character;
33
+    if (ref $self->param eq 'HASH') {
34
+        foreach my $column (keys %{$self->param}) {
35
+            croak qq{"$column" is not safety column name (} . _subname . ")"
36
+              unless $column =~ /^[$safety\.]+$/;
37
+        }
38
+    }
39
+    # Clause
40
+    my $clause = $self->clause;
41
+    $clause = ['and', $clause] unless ref $clause eq 'ARRAY';
42
+    $clause->[0] = 'and' unless @$clause;
43
+
44
+    # Parse
45
+    my $where = [];
46
+    my $count = {};
47
+    $self->_parse($clause, $where, $count, 'and');
48
+    
49
+    # Stringify
50
+    unshift @$where, 'where' if @$where;
51
+    return join(' ', @$where);
52
+}
53
+
54
+our %VALID_OPERATIONS = map { $_ => 1 } qw/and or/;
55
+sub _parse {
56
+    my ($self, $clause, $where, $count, $op) = @_;
57
+    
58
+    # Array
59
+    if (ref $clause eq 'ARRAY') {
60
+        
61
+        # Start
62
+        push @$where, '(';
63
+        
64
+        # Operation
65
+        my $op = $clause->[0] || '';
66
+        croak qq{First argument must be "and" or "or" in where clause } .
67
+              qq{"$op" is passed} . _subname . ")"
68
+          unless $VALID_OPERATIONS{$op};
69
+        
70
+        my $pushed_array;
71
+        # Parse internal clause
72
+        for (my $i = 1; $i < @$clause; $i++) {
73
+            my $pushed = $self->_parse($clause->[$i], $where, $count, $op);
74
+            push @$where, $op if $pushed;
75
+            $pushed_array = 1 if $pushed;
76
+        }
77
+        pop @$where if $where->[-1] eq $op;
78
+        
79
+        # Undo
80
+        if ($where->[-1] eq '(') {
81
+            pop @$where;
82
+            pop @$where if ($where->[-1] || '') eq $op;
83
+        }
84
+        # End
85
+        else { push @$where, ')' }
86
+        
87
+        return $pushed_array;
88
+    }
89
+    
90
+    # String
91
+    else {
92
+        # Pushed
93
+        my $pushed;
94
+        
95
+        # Column
96
+        my $columns = $self->dbi->query_builder->build_query($clause)->columns;
97
+        if (@$columns == 0) {
98
+            push @$where, $clause;
99
+            $pushed = 1;
100
+            return $pushed;
101
+        }
102
+        elsif (@$columns != 1) {
103
+            croak qq{Each part contains one column name: "$clause" (}
104
+                  . _subname . ")";
105
+        }
106
+        
107
+        # Remove quote
108
+        my $column = $columns->[0];
109
+        if (my $q = $self->dbi->_quote) {
110
+            $q = quotemeta($q);
111
+            $column =~ s/[$q]//g;
112
+        }
113
+        
114
+        # Check safety
115
+        my $safety = $self->dbi->safety_character;
116
+        croak qq{"$column" is not safety column name (} . _subname . ")"
117
+          unless $column =~ /^[$safety\.]+$/;
118
+        
119
+        # Column count up
120
+        my $count = ++$count->{$column};
121
+        
122
+        # Push
123
+        my $param = $self->param;
124
+        if (ref $param eq 'HASH') {
125
+            if (exists $param->{$column}) {
126
+                if (ref $param->{$column} eq 'ARRAY') {
127
+                    $pushed = 1
128
+                      if  exists $param->{$column}->[$count - 1]
129
+                       && ref $param->{$column}->[$count - 1] ne 'DBIx::Custom::NotExists';
130
+                } 
131
+                elsif ($count == 1) {
132
+                    $pushed = 1;
133
+                }
134
+            }
135
+            push @$where, $clause if $pushed;
136
+        }
137
+        elsif (!defined $param) {
138
+            push @$where, $clause;
139
+            $pushed = 1;
140
+        }
141
+        else {
142
+            croak "Parameter must be hash reference or undfined value ("
143
+                . _subname . ")"
144
+        }
145
+        return $pushed;
146
+    }
147
+    return;
148
+}
149
+
150
+1;
151
+
152
+=head1 NAME
153
+
154
+DBIx::Custom::Where - Where clause
155
+
156
+=head1 SYNOPSYS
157
+
158
+    my $where = DBIx::Custom::Where->new;
159
+    my $string_where = "$where";
160
+
161
+=head1 ATTRIBUTES
162
+
163
+=head2 C<clause>
164
+
165
+    my $clause = $where->clause;
166
+    $where = $where->clause(
167
+        ['and',
168
+            'title = :title', 
169
+            ['or', 'date < :date', 'date > :date']
170
+        ]
171
+    );
172
+
173
+Where clause. Above one is expanded to the following SQL by to_string
174
+If all parameter names is exists.
175
+
176
+    "where ( title = :title and ( date < :date or date > :date ) )"
177
+
178
+=head2 C<param>
179
+
180
+    my $param = $where->param;
181
+    $where = $where->param({
182
+        title => 'Perl',
183
+        date => ['2010-11-11', '2011-03-05'],
184
+    });
185
+
186
+=head2 C<dbi>
187
+
188
+    my $dbi = $where->dbi;
189
+    $where = $where->dbi($dbi);
190
+
191
+L<DBIx::Custom> object.
192
+
193
+=head1 METHODS
194
+
195
+L<DBIx::Custom::Where> inherits all methods from L<Object::Simple>
196
+and implements the following new ones.
197
+
198
+=head2 C<to_string>
199
+
200
+    $where->to_string;
201
+
202
+Convert where clause to string.
203
+
204
+double quote is override to execute C<to_string> method.
205
+
206
+    my $string_where = "$where";
207
+
208
+=cut
+11
DBIx-Custom-0.1711/t/basic-quote.t
... ...
@@ -0,0 +1,11 @@
1
+# Change quote for tests
2
+use DBIx::Custom;
3
+{
4
+    package DBIx::Custom;
5
+    no warnings 'redefine';
6
+    sub quote { '""' }
7
+}
8
+
9
+use FindBin;
10
+
11
+require "$FindBin::Bin/basic.t";
+3750
DBIx-Custom-0.1711/t/basic.t
... ...
@@ -0,0 +1,3750 @@
1
+use Test::More;
2
+use strict;
3
+use warnings;
4
+use utf8;
5
+use Encode qw/encode_utf8 decode_utf8/;
6
+use FindBin;
7
+use lib "$FindBin::Bin/basic";
8
+
9
+BEGIN {
10
+    eval { require DBD::SQLite; 1 }
11
+        or plan skip_all => 'DBD::SQLite required';
12
+    eval { DBD::SQLite->VERSION >= 1.25 }
13
+        or plan skip_all => 'DBD::SQLite >= 1.25 required';
14
+
15
+    plan 'no_plan';
16
+    use_ok('DBIx::Custom');
17
+}
18
+
19
+$SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /DEPRECATED/};
20
+sub test { print "# $_[0]\n" }
21
+
22
+# Constant
23
+my %memory = (dsn => 'dbi:SQLite:dbname=:memory:');
24
+my $create_table_default = 'create table table1 (key1 char(255), key2 char(255));';
25
+
26
+# Variables
27
+my $builder;
28
+my $datas;
29
+my $dbi;
30
+my $sth;
31
+my $source;
32
+my @sources;
33
+my $select_source;
34
+my $insert_source;
35
+my $update_source;
36
+my $param;
37
+my $params;
38
+my $sql;
39
+my $result;
40
+my $row;
41
+my @rows;
42
+my $rows;
43
+my $query;
44
+my @queries;
45
+my $select_query;
46
+my $insert_query;
47
+my $update_query;
48
+my $ret_val;
49
+my $infos;
50
+my $model;
51
+my $model2;
52
+my $where;
53
+my $update_param;
54
+my $insert_param;
55
+my $join;
56
+
57
+# Prepare table
58
+$dbi = DBIx::Custom->connect(%memory);
59
+$dbi->execute($create_table_default);
60
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
61
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
62
+
63
+test 'DBIx::Custom::Result test';
64
+$source = "select key1, key2 from table1";
65
+$query = $dbi->create_query($source);
66
+$result = $dbi->execute($query);
67
+
68
+@rows = ();
69
+while (my $row = $result->fetch) {
70
+    push @rows, [@$row];
71
+}
72
+is_deeply(\@rows, [[1, 2], [3, 4]], "fetch");
73
+
74
+$result = $dbi->execute($query);
75
+@rows = ();
76
+while (my $row = $result->fetch_hash) {
77
+    push @rows, {%$row};
78
+}
79
+is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "fetch_hash");
80
+
81
+$result = $dbi->execute($query);
82
+$rows = $result->fetch_all;
83
+is_deeply($rows, [[1, 2], [3, 4]], "fetch_all");
84
+
85
+$result = $dbi->execute($query);
86
+$rows = $result->fetch_hash_all;
87
+is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "all");
88
+
89
+test 'Insert query return value';
90
+$dbi->execute('drop table table1');
91
+$dbi->execute($create_table_default);
92
+$source = "insert into table1 {insert_param key1 key2}";
93
+$query = $dbi->execute($source, {}, query => 1);
94
+$ret_val = $dbi->execute($query, param => {key1 => 1, key2 => 2});
95
+ok($ret_val);
96
+
97
+
98
+test 'Direct query';
99
+$dbi->execute('drop table table1');
100
+$dbi->execute($create_table_default);
101
+$insert_source = "insert into table1 {insert_param key1 key2}";
102
+$dbi->execute($insert_source, param => {key1 => 1, key2 => 2});
103
+$result = $dbi->execute('select * from table1;');
104
+$rows = $result->all;
105
+is_deeply($rows, [{key1 => 1, key2 => 2}]);
106
+
107
+test 'Filter basic';
108
+$dbi->execute('drop table table1');
109
+$dbi->execute($create_table_default);
110
+$dbi->register_filter(twice       => sub { $_[0] * 2}, 
111
+                    three_times => sub { $_[0] * 3});
112
+
113
+$insert_source  = "insert into table1 {insert_param key1 key2};";
114
+$insert_query = $dbi->execute($insert_source, {}, query => 1);
115
+$insert_query->filter({key1 => 'twice'});
116
+$dbi->execute($insert_query, param => {key1 => 1, key2 => 2});
117
+$result = $dbi->execute('select * from table1;');
118
+$rows = $result->filter({key2 => 'three_times'})->all;
119
+is_deeply($rows, [{key1 => 2, key2 => 6}], "filter fetch_filter");
120
+$dbi->execute('drop table table1');
121
+
122
+test 'Filter in';
123
+$dbi->execute($create_table_default);
124
+$insert_source  = "insert into table1 {insert_param key1 key2};";
125
+$insert_query = $dbi->execute($insert_source, {}, query => 1);
126
+$dbi->execute($insert_query, param => {key1 => 2, key2 => 4});
127
+$select_source = "select * from table1 where {in table1.key1 2} and {in table1.key2 2}";
128
+$select_query = $dbi->execute($select_source,{}, query => 1);
129
+$select_query->filter({'table1.key1' => 'twice'});
130
+$result = $dbi->execute($select_query, param => {'table1.key1' => [1,5], 'table1.key2' => [2,4]});
131
+$rows = $result->all;
132
+is_deeply($rows, [{key1 => 2, key2 => 4}], "filter");
133
+
134
+test 'DBIx::Custom::SQLTemplate basic tag';
135
+$dbi->execute('drop table table1');
136
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
137
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
138
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
139
+
140
+$source = "select * from table1 where key1 = :key1 and {<> key2} and {< key3} and {> key4} and {>= key5};";
141
+$query = $dbi->execute($source, {}, query => 1);
142
+$result = $dbi->execute($query, param => {key1 => 1, key2 => 3, key3 => 4, key4 => 3, key5 => 5});
143
+$rows = $result->all;
144
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "basic tag1");
145
+
146
+$source = "select * from table1 where key1 = :key1 and {<> key2} and {< key3} and {> key4} and {>= key5};";
147
+$query = $dbi->execute($source, {}, query => 1);
148
+$result = $dbi->execute($query, {key1 => 1, key2 => 3, key3 => 4, key4 => 3, key5 => 5});
149
+$rows = $result->all;
150
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "basic tag1");
151
+
152
+$source = "select * from table1 where {<= key1} and {like key2};";
153
+$query = $dbi->execute($source, {}, query => 1);
154
+$result = $dbi->execute($query, param => {key1 => 1, key2 => '%2%'});
155
+$rows = $result->all;
156
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "basic tag2");
157
+
158
+test 'DIB::Custom::SQLTemplate in tag';
159
+$dbi->execute('drop table table1');
160
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
161
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
162
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
163
+
164
+$source = "select * from table1 where {in key1 2};";
165
+$query = $dbi->execute($source, {}, query => 1);
166
+$result = $dbi->execute($query, param => {key1 => [9, 1]});
167
+$rows = $result->all;
168
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "basic");
169
+
170
+test 'DBIx::Custom::SQLTemplate insert tag';
171
+$dbi->execute("delete from table1");
172
+$insert_source = 'insert into table1 {insert_param key1 key2 key3 key4 key5}';
173
+$dbi->execute($insert_source, param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
174
+
175
+$result = $dbi->execute('select * from table1;');
176
+$rows = $result->all;
177
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}], "basic");
178
+
179
+test 'DBIx::Custom::SQLTemplate update tag';
180
+$dbi->execute("delete from table1");
181
+$insert_source = "insert into table1 {insert_param key1 key2 key3 key4 key5}";
182
+$dbi->execute($insert_source, param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
183
+$dbi->execute($insert_source, param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
184
+
185
+$update_source = 'update table1 {update_param key1 key2 key3 key4} where {= key5}';
186
+$dbi->execute($update_source, param => {key1 => 1, key2 => 1, key3 => 1, key4 => 1, key5 => 5});
187
+
188
+$result = $dbi->execute('select * from table1;');
189
+$rows = $result->all;
190
+is_deeply($rows, [{key1 => 1, key2 => 1, key3 => 1, key4 => 1, key5 => 5},
191
+                  {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10}], "basic");
192
+
193
+
194
+test 'Named placeholder';
195
+$dbi->execute('drop table table1');
196
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
197
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
198
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
199
+
200
+$source = "select * from table1 where key1 = :key1 and key2 = :key2";
201
+$result = $dbi->execute($source, param => {key1 => 1, key2 => 2});
202
+$rows = $result->all;
203
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}]);
204
+
205
+$source = "select * from table1 where key1 = \n:key1\n and key2 = :key2";
206
+$result = $dbi->execute($source, param => {key1 => 1, key2 => 2});
207
+$rows = $result->all;
208
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}]);
209
+
210
+$source = "select * from table1 where key1 = :key1 or key1 = :key1";
211
+$result = $dbi->execute($source, param => {key1 => [1, 2]});
212
+$rows = $result->all;
213
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}]);
214
+
215
+$source = "select * from table1 where key1 = :table1.key1 and key2 = :table1.key2";
216
+$result = $dbi->execute(
217
+    $source,
218
+    param => {'table1.key1' => 1, 'table1.key2' => 1},
219
+    filter => {'table1.key2' => sub { $_[0] * 2 }}
220
+);
221
+$rows = $result->all;
222
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}]);
223
+
224
+$dbi->execute('drop table table1');
225
+$dbi->execute($create_table_default);
226
+$dbi->insert(table => 'table1', param => {key1 => '2011-10-14 12:19:18', key2 => 2});
227
+$source = "select * from table1 where key1 = '2011-10-14 12:19:18' and key2 = :key2";
228
+$result = $dbi->execute(
229
+    $source,
230
+    param => {'key2' => 2},
231
+);
232
+
233
+$rows = $result->all;
234
+is_deeply($rows, [{key1 => '2011-10-14 12:19:18', key2 => 2}]);
235
+
236
+$dbi = DBIx::Custom->connect(%memory);
237
+$dbi->execute($create_table_default);
238
+$dbi->insert(table => 'table1', param => {key1 => 'a:b c:d', key2 => 2});
239
+$source = "select * from table1 where key1 = 'a\\:b c\\:d' and key2 = :key2";
240
+$result = $dbi->execute(
241
+    $source,
242
+    param => {'key2' => 2},
243
+);
244
+$rows = $result->all;
245
+is_deeply($rows, [{key1 => 'a:b c:d', key2 => 2}]);
246
+
247
+
248
+test 'Error case';
249
+eval {DBIx::Custom->connect(dsn => 'dbi:SQLit')};
250
+ok($@, "connect error");
251
+
252
+$dbi = DBIx::Custom->connect(%memory);
253
+eval{$dbi->execute("{p }", {}, query => 1)};
254
+ok($@, "create_query invalid SQL template");
255
+
256
+test 'insert';
257
+$dbi = DBIx::Custom->connect(%memory);
258
+$dbi->execute($create_table_default);
259
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
260
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
261
+$result = $dbi->execute('select * from table1;');
262
+$rows   = $result->all;
263
+is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "basic");
264
+
265
+$dbi->execute('delete from table1');
266
+$dbi->register_filter(
267
+    twice       => sub { $_[0] * 2 },
268
+    three_times => sub { $_[0] * 3 }
269
+);
270
+$dbi->default_bind_filter('twice');
271
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2}, filter => {key1 => 'three_times'});
272
+$result = $dbi->execute('select * from table1;');
273
+$rows   = $result->all;
274
+is_deeply($rows, [{key1 => 3, key2 => 4}], "filter");
275
+$dbi->default_bind_filter(undef);
276
+
277
+$dbi->execute('drop table table1');
278
+$dbi->execute($create_table_default);
279
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2}, append => '   ');
280
+$rows = $dbi->select(table => 'table1')->all;
281
+is_deeply($rows, [{key1 => 1, key2 => 2}], 'insert append');
282
+
283
+eval{$dbi->insert(table => 'table1', noexist => 1)};
284
+like($@, qr/noexist/, "invalid");
285
+
286
+eval{$dbi->insert(table => 'table', param => {';' => 1})};
287
+like($@, qr/safety/);
288
+
289
+$dbi = DBIx::Custom->connect(%memory);
290
+$dbi->quote('"');
291
+$dbi->execute('create table "table" ("select")');
292
+$dbi->apply_filter('table', select => {out => sub { $_[0] * 2}});
293
+$dbi->insert(table => 'table', param => {select => 1});
294
+$result = $dbi->execute('select * from "table"');
295
+$rows   = $result->all;
296
+is_deeply($rows, [{select => 2}], "reserved word");
297
+
298
+$dbi = DBIx::Custom->connect(%memory);
299
+$dbi->execute($create_table_default);
300
+$dbi->insert({key1 => 1, key2 => 2}, table => 'table1');
301
+$dbi->insert({key1 => 3, key2 => 4}, table => 'table1');
302
+$result = $dbi->execute('select * from table1;');
303
+$rows   = $result->all;
304
+is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "basic");
305
+
306
+$dbi = DBIx::Custom->connect(%memory);
307
+$dbi->execute("create table table1 (key1 char(255), key2 char(255), primary key(key1))");
308
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
309
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 4}, prefix => 'or replace');
310
+$result = $dbi->execute('select * from table1;');
311
+$rows   = $result->all;
312
+is_deeply($rows, [{key1 => 1, key2 => 4}], "basic");
313
+
314
+$dbi = DBIx::Custom->connect(%memory);
315
+$dbi->execute($create_table_default);
316
+$dbi->insert(table => 'table1', param => {key1 => \"'1'", key2 => 2});
317
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
318
+$result = $dbi->execute('select * from table1;');
319
+$rows   = $result->all;
320
+is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "basic");
321
+
322
+test 'update';
323
+$dbi = DBIx::Custom->connect(%memory);
324
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
325
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
326
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
327
+$dbi->update(table => 'table1', param => {key2 => 11}, where => {key1 => 1});
328
+$result = $dbi->execute('select * from table1;');
329
+$rows   = $result->all;
330
+is_deeply($rows, [{key1 => 1, key2 => 11, key3 => 3, key4 => 4, key5 => 5},
331
+                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
332
+                  "basic");
333
+                  
334
+$dbi->execute("delete from table1");
335
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
336
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
337
+$dbi->update(table => 'table1', param => {key2 => 12}, where => {key2 => 2, key3 => 3});
338
+$result = $dbi->execute('select * from table1;');
339
+$rows   = $result->all;
340
+is_deeply($rows, [{key1 => 1, key2 => 12, key3 => 3, key4 => 4, key5 => 5},
341
+                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
342
+                  "update key same as search key");
343
+
344
+$dbi->update(table => 'table1', param => {key2 => [12]}, where => {key2 => 2, key3 => 3});
345
+$result = $dbi->execute('select * from table1;');
346
+$rows   = $result->all;
347
+is_deeply($rows, [{key1 => 1, key2 => 12, key3 => 3, key4 => 4, key5 => 5},
348
+                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
349
+                  "update key same as search key : param is array ref");
350
+
351
+$dbi->execute("delete from table1");
352
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
353
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
354
+$dbi->register_filter(twice => sub { $_[0] * 2 });
355
+$dbi->update(table => 'table1', param => {key2 => 11}, where => {key1 => 1},
356
+              filter => {key2 => sub { $_[0] * 2 }});
357
+$result = $dbi->execute('select * from table1;');
358
+$rows   = $result->all;
359
+is_deeply($rows, [{key1 => 1, key2 => 22, key3 => 3, key4 => 4, key5 => 5},
360
+                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
361
+                  "filter");
362
+
363
+$result = $dbi->update(table => 'table1', param => {key2 => 11}, where => {key1 => 1}, append => '   ');
364
+
365
+eval{$dbi->update(table => 'table1', where => {key1 => 1}, noexist => 1)};
366
+like($@, qr/noexist/, "invalid");
367
+
368
+eval{$dbi->update(table => 'table1')};
369
+like($@, qr/where/, "not contain where");
370
+
371
+$dbi = DBIx::Custom->connect(%memory);
372
+$dbi->execute($create_table_default);
373
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
374
+$where = $dbi->where;
375
+$where->clause(['and', 'key1 = :key1', 'key2 = :key2']);
376
+$where->param({key1 => 1, key2 => 2});
377
+$dbi->update(table => 'table1', param => {key1 => 3}, where => $where);
378
+$result = $dbi->select(table => 'table1');
379
+is_deeply($result->all, [{key1 => 3, key2 => 2}], 'update() where');
380
+
381
+$dbi = DBIx::Custom->connect(%memory);
382
+$dbi->execute($create_table_default);
383
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
384
+$dbi->update(
385
+    table => 'table1',
386
+    param => {key1 => 3},
387
+    where => [
388
+        ['and', 'key1 = :key1', 'key2 = :key2'],
389
+        {key1 => 1, key2 => 2}
390
+    ]
391
+);
392
+$result = $dbi->select(table => 'table1');
393
+is_deeply($result->all, [{key1 => 3, key2 => 2}], 'update() where');
394
+
395
+$dbi = DBIx::Custom->connect(%memory);
396
+$dbi->execute($create_table_default);
397
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
398
+$where = $dbi->where;
399
+$where->clause(['and', 'key2 = :key2']);
400
+$where->param({key2 => 2});
401
+$dbi->update(table => 'table1', param => {key1 => 3}, where => $where);
402
+$result = $dbi->select(table => 'table1');
403
+is_deeply($result->all, [{key1 => 3, key2 => 2}], 'update() where');
404
+
405
+eval{$dbi->update(table => 'table1', param => {';' => 1})};
406
+like($@, qr/safety/);
407
+
408
+eval{$dbi->update(table => 'table1', param => {'key1' => 1}, where => {';' => 1})};
409
+like($@, qr/safety/);
410
+
411
+$dbi = DBIx::Custom->connect(%memory);
412
+$dbi->quote('"');
413
+$dbi->execute('create table "table" ("select", "update")');
414
+$dbi->apply_filter('table', select => {out => sub { $_[0] * 2}});
415
+$dbi->apply_filter('table', update => {out => sub { $_[0] * 3}});
416
+$dbi->insert(table => 'table', param => {select => 1});
417
+$dbi->update(table => 'table', where => {select => 1}, param => {update => 2});
418
+$result = $dbi->execute('select * from "table"');
419
+$rows   = $result->all;
420
+is_deeply($rows, [{select => 2, update => 6}], "reserved word");
421
+
422
+eval {$dbi->update_all(table => 'table', param => {';' => 2}) };
423
+like($@, qr/safety/);
424
+
425
+$dbi = DBIx::Custom->connect(%memory);
426
+$dbi->reserved_word_quote('"');
427
+$dbi->execute('create table "table" ("select", "update")');
428
+$dbi->apply_filter('table', select => {out => sub { $_[0] * 2}});
429
+$dbi->apply_filter('table', update => {out => sub { $_[0] * 3}});
430
+$dbi->insert(table => 'table', param => {select => 1});
431
+$dbi->update(table => 'table', where => {'table.select' => 1}, param => {update => 2});
432
+$result = $dbi->execute('select * from "table"');
433
+$rows   = $result->all;
434
+is_deeply($rows, [{select => 2, update => 6}], "reserved word");
435
+
436
+$dbi = DBIx::Custom->connect(%memory);
437
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
438
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
439
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
440
+$dbi->update({key2 => 11}, table => 'table1', where => {key1 => 1});
441
+$result = $dbi->execute('select * from table1;');
442
+$rows   = $result->all;
443
+is_deeply($rows, [{key1 => 1, key2 => 11, key3 => 3, key4 => 4, key5 => 5},
444
+                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
445
+                  "basic");
446
+
447
+$dbi = DBIx::Custom->connect(%memory);
448
+$dbi->execute("create table table1 (key1 char(255), key2 char(255), primary key(key1))");
449
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
450
+$dbi->update(table => 'table1', param => {key2 => 4},
451
+  where => {key1 => 1}, prefix => 'or replace');
452
+$result = $dbi->execute('select * from table1;');
453
+$rows   = $result->all;
454
+is_deeply($rows, [{key1 => 1, key2 => 4}], "basic");
455
+
456
+$dbi = DBIx::Custom->connect(%memory);
457
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
458
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
459
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
460
+$dbi->update(table => 'table1', param => {key2 => \"'11'"}, where => {key1 => 1});
461
+$result = $dbi->execute('select * from table1;');
462
+$rows   = $result->all;
463
+is_deeply($rows, [{key1 => 1, key2 => 11, key3 => 3, key4 => 4, key5 => 5},
464
+                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
465
+                  "basic");
466
+
467
+test 'update_all';
468
+$dbi = DBIx::Custom->connect(%memory);
469
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
470
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
471
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
472
+$dbi->register_filter(twice => sub { $_[0] * 2 });
473
+$dbi->update_all(table => 'table1', param => {key2 => 10}, filter => {key2 => 'twice'});
474
+$result = $dbi->execute('select * from table1;');
475
+$rows   = $result->all;
476
+is_deeply($rows, [{key1 => 1, key2 => 20, key3 => 3, key4 => 4, key5 => 5},
477
+                  {key1 => 6, key2 => 20, key3 => 8, key4 => 9, key5 => 10}],
478
+                  "filter");
479
+
480
+
481
+test 'delete';
482
+$dbi = DBIx::Custom->connect(%memory);
483
+$dbi->execute($create_table_default);
484
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
485
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
486
+$dbi->delete(table => 'table1', where => {key1 => 1});
487
+$result = $dbi->execute('select * from table1;');
488
+$rows   = $result->all;
489
+is_deeply($rows, [{key1 => 3, key2 => 4}], "basic");
490
+
491
+$dbi->execute("delete from table1;");
492
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
493
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
494
+$dbi->register_filter(twice => sub { $_[0] * 2 });
495
+$dbi->delete(table => 'table1', where => {key2 => 1}, filter => {key2 => 'twice'});
496
+$result = $dbi->execute('select * from table1;');
497
+$rows   = $result->all;
498
+is_deeply($rows, [{key1 => 3, key2 => 4}], "filter");
499
+
500
+$dbi->delete(table => 'table1', where => {key1 => 1}, append => '   ');
501
+
502
+$dbi->delete_all(table => 'table1');
503
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
504
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
505
+$dbi->delete(table => 'table1', where => {key1 => 1, key2 => 2});
506
+$rows = $dbi->select(table => 'table1')->all;
507
+is_deeply($rows, [{key1 => 3, key2 => 4}], "delete multi key");
508
+
509
+eval{$dbi->delete(table => 'table1', where => {key1 => 1}, noexist => 1)};
510
+like($@, qr/noexist/, "invalid");
511
+
512
+$dbi = DBIx::Custom->connect(%memory);
513
+$dbi->execute($create_table_default);
514
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
515
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
516
+$where = $dbi->where;
517
+$where->clause(['and', 'key1 = :key1', 'key2 = :key2']);
518
+$where->param({ke1 => 1, key2 => 2});
519
+$dbi->delete(table => 'table1', where => $where);
520
+$result = $dbi->select(table => 'table1');
521
+is_deeply($result->all, [{key1 => 3, key2 => 4}], 'delete() where');
522
+
523
+$dbi = DBIx::Custom->connect(%memory);
524
+$dbi->execute($create_table_default);
525
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
526
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
527
+$dbi->delete(
528
+    table => 'table1',
529
+    where => [
530
+        ['and', 'key1 = :key1', 'key2 = :key2'],
531
+        {ke1 => 1, key2 => 2}
532
+    ]
533
+);
534
+$result = $dbi->select(table => 'table1');
535
+is_deeply($result->all, [{key1 => 3, key2 => 4}], 'delete() where');
536
+
537
+$dbi = DBIx::Custom->connect(%memory);
538
+$dbi->execute("create table table1 (key1 char(255), key2 char(255), primary key(key1))");
539
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
540
+$dbi->delete(table => 'table1', where => {key1 => 1}, prefix => '    ');
541
+$result = $dbi->execute('select * from table1;');
542
+$rows   = $result->all;
543
+is_deeply($rows, [], "basic");
544
+
545
+test 'delete error';
546
+$dbi = DBIx::Custom->connect(%memory);
547
+$dbi->execute($create_table_default);
548
+eval{$dbi->delete(table => 'table1')};
549
+like($@, qr/"where" must be specified/,
550
+         "where key-value pairs not specified");
551
+
552
+eval{$dbi->delete(table => 'table1', where => {';' => 1})};
553
+like($@, qr/safety/);
554
+
555
+$dbi = DBIx::Custom->connect(%memory);
556
+$dbi->quote('"');
557
+$dbi->execute('create table "table" ("select", "update")');
558
+$dbi->apply_filter('table', select => {out => sub { $_[0] * 2}});
559
+$dbi->insert(table => 'table', param => {select => 1});
560
+$dbi->delete(table => 'table', where => {select => 1});
561
+$result = $dbi->execute('select * from "table"');
562
+$rows   = $result->all;
563
+is_deeply($rows, [], "reserved word");
564
+
565
+test 'delete_all';
566
+$dbi = DBIx::Custom->connect(%memory);
567
+$dbi->execute($create_table_default);
568
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
569
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
570
+$dbi->delete_all(table => 'table1');
571
+$result = $dbi->execute('select * from table1;');
572
+$rows   = $result->all;
573
+is_deeply($rows, [], "basic");
574
+
575
+
576
+test 'select';
577
+$dbi = DBIx::Custom->connect(%memory);
578
+$dbi->execute($create_table_default);
579
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
580
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
581
+$rows = $dbi->select(table => 'table1')->all;
582
+is_deeply($rows, [{key1 => 1, key2 => 2},
583
+                  {key1 => 3, key2 => 4}], "table");
584
+
585
+$rows = $dbi->select(table => 'table1', column => ['key1'])->all;
586
+is_deeply($rows, [{key1 => 1}, {key1 => 3}], "table and columns and where key");
587
+
588
+$rows = $dbi->select(table => 'table1', where => {key1 => 1})->all;
589
+is_deeply($rows, [{key1 => 1, key2 => 2}], "table and columns and where key");
590
+
591
+$rows = $dbi->select(table => 'table1', column => ['key1'], where => {key1 => 3})->all;
592
+is_deeply($rows, [{key1 => 3}], "table and columns and where key");
593
+
594
+$rows = $dbi->select(table => 'table1', append => "order by key1 desc limit 1")->all;
595
+is_deeply($rows, [{key1 => 3, key2 => 4}], "append statement");
596
+
597
+$dbi->register_filter(decrement => sub { $_[0] - 1 });
598
+$rows = $dbi->select(table => 'table1', where => {key1 => 2}, filter => {key1 => 'decrement'})
599
+            ->all;
600
+is_deeply($rows, [{key1 => 1, key2 => 2}], "filter");
601
+
602
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
603
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 5});
604
+$rows = $dbi->select(
605
+    table => [qw/table1 table2/],
606
+    column => 'table1.key1 as table1_key1, table2.key1 as table2_key1, key2, key3',
607
+    where   => {'table1.key2' => 2},
608
+    relation  => {'table1.key1' => 'table2.key1'}
609
+)->all;
610
+is_deeply($rows, [{table1_key1 => 1, table2_key1 => 1, key2 => 2, key3 => 5}], "relation : exists where");
611
+
612
+$rows = $dbi->select(
613
+    table => [qw/table1 table2/],
614
+    column => ['table1.key1 as table1_key1', 'table2.key1 as table2_key1', 'key2', 'key3'],
615
+    relation  => {'table1.key1' => 'table2.key1'}
616
+)->all;
617
+is_deeply($rows, [{table1_key1 => 1, table2_key1 => 1, key2 => 2, key3 => 5}], "relation : no exists where");
618
+
619
+eval{$dbi->select(table => 'table1', noexist => 1)};
620
+like($@, qr/noexist/, "invalid");
621
+
622
+$dbi = DBIx::Custom->connect(%memory);
623
+$dbi->quote('"');
624
+$dbi->execute('create table "table" ("select", "update")');
625
+$dbi->apply_filter('table', select => {out => sub { $_[0] * 2}});
626
+$dbi->insert(table => 'table', param => {select => 1, update => 2});
627
+$result = $dbi->select(table => 'table', where => {select => 1});
628
+$rows   = $result->all;
629
+is_deeply($rows, [{select => 2, update => 2}], "reserved word");
630
+
631
+test 'fetch filter';
632
+$dbi = DBIx::Custom->connect(%memory);
633
+$dbi->register_filter(
634
+    twice       => sub { $_[0] * 2 },
635
+    three_times => sub { $_[0] * 3 }
636
+);
637
+$dbi->default_fetch_filter('twice');
638
+$dbi->execute($create_table_default);
639
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
640
+$result = $dbi->select(table => 'table1');
641
+$result->filter({key1 => 'three_times'});
642
+$row = $result->one;
643
+is_deeply($row, {key1 => 3, key2 => 4}, "default_fetch_filter and filter");
644
+
645
+test 'filters';
646
+$dbi = DBIx::Custom->new;
647
+
648
+is($dbi->filters->{decode_utf8}->(encode_utf8('あ')),
649
+   'あ', "decode_utf8");
650
+
651
+is($dbi->filters->{encode_utf8}->('あ'),
652
+   encode_utf8('あ'), "encode_utf8");
653
+
654
+test 'transaction';
655
+$dbi = DBIx::Custom->connect(%memory);
656
+$dbi->execute($create_table_default);
657
+$dbi->dbh->begin_work;
658
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
659
+$dbi->insert(table => 'table1', param => {key1 => 2, key2 => 3});
660
+$dbi->dbh->commit;
661
+$result = $dbi->select(table => 'table1');
662
+is_deeply(scalar $result->all, [{key1 => 1, key2 => 2}, {key1 => 2, key2 => 3}],
663
+          "commit");
664
+
665
+$dbi = DBIx::Custom->connect(%memory);
666
+$dbi->execute($create_table_default);
667
+$dbi->dbh->begin_work(0);
668
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
669
+$dbi->dbh->rollback;
670
+
671
+$result = $dbi->select(table => 'table1');
672
+ok(! $result->fetch_first, "rollback");
673
+
674
+test 'cache';
675
+$dbi = DBIx::Custom->connect(%memory);
676
+$dbi->cache(1);
677
+$dbi->execute($create_table_default);
678
+$source = 'select * from table1 where key1 = :key1 and key2 = :key2;';
679
+$dbi->execute($source, {}, query => 1);
680
+is_deeply($dbi->{_cached}->{$source}, 
681
+          {sql => "select * from table1 where key1 = ? and key2 = ?;", columns => ['key1', 'key2'], tables => []}, "cache");
682
+
683
+$dbi = DBIx::Custom->connect(%memory);
684
+$dbi->execute($create_table_default);
685
+$dbi->{_cached} = {};
686
+$dbi->cache(0);
687
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
688
+is(scalar keys %{$dbi->{_cached}}, 0, 'not cache');
689
+
690
+test 'execute';
691
+$dbi = DBIx::Custom->connect(%memory);
692
+$dbi->execute($create_table_default);
693
+{
694
+    local $Carp::Verbose = 0;
695
+    eval{$dbi->execute('select * frm table1')};
696
+    like($@, qr/\Qselect * frm table1;/, "fail prepare");
697
+    like($@, qr/\.t /, "fail : not verbose");
698
+}
699
+{
700
+    local $Carp::Verbose = 1;
701
+    eval{$dbi->execute('select * frm table1')};
702
+    like($@, qr/Custom.*\.t /s, "fail : verbose");
703
+}
704
+
705
+eval{$dbi->execute('select * from table1', no_exists => 1)};
706
+like($@, qr/wrong/, "invald SQL");
707
+
708
+$query = $dbi->execute('select * from table1 where key1 = :key1', {}, query => 1);
709
+$dbi->dbh->disconnect;
710
+eval{$dbi->execute($query, param => {key1 => {a => 1}})};
711
+ok($@, "execute fail");
712
+
713
+{
714
+    local $Carp::Verbose = 0;
715
+    eval{$dbi->execute('select * from table1 where {0 key1}', {}, query => 1)};
716
+    like($@, qr/\Q.t /, "caller spec : not vebose");
717
+}
718
+{
719
+    local $Carp::Verbose = 1;
720
+    eval{$dbi->execute('select * from table1 where {0 key1}', {}, query => 1)};
721
+    like($@, qr/QueryBuilder.*\.t /s, "caller spec : not vebose");
722
+}
723
+
724
+
725
+test 'transaction';
726
+$dbi = DBIx::Custom->connect(%memory);
727
+$dbi->execute($create_table_default);
728
+
729
+$dbi->begin_work;
730
+
731
+eval {
732
+    $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
733
+    die "Error";
734
+    $dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
735
+};
736
+
737
+$dbi->rollback if $@;
738
+
739
+$result = $dbi->select(table => 'table1');
740
+$rows = $result->all;
741
+is_deeply($rows, [], "rollback");
742
+
743
+$dbi->begin_work;
744
+
745
+eval {
746
+    $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
747
+    $dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
748
+};
749
+
750
+$dbi->commit unless $@;
751
+
752
+$result = $dbi->select(table => 'table1');
753
+$rows = $result->all;
754
+is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "commit");
755
+
756
+$dbi->dbh->{AutoCommit} = 0;
757
+eval{ $dbi->begin_work };
758
+ok($@, "exception");
759
+$dbi->dbh->{AutoCommit} = 1;
760
+
761
+
762
+test 'method';
763
+$dbi = DBIx::Custom->connect(%memory);
764
+$dbi->method(
765
+    one => sub { 1 }
766
+);
767
+$dbi->method(
768
+    two => sub { 2 }
769
+);
770
+$dbi->method({
771
+    twice => sub {
772
+        my $self = shift;
773
+        return $_[0] * 2;
774
+    }
775
+});
776
+
777
+is($dbi->one, 1, "first");
778
+is($dbi->two, 2, "second");
779
+is($dbi->twice(5), 10 , "second");
780
+
781
+eval {$dbi->XXXXXX};
782
+ok($@, "not exists");
783
+
784
+test 'out filter';
785
+$dbi = DBIx::Custom->connect(%memory);
786
+$dbi->execute($create_table_default);
787
+$dbi->register_filter(twice => sub { $_[0] * 2 });
788
+$dbi->register_filter(three_times => sub { $_[0] * 3});
789
+$dbi->apply_filter(
790
+    'table1', 'key1' => {out => 'twice', in => 'three_times'}, 
791
+              'key2' => {out => 'three_times', in => 'twice'});
792
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
793
+$result = $dbi->execute('select * from table1;');
794
+$row   = $result->fetch_hash_first;
795
+is_deeply($row, {key1 => 2, key2 => 6}, "insert");
796
+$result = $dbi->select(table => 'table1');
797
+$row   = $result->one;
798
+is_deeply($row, {key1 => 6, key2 => 12}, "insert");
799
+
800
+$dbi = DBIx::Custom->connect(%memory);
801
+$dbi->execute($create_table_default);
802
+$dbi->register_filter(twice => sub { $_[0] * 2 });
803
+$dbi->register_filter(three_times => sub { $_[0] * 3});
804
+$dbi->apply_filter(
805
+    'table1', 'key1' => {out => 'twice', in => 'three_times'}, 
806
+              'key2' => {out => 'three_times', in => 'twice'});
807
+$dbi->apply_filter(
808
+    'table1', 'key1' => {out => undef}
809
+); 
810
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
811
+$result = $dbi->execute('select * from table1;');
812
+$row   = $result->one;
813
+is_deeply($row, {key1 => 1, key2 => 6}, "insert");
814
+
815
+$dbi = DBIx::Custom->connect(%memory);
816
+$dbi->execute($create_table_default);
817
+$dbi->register_filter(twice => sub { $_[0] * 2 });
818
+$dbi->apply_filter(
819
+    'table1', 'key1' => {out => 'twice', in => 'twice'}
820
+);
821
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2}, filter => {key1 => undef});
822
+$dbi->update(table => 'table1', param => {key1 => 2}, where => {key2 => 2});
823
+$result = $dbi->execute('select * from table1;');
824
+$row   = $result->one;
825
+is_deeply($row, {key1 => 4, key2 => 2}, "update");
826
+
827
+$dbi = DBIx::Custom->connect(%memory);
828
+$dbi->execute($create_table_default);
829
+$dbi->register_filter(twice => sub { $_[0] * 2 });
830
+$dbi->apply_filter(
831
+    'table1', 'key1' => {out => 'twice', in => 'twice'}
832
+);
833
+$dbi->insert(table => 'table1', param => {key1 => 2, key2 => 2}, filter => {key1=> undef});
834
+$dbi->delete(table => 'table1', where => {key1 => 1});
835
+$result = $dbi->execute('select * from table1;');
836
+$rows   = $result->all;
837
+is_deeply($rows, [], "delete");
838
+
839
+$dbi = DBIx::Custom->connect(%memory);
840
+$dbi->execute($create_table_default);
841
+$dbi->register_filter(twice => sub { $_[0] * 2 });
842
+$dbi->apply_filter(
843
+    'table1', 'key1' => {out => 'twice', in => 'twice'}
844
+);
845
+$dbi->insert(table => 'table1', param => {key1 => 2, key2 => 2}, filter => {key1 => undef});
846
+$result = $dbi->select(table => 'table1', where => {key1 => 1});
847
+$result->filter({'key2' => 'twice'});
848
+$rows   = $result->all;
849
+is_deeply($rows, [{key1 => 4, key2 => 4}], "select");
850
+
851
+$dbi = DBIx::Custom->connect(%memory);
852
+$dbi->execute($create_table_default);
853
+$dbi->register_filter(twice => sub { $_[0] * 2 });
854
+$dbi->apply_filter(
855
+    'table1', 'key1' => {out => 'twice', in => 'twice'}
856
+);
857
+$dbi->insert(table => 'table1', param => {key1 => 2, key2 => 2}, filter => {key1 => undef});
858
+$result = $dbi->execute("select * from table1 where key1 = :key1 and key2 = :key2;",
859
+                        param => {key1 => 1, key2 => 2},
860
+                        table => ['table1']);
861
+$rows   = $result->all;
862
+is_deeply($rows, [{key1 => 4, key2 => 2}], "execute");
863
+
864
+$dbi = DBIx::Custom->connect(%memory);
865
+$dbi->execute($create_table_default);
866
+$dbi->register_filter(twice => sub { $_[0] * 2 });
867
+$dbi->apply_filter(
868
+    'table1', 'key1' => {out => 'twice', in => 'twice'}
869
+);
870
+$dbi->insert(table => 'table1', param => {key1 => 2, key2 => 2}, filter => {key1 => undef});
871
+$result = $dbi->execute("select * from {table table1} where key1 = :key1 and key2 = :key2;",
872
+                        param => {key1 => 1, key2 => 2});
873
+$rows   = $result->all;
874
+is_deeply($rows, [{key1 => 4, key2 => 2}], "execute table tag");
875
+
876
+$dbi = DBIx::Custom->connect(%memory);
877
+$dbi->execute($create_table_default);
878
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
879
+$dbi->register_filter(twice => sub { $_[0] * 2 });
880
+$dbi->register_filter(three_times => sub { $_[0] * 3 });
881
+$dbi->apply_filter(
882
+    'table1', 'key2' => {out => 'twice', in => 'twice'}
883
+);
884
+$dbi->apply_filter(
885
+    'table2', 'key3' => {out => 'three_times', in => 'three_times'}
886
+);
887
+$dbi->insert(table => 'table1', param => {key1 => 5, key2 => 2}, filter => {key2 => undef});
888
+$dbi->insert(table => 'table2', param => {key1 => 5, key3 => 6}, filter => {key3 => undef});
889
+$result = $dbi->select(
890
+     table => ['table1', 'table2'],
891
+     column => ['key2', 'key3'],
892
+     where => {'table1.key2' => 1, 'table2.key3' => 2}, relation => {'table1.key1' => 'table2.key1'});
893
+
894
+$result->filter({'key2' => 'twice'});
895
+$rows   = $result->all;
896
+is_deeply($rows, [{key2 => 4, key3 => 18}], "select : join");
897
+
898
+$result = $dbi->select(
899
+     table => ['table1', 'table2'],
900
+     column => ['key2', 'key3'],
901
+     where => {'key2' => 1, 'key3' => 2}, relation => {'table1.key1' => 'table2.key1'});
902
+
903
+$result->filter({'key2' => 'twice'});
904
+$rows   = $result->all;
905
+is_deeply($rows, [{key2 => 4, key3 => 18}], "select : join : omit");
906
+
907
+test 'each_column';
908
+$dbi = DBIx::Custom->connect(%memory);
909
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
910
+$dbi->execute('create table table1 (key1 Date, key2 datetime);');
911
+
912
+$infos = [];
913
+$dbi->each_column(sub {
914
+    my ($self, $table, $column, $cinfo) = @_;
915
+    
916
+    if ($table =~ /^table/) {
917
+         my $info = [$table, $column, $cinfo->{COLUMN_NAME}];
918
+         push @$infos, $info;
919
+    }
920
+});
921
+$infos = [sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] } @$infos];
922
+is_deeply($infos, 
923
+    [
924
+        ['table1', 'key1', 'key1'],
925
+        ['table1', 'key2', 'key2'],
926
+        ['table2', 'key1', 'key1'],
927
+        ['table2', 'key3', 'key3']
928
+    ]
929
+    
930
+);
931
+test 'each_table';
932
+$dbi = DBIx::Custom->connect(%memory);
933
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
934
+$dbi->execute('create table table1 (key1 Date, key2 datetime);');
935
+
936
+$infos = [];
937
+$dbi->each_table(sub {
938
+    my ($self, $table, $table_info) = @_;
939
+    
940
+    if ($table =~ /^table/) {
941
+         my $info = [$table, $table_info->{TABLE_NAME}];
942
+         push @$infos, $info;
943
+    }
944
+});
945
+$infos = [sort { $a->[0] cmp $b->[0] || $a->[1] cmp $b->[1] } @$infos];
946
+is_deeply($infos, 
947
+    [
948
+        ['table1', 'table1'],
949
+        ['table2', 'table2'],
950
+    ]
951
+);
952
+
953
+test 'limit';
954
+$dbi = DBIx::Custom->connect(%memory);
955
+$dbi->execute($create_table_default);
956
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
957
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 4});
958
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 6});
959
+$dbi->register_tag(
960
+    limit => sub {
961
+        my ($count, $offset) = @_;
962
+        
963
+        my $s = '';
964
+        $s .= "limit $count";
965
+        $s .= " offset $offset" if defined $offset;
966
+        
967
+        return [$s, []];
968
+    }
969
+);
970
+$rows = $dbi->select(
971
+  table => 'table1',
972
+  where => {key1 => 1},
973
+  append => "order by key2 {limit 1 0}"
974
+)->all;
975
+is_deeply($rows, [{key1 => 1, key2 => 2}]);
976
+$rows = $dbi->select(
977
+  table => 'table1',
978
+  where => {key1 => 1},
979
+  append => "order by key2 {limit 2 1}"
980
+)->all;
981
+is_deeply($rows, [{key1 => 1, key2 => 4},{key1 => 1, key2 => 6}]);
982
+$rows = $dbi->select(
983
+  table => 'table1',
984
+  where => {key1 => 1},
985
+  append => "order by key2 {limit 1}"
986
+)->all;
987
+is_deeply($rows, [{key1 => 1, key2 => 2}]);
988
+
989
+test 'connect super';
990
+{
991
+    package MyDBI;
992
+    
993
+    use base 'DBIx::Custom';
994
+    sub connect {
995
+        my $self = shift->SUPER::connect(@_);
996
+        
997
+        return $self;
998
+    }
999
+    
1000
+    sub new {
1001
+        my $self = shift->SUPER::new(@_);
1002
+        
1003
+        return $self;
1004
+    }
1005
+}
1006
+
1007
+$dbi = MyDBI->connect(%memory);
1008
+$dbi->execute($create_table_default);
1009
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
1010
+is($dbi->select(table => 'table1')->one->{key1}, 1);
1011
+
1012
+$dbi = MyDBI->new(%memory);
1013
+$dbi->connect;
1014
+$dbi->execute($create_table_default);
1015
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
1016
+is($dbi->select(table => 'table1')->one->{key1}, 1);
1017
+
1018
+{
1019
+    package MyDBI2;
1020
+    
1021
+    use base 'DBIx::Custom';
1022
+    sub connect {
1023
+        my $self = shift->SUPER::new(@_);
1024
+        $self->connect;
1025
+        
1026
+        return $self;
1027
+    }
1028
+}
1029
+
1030
+$dbi = MyDBI->connect(%memory);
1031
+$dbi->execute($create_table_default);
1032
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
1033
+is($dbi->select(table => 'table1')->one->{key1}, 1);
1034
+
1035
+test 'end_filter';
1036
+$dbi = DBIx::Custom->connect(%memory);
1037
+$dbi->execute($create_table_default);
1038
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
1039
+$result = $dbi->select(table => 'table1');
1040
+$result->filter(key1 => sub { $_[0] * 2 }, key2 => sub { $_[0] * 4 });
1041
+$result->end_filter(key1 => sub { $_[0] * 3 }, key2 => sub { $_[0] * 5 });
1042
+$row = $result->fetch_first;
1043
+is_deeply($row, [6, 40]);
1044
+
1045
+$dbi = DBIx::Custom->connect(%memory);
1046
+$dbi->execute($create_table_default);
1047
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
1048
+$result = $dbi->select(table => 'table1');
1049
+$result->filter([qw/key1 key2/] => sub { $_[0] * 2 });
1050
+$result->end_filter([[qw/key1 key2/] => sub { $_[0] * 3 }]);
1051
+$row = $result->fetch_first;
1052
+is_deeply($row, [6, 12]);
1053
+
1054
+$dbi = DBIx::Custom->connect(%memory);
1055
+$dbi->execute($create_table_default);
1056
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
1057
+$result = $dbi->select(table => 'table1');
1058
+$result->filter([[qw/key1 key2/] => sub { $_[0] * 2 }]);
1059
+$result->end_filter([qw/key1 key2/] => sub { $_[0] * 3 });
1060
+$row = $result->fetch_first;
1061
+is_deeply($row, [6, 12]);
1062
+
1063
+$dbi->register_filter(five_times => sub { $_[0] * 5 });
1064
+$result = $dbi->select(table => 'table1');
1065
+$result->filter(key1 => sub { $_[0] * 2 }, key2 => sub { $_[0] * 4 });
1066
+$result->end_filter({key1 => sub { $_[0] * 3 }, key2 => 'five_times' });
1067
+$row = $result->one;
1068
+is_deeply($row, {key1 => 6, key2 => 40});
1069
+
1070
+$dbi->register_filter(five_times => sub { $_[0] * 5 });
1071
+$dbi->apply_filter('table1',
1072
+    key1 => {end => sub { $_[0] * 3 } },
1073
+    key2 => {end => 'five_times'}
1074
+);
1075
+$result = $dbi->select(table => 'table1');
1076
+$result->filter(key1 => sub { $_[0] * 2 }, key2 => sub { $_[0] * 4 });
1077
+$row = $result->one;
1078
+is_deeply($row, {key1 => 6, key2 => 40}, 'apply_filter');
1079
+
1080
+$dbi->register_filter(five_times => sub { $_[0] * 5 });
1081
+$dbi->apply_filter('table1',
1082
+    key1 => {end => sub { $_[0] * 3 } },
1083
+    key2 => {end => 'five_times'}
1084
+);
1085
+$result = $dbi->select(table => 'table1');
1086
+$result->filter(key1 => sub { $_[0] * 2 }, key2 => sub { $_[0] * 4 });
1087
+$result->filter(key1 => undef);
1088
+$result->end_filter(key1 => undef);
1089
+$row = $result->one;
1090
+is_deeply($row, {key1 => 1, key2 => 40}, 'apply_filter overwrite');
1091
+
1092
+test 'remove_end_filter and remove_filter';
1093
+$dbi = DBIx::Custom->connect(%memory);
1094
+$dbi->execute($create_table_default);
1095
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
1096
+$result = $dbi->select(table => 'table1');
1097
+$row = $result
1098
+       ->filter(key1 => sub { $_[0] * 2 }, key2 => sub { $_[0] * 4 })
1099
+       ->remove_filter
1100
+       ->end_filter(key1 => sub { $_[0] * 3 }, key2 => sub { $_[0] * 5 })
1101
+       ->remove_end_filter
1102
+       ->fetch_first;
1103
+is_deeply($row, [1, 2]);
1104
+
1105
+test 'empty where select';
1106
+$dbi = DBIx::Custom->connect(%memory);
1107
+$dbi->execute($create_table_default);
1108
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
1109
+$result = $dbi->select(table => 'table1', where => {});
1110
+$row = $result->one;
1111
+is_deeply($row, {key1 => 1, key2 => 2});
1112
+
1113
+test 'select query option';
1114
+$dbi = DBIx::Custom->connect(%memory);
1115
+$dbi->execute($create_table_default);
1116
+$query = $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2}, query => 1);
1117
+is(ref $query, 'DBIx::Custom::Query');
1118
+$query = $dbi->update(table => 'table1', where => {key1 => 1}, param => {key2 => 2}, query => 1);
1119
+is(ref $query, 'DBIx::Custom::Query');
1120
+$query = $dbi->delete(table => 'table1', where => {key1 => 1}, query => 1);
1121
+is(ref $query, 'DBIx::Custom::Query');
1122
+$query = $dbi->select(table => 'table1', where => {key1 => 1, key2 => 2}, query => 1);
1123
+is(ref $query, 'DBIx::Custom::Query');
1124
+
1125
+test 'DBIx::Custom::Where';
1126
+$dbi = DBIx::Custom->connect(%memory);
1127
+$dbi->execute($create_table_default);
1128
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
1129
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
1130
+$where = $dbi->where->clause(['and', 'key1 = :key1', 'key2 = :key2']);
1131
+is("$where", "where ( key1 = :key1 and key2 = :key2 )", 'no param');
1132
+
1133
+$where = $dbi->where
1134
+             ->clause(['and', 'key1 = :key1', 'key2 = :key2'])
1135
+             ->param({key1 => 1});
1136
+
1137
+$result = $dbi->select(
1138
+    table => 'table1',
1139
+    where => $where
1140
+);
1141
+$row = $result->all;
1142
+is_deeply($row, [{key1 => 1, key2 => 2}]);
1143
+
1144
+$result = $dbi->select(
1145
+    table => 'table1',
1146
+    where => [
1147
+        ['and', 'key1 = :key1', 'key2 = :key2'],
1148
+        {key1 => 1}
1149
+    ]
1150
+);
1151
+$row = $result->all;
1152
+is_deeply($row, [{key1 => 1, key2 => 2}]);
1153
+
1154
+$where = $dbi->where
1155
+             ->clause(['and', 'key1 = :key1', 'key2 = :key2'])
1156
+             ->param({key1 => 1, key2 => 2});
1157
+$result = $dbi->select(
1158
+    table => 'table1',
1159
+    where => $where
1160
+);
1161
+$row = $result->all;
1162
+is_deeply($row, [{key1 => 1, key2 => 2}]);
1163
+
1164
+$where = $dbi->where
1165
+             ->clause(['and', 'key1 = :key1', 'key2 = :key2'])
1166
+             ->param({});
1167
+$result = $dbi->select(
1168
+    table => 'table1',
1169
+    where => $where,
1170
+);
1171
+$row = $result->all;
1172
+is_deeply($row, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}]);
1173
+
1174
+$where = $dbi->where
1175
+             ->clause(['and', ['or', 'key1 > :key1', 'key1 < :key1'], 'key2 = :key2'])
1176
+             ->param({key1 => [0, 3], key2 => 2});
1177
+$result = $dbi->select(
1178
+    table => 'table1',
1179
+    where => $where,
1180
+); 
1181
+$row = $result->all;
1182
+is_deeply($row, [{key1 => 1, key2 => 2}]);
1183
+
1184
+$where = $dbi->where;
1185
+$result = $dbi->select(
1186
+    table => 'table1',
1187
+    where => $where
1188
+);
1189
+$row = $result->all;
1190
+is_deeply($row, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}]);
1191
+
1192
+eval {
1193
+$where = $dbi->where
1194
+             ->clause(['uuu']);
1195
+$result = $dbi->select(
1196
+    table => 'table1',
1197
+    where => $where
1198
+);
1199
+};
1200
+ok($@);
1201
+
1202
+$where = $dbi->where;
1203
+is("$where", '');
1204
+
1205
+$where = $dbi->where
1206
+             ->clause(['or', ('key1 = :key1') x 2])
1207
+             ->param({key1 => [1, 3]});
1208
+$result = $dbi->select(
1209
+    table => 'table1',
1210
+    where => $where,
1211
+);
1212
+$row = $result->all;
1213
+is_deeply($row, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}]);
1214
+
1215
+$where = $dbi->where
1216
+             ->clause(['or', ('key1 = :key1') x 2])
1217
+             ->param({key1 => [1]});
1218
+$result = $dbi->select(
1219
+    table => 'table1',
1220
+    where => $where,
1221
+);
1222
+$row = $result->all;
1223
+is_deeply($row, [{key1 => 1, key2 => 2}]);
1224
+
1225
+$where = $dbi->where
1226
+             ->clause(['or', ('key1 = :key1') x 2])
1227
+             ->param({key1 => 1});
1228
+$result = $dbi->select(
1229
+    table => 'table1',
1230
+    where => $where,
1231
+);
1232
+$row = $result->all;
1233
+is_deeply($row, [{key1 => 1, key2 => 2}]);
1234
+
1235
+$where = $dbi->where
1236
+             ->clause('key1 = :key1')
1237
+             ->param({key1 => 1});
1238
+$result = $dbi->select(
1239
+    table => 'table1',
1240
+    where => $where,
1241
+);
1242
+$row = $result->all;
1243
+is_deeply($row, [{key1 => 1, key2 => 2}]);
1244
+
1245
+$where = $dbi->where
1246
+             ->clause('key1 = :key1 key2 = :key2')
1247
+             ->param({key1 => 1});
1248
+eval{$where->to_string};
1249
+like($@, qr/one column/);
1250
+
1251
+$where = $dbi->where
1252
+             ->clause('key1 = :key1')
1253
+             ->param([]);
1254
+eval{$where->to_string};
1255
+like($@, qr/Parameter/);
1256
+
1257
+$where = $dbi->where
1258
+             ->clause(['or', ('key1 = :key1') x 3])
1259
+             ->param({key1 => [$dbi->not_exists, 1, 3]});
1260
+$result = $dbi->select(
1261
+    table => 'table1',
1262
+    where => $where,
1263
+);
1264
+$row = $result->all;
1265
+is_deeply($row, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], 'not_exists');
1266
+
1267
+$where = $dbi->where
1268
+             ->clause(['or', ('key1 = :key1') x 3])
1269
+             ->param({key1 => [1, $dbi->not_exists, 3]});
1270
+$result = $dbi->select(
1271
+    table => 'table1',
1272
+    where => $where,
1273
+);
1274
+$row = $result->all;
1275
+is_deeply($row, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], 'not_exists');
1276
+
1277
+$where = $dbi->where
1278
+             ->clause(['or', ('key1 = :key1') x 3])
1279
+             ->param({key1 => [1, 3, $dbi->not_exists]});
1280
+$result = $dbi->select(
1281
+    table => 'table1',
1282
+    where => $where,
1283
+);
1284
+$row = $result->all;
1285
+is_deeply($row, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], 'not_exists');
1286
+
1287
+$where = $dbi->where
1288
+             ->clause(['or', ('key1 = :key1') x 3])
1289
+             ->param({key1 => [1, $dbi->not_exists, $dbi->not_exists]});
1290
+$result = $dbi->select(
1291
+    table => 'table1',
1292
+    where => $where,
1293
+);
1294
+$row = $result->all;
1295
+is_deeply($row, [{key1 => 1, key2 => 2}], 'not_exists');
1296
+
1297
+$where = $dbi->where
1298
+             ->clause(['or', ('key1 = :key1') x 3])
1299
+             ->param({key1 => [$dbi->not_exists, 1, $dbi->not_exists]});
1300
+$result = $dbi->select(
1301
+    table => 'table1',
1302
+    where => $where,
1303
+);
1304
+$row = $result->all;
1305
+is_deeply($row, [{key1 => 1, key2 => 2}], 'not_exists');
1306
+
1307
+$where = $dbi->where
1308
+             ->clause(['or', ('key1 = :key1') x 3])
1309
+             ->param({key1 => [$dbi->not_exists, $dbi->not_exists, 1]});
1310
+$result = $dbi->select(
1311
+    table => 'table1',
1312
+    where => $where,
1313
+);
1314
+$row = $result->all;
1315
+is_deeply($row, [{key1 => 1, key2 => 2}], 'not_exists');
1316
+
1317
+$where = $dbi->where
1318
+             ->clause(['or', ('key1 = :key1') x 3])
1319
+             ->param({key1 => [$dbi->not_exists, $dbi->not_exists, $dbi->not_exists]});
1320
+$result = $dbi->select(
1321
+    table => 'table1',
1322
+    where => $where,
1323
+);
1324
+$row = $result->all;
1325
+is_deeply($row, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], 'not_exists');
1326
+
1327
+$where = $dbi->where
1328
+             ->clause(['or', ('key1 = :key1') x 3])
1329
+             ->param({key1 => []});
1330
+$result = $dbi->select(
1331
+    table => 'table1',
1332
+    where => $where,
1333
+);
1334
+$row = $result->all;
1335
+is_deeply($row, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], 'not_exists');
1336
+
1337
+$where = $dbi->where
1338
+             ->clause(['and', '{> key1}', '{< key1}' ])
1339
+             ->param({key1 => [2, $dbi->not_exists]});
1340
+$result = $dbi->select(
1341
+    table => 'table1',
1342
+    where => $where,
1343
+);
1344
+$row = $result->all;
1345
+is_deeply($row, [{key1 => 3, key2 => 4}], 'not_exists');
1346
+
1347
+$where = $dbi->where
1348
+             ->clause(['and', '{> key1}', '{< key1}' ])
1349
+             ->param({key1 => [$dbi->not_exists, 2]});
1350
+$result = $dbi->select(
1351
+    table => 'table1',
1352
+    where => $where,
1353
+);
1354
+$row = $result->all;
1355
+is_deeply($row, [{key1 => 1, key2 => 2}], 'not_exists');
1356
+
1357
+$where = $dbi->where
1358
+             ->clause(['and', '{> key1}', '{< key1}' ])
1359
+             ->param({key1 => [$dbi->not_exists, $dbi->not_exists]});
1360
+$result = $dbi->select(
1361
+    table => 'table1',
1362
+    where => $where,
1363
+);
1364
+$row = $result->all;
1365
+is_deeply($row, [{key1 => 1, key2 => 2},{key1 => 3, key2 => 4}], 'not_exists');
1366
+
1367
+$where = $dbi->where
1368
+             ->clause(['and', '{> key1}', '{< key1}' ])
1369
+             ->param({key1 => [0, 2]});
1370
+$result = $dbi->select(
1371
+    table => 'table1',
1372
+    where => $where,
1373
+);
1374
+$row = $result->all;
1375
+is_deeply($row, [{key1 => 1, key2 => 2}], 'not_exists');
1376
+
1377
+$where = $dbi->where
1378
+             ->clause(['and', 'key1 is not null', 'key2 is not null' ]);
1379
+$result = $dbi->select(
1380
+    table => 'table1',
1381
+    where => $where,
1382
+);
1383
+$row = $result->all;
1384
+is_deeply($row, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], 'not_exists');
1385
+
1386
+eval {$dbi->where(ppp => 1) };
1387
+like($@, qr/invalid/);
1388
+
1389
+$where = $dbi->where(
1390
+    clause => ['and', ['or'], ['and', 'key1 = :key1', 'key2 = :key2']],
1391
+    param => {key1 => 1, key2 => 2}
1392
+);
1393
+$result = $dbi->select(
1394
+    table => 'table1',
1395
+    where => $where,
1396
+);
1397
+$row = $result->all;
1398
+is_deeply($row, [{key1 => 1, key2 => 2}]);
1399
+
1400
+
1401
+$where = $dbi->where(
1402
+    clause => ['and', ['or'], ['or', ':key1', ':key2']],
1403
+    param => {}
1404
+);
1405
+$result = $dbi->select(
1406
+    table => 'table1',
1407
+    where => $where,
1408
+);
1409
+$row = $result->all;
1410
+is_deeply($row, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}]);
1411
+
1412
+
1413
+test 'dbi_option default';
1414
+$dbi = DBIx::Custom->new;
1415
+is_deeply($dbi->dbi_option, {});
1416
+
1417
+test 'register_tag_processor';
1418
+$dbi = DBIx::Custom->connect(%memory);
1419
+$dbi->register_tag_processor(
1420
+    a => sub { 1 }
1421
+);
1422
+is($dbi->query_builder->tag_processors->{a}->(), 1);
1423
+
1424
+test 'register_tag';
1425
+$dbi = DBIx::Custom->connect(%memory);
1426
+$dbi->register_tag(
1427
+    b => sub { 2 }
1428
+);
1429
+is($dbi->query_builder->tags->{b}->(), 2);
1430
+
1431
+test 'table not specify exception';
1432
+$dbi = DBIx::Custom->connect(%memory);
1433
+eval {$dbi->insert};
1434
+like($@, qr/table/);
1435
+eval {$dbi->update};
1436
+like($@, qr/table/);
1437
+eval {$dbi->delete};
1438
+like($@, qr/table/);
1439
+eval {$dbi->select};
1440
+like($@, qr/table/);
1441
+
1442
+
1443
+test 'more tests';
1444
+$dbi = DBIx::Custom->connect(%memory);
1445
+eval{$dbi->apply_filter('table', 'column', [])};
1446
+like($@, qr/apply_filter/);
1447
+
1448
+eval{$dbi->apply_filter('table', 'column', {outer => 2})};
1449
+like($@, qr/apply_filter/);
1450
+
1451
+$dbi->apply_filter(
1452
+
1453
+);
1454
+$dbi = DBIx::Custom->connect(%memory);
1455
+$dbi->execute($create_table_default);
1456
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
1457
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
1458
+$dbi->apply_filter('table1', 'key2', 
1459
+                   {in => sub { $_[0] * 3 }, out => sub { $_[0] * 2 }});
1460
+$rows = $dbi->select(table => 'table1', where => {key2 => 1})->all;
1461
+is_deeply($rows, [{key1 => 1, key2 => 6}]);
1462
+
1463
+$dbi = DBIx::Custom->connect(%memory);
1464
+$dbi->execute($create_table_default);
1465
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
1466
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
1467
+$dbi->apply_filter('table1', 'key2', {});
1468
+$rows = $dbi->select(table => 'table1', where => {key2 => 2})->all;
1469
+is_deeply($rows, [{key1 => 1, key2 => 2}]);
1470
+
1471
+$dbi = DBIx::Custom->connect(%memory);
1472
+eval {$dbi->apply_filter('table1', 'key2', {out => 'no'})};
1473
+like($@, qr/not registered/);
1474
+eval {$dbi->apply_filter('table1', 'key2', {in => 'no'})};
1475
+like($@, qr/not registered/);
1476
+$dbi->method({one => sub { 1 }});
1477
+is($dbi->one, 1);
1478
+
1479
+eval{DBIx::Custom->connect()};
1480
+like($@, qr/_connect/);
1481
+
1482
+$dbi = DBIx::Custom->connect(%memory);
1483
+$dbi->execute($create_table_default);
1484
+$dbi->register_filter(twice => sub { $_[0] * 2 });
1485
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2},
1486
+             filter => {key1 => 'twice'});
1487
+$row = $dbi->select(table => 'table1')->one;
1488
+is_deeply($row, {key1 => 2, key2 => 2});
1489
+eval {$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2},
1490
+             filter => {key1 => 'no'}) };
1491
+like($@, qr//);
1492
+
1493
+$dbi->register_filter(one => sub { });
1494
+$dbi->default_fetch_filter('one');
1495
+ok($dbi->default_fetch_filter);
1496
+$dbi->default_bind_filter('one');
1497
+ok($dbi->default_bind_filter);
1498
+eval{$dbi->default_fetch_filter('no')};
1499
+like($@, qr/not registered/);
1500
+eval{$dbi->default_bind_filter('no')};
1501
+like($@, qr/not registered/);
1502
+$dbi->default_bind_filter(undef);
1503
+ok(!defined $dbi->default_bind_filter);
1504
+$dbi->default_fetch_filter(undef);
1505
+ok(!defined $dbi->default_fetch_filter);
1506
+eval {$dbi->execute('select * from table1 {} {= author') };
1507
+like($@, qr/Tag not finished/);
1508
+
1509
+$dbi = DBIx::Custom->connect(%memory);
1510
+$dbi->execute($create_table_default);
1511
+$dbi->register_filter(one => sub { 1 });
1512
+$result = $dbi->select(table => 'table1');
1513
+eval {$result->filter(key1 => 'no')};
1514
+like($@, qr/not registered/);
1515
+eval {$result->end_filter(key1 => 'no')};
1516
+like($@, qr/not registered/);
1517
+$result->default_filter(undef);
1518
+ok(!defined $result->default_filter);
1519
+$result->default_filter('one');
1520
+is($result->default_filter->(), 1);
1521
+
1522
+test 'dbi_option';
1523
+$dbi = DBIx::Custom->connect(%memory,
1524
+                             dbi_option => {PrintError => 1});
1525
+ok($dbi->dbh->{PrintError});
1526
+$dbi = DBIx::Custom->connect(%memory,
1527
+                             dbi_options => {PrintError => 1});
1528
+ok($dbi->dbh->{PrintError});
1529
+
1530
+test 'DBIx::Custom::Result stash()';
1531
+$result = DBIx::Custom::Result->new;
1532
+is_deeply($result->stash, {}, 'default');
1533
+$result->stash->{foo} = 1;
1534
+is($result->stash->{foo}, 1, 'get and set');
1535
+
1536
+test 'filter __ expression';
1537
+$dbi = DBIx::Custom->connect(%memory);
1538
+$dbi->execute('create table company (id, name, location_id)');
1539
+$dbi->execute('create table location (id, name)');
1540
+$dbi->apply_filter('location',
1541
+  name => {in => sub { uc $_[0] } }
1542
+);
1543
+
1544
+$dbi->insert(table => 'company', param => {id => 1, name => 'a', location_id => 2});
1545
+$dbi->insert(table => 'location', param => {id => 2, name => 'b'});
1546
+
1547
+$result = $dbi->select(
1548
+    table => ['company', 'location'], relation => {'company.location_id' => 'location.id'},
1549
+    column => ['location.name as location__name']
1550
+);
1551
+is($result->fetch_first->[0], 'B');
1552
+
1553
+$result = $dbi->select(
1554
+    table => 'company', relation => {'company.location_id' => 'location.id'},
1555
+    column => ['location.name as location__name']
1556
+);
1557
+is($result->fetch_first->[0], 'B');
1558
+
1559
+$result = $dbi->select(
1560
+    table => 'company', relation => {'company.location_id' => 'location.id'},
1561
+    column => ['location.name as "location.name"']
1562
+);
1563
+is($result->fetch_first->[0], 'B');
1564
+
1565
+test 'Model class';
1566
+use MyDBI1;
1567
+$dbi = MyDBI1->connect(%memory);
1568
+$dbi->execute("create table book (title, author)");
1569
+$model = $dbi->model('book');
1570
+$model->insert({title => 'a', author => 'b'});
1571
+is_deeply($model->list->all, [{title => 'a', author => 'b'}], 'basic');
1572
+$dbi->execute("create table company (name)");
1573
+$model = $dbi->model('company');
1574
+$model->insert({name => 'a'});
1575
+is_deeply($model->list->all, [{name => 'a'}], 'basic');
1576
+is($dbi->models->{'book'}, $dbi->model('book'));
1577
+is($dbi->models->{'company'}, $dbi->model('company'));
1578
+
1579
+{
1580
+    package MyDBI4;
1581
+
1582
+    use strict;
1583
+    use warnings;
1584
+
1585
+    use base 'DBIx::Custom';
1586
+
1587
+    sub connect {
1588
+        my $self = shift->SUPER::connect(@_);
1589
+        
1590
+        $self->include_model(
1591
+            MyModel2 => [
1592
+                'book',
1593
+                {class => 'Company', name => 'company'}
1594
+            ]
1595
+        );
1596
+    }
1597
+
1598
+    package MyModel2::Base1;
1599
+
1600
+    use strict;
1601
+    use warnings;
1602
+
1603
+    use base 'DBIx::Custom::Model';
1604
+
1605
+    package MyModel2::book;
1606
+
1607
+    use strict;
1608
+    use warnings;
1609
+
1610
+    use base 'MyModel2::Base1';
1611
+
1612
+    sub insert {
1613
+        my ($self, $param) = @_;
1614
+        
1615
+        return $self->SUPER::insert(param => $param);
1616
+    }
1617
+
1618
+    sub list { shift->select; }
1619
+
1620
+    package MyModel2::Company;
1621
+
1622
+    use strict;
1623
+    use warnings;
1624
+
1625
+    use base 'MyModel2::Base1';
1626
+
1627
+    sub insert {
1628
+        my ($self, $param) = @_;
1629
+        
1630
+        return $self->SUPER::insert(param => $param);
1631
+    }
1632
+
1633
+    sub list { shift->select; }
1634
+}
1635
+$dbi = MyDBI4->connect(%memory);
1636
+$dbi->execute("create table book (title, author)");
1637
+$model = $dbi->model('book');
1638
+$model->insert({title => 'a', author => 'b'});
1639
+is_deeply($model->list->all, [{title => 'a', author => 'b'}], 'basic');
1640
+$dbi->execute("create table company (name)");
1641
+$model = $dbi->model('company');
1642
+$model->insert({name => 'a'});
1643
+is_deeply($model->list->all, [{name => 'a'}], 'basic');
1644
+
1645
+{
1646
+     package MyDBI5;
1647
+
1648
+    use strict;
1649
+    use warnings;
1650
+
1651
+    use base 'DBIx::Custom';
1652
+
1653
+    sub connect {
1654
+        my $self = shift->SUPER::connect(@_);
1655
+        
1656
+        $self->include_model('MyModel4');
1657
+    }
1658
+}
1659
+$dbi = MyDBI5->connect(%memory);
1660
+$dbi->execute("create table company (name)");
1661
+$dbi->execute("create table table1 (key1)");
1662
+$model = $dbi->model('company');
1663
+$model->insert({name => 'a'});
1664
+is_deeply($model->list->all, [{name => 'a'}], 'include all model');
1665
+$dbi->insert(table => 'table1', param => {key1 => 1});
1666
+$model = $dbi->model('book');
1667
+is_deeply($model->list->all, [{key1 => 1}], 'include all model');
1668
+
1669
+test 'primary_key';
1670
+use MyDBI1;
1671
+$dbi = MyDBI1->connect(%memory);
1672
+$model = $dbi->model('book');
1673
+$model->primary_key(['id', 'number']);
1674
+is_deeply($model->primary_key, ['id', 'number']);
1675
+
1676
+test 'columns';
1677
+use MyDBI1;
1678
+$dbi = MyDBI1->connect(%memory);
1679
+$model = $dbi->model('book');
1680
+$model->columns(['id', 'number']);
1681
+is_deeply($model->columns, ['id', 'number']);
1682
+
1683
+test 'setup_model';
1684
+use MyDBI1;
1685
+$dbi = MyDBI1->connect(%memory);
1686
+$dbi->execute('create table book (id)');
1687
+$dbi->execute('create table company (id, name);');
1688
+$dbi->execute('create table test (id, name, primary key (id, name));');
1689
+$dbi->setup_model;
1690
+is_deeply($dbi->model('book')->columns, ['id']);
1691
+is_deeply($dbi->model('company')->columns, ['id', 'name']);
1692
+
1693
+test 'delete_at';
1694
+$dbi = DBIx::Custom->connect(%memory);
1695
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
1696
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
1697
+$dbi->delete_at(
1698
+    table => 'table1',
1699
+    primary_key => ['key1', 'key2'],
1700
+    where => [1, 2],
1701
+);
1702
+is_deeply($dbi->select(table => 'table1')->all, []);
1703
+
1704
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
1705
+$dbi->delete_at(
1706
+    table => 'table1',
1707
+    primary_key => 'key1',
1708
+    where => 1,
1709
+);
1710
+is_deeply($dbi->select(table => 'table1')->all, []);
1711
+
1712
+test 'insert_at';
1713
+$dbi = DBIx::Custom->connect(%memory);
1714
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
1715
+$dbi->insert_at(
1716
+    primary_key => ['key1', 'key2'], 
1717
+    table => 'table1',
1718
+    where => [1, 2],
1719
+    param => {key3 => 3}
1720
+);
1721
+is($dbi->select(table => 'table1')->one->{key1}, 1);
1722
+is($dbi->select(table => 'table1')->one->{key2}, 2);
1723
+is($dbi->select(table => 'table1')->one->{key3}, 3);
1724
+
1725
+$dbi->delete_all(table => 'table1');
1726
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
1727
+$dbi->insert_at(
1728
+    primary_key => 'key1', 
1729
+    table => 'table1',
1730
+    where => 1,
1731
+    param => {key2 => 2, key3 => 3}
1732
+);
1733
+
1734
+is($dbi->select(table => 'table1')->one->{key1}, 1);
1735
+is($dbi->select(table => 'table1')->one->{key2}, 2);
1736
+is($dbi->select(table => 'table1')->one->{key3}, 3);
1737
+
1738
+eval {
1739
+    $dbi->insert_at(
1740
+        table => 'table1',
1741
+        primary_key => ['key1', 'key2'],
1742
+        where => {},
1743
+        param => {key1 => 1, key2 => 2, key3 => 3},
1744
+    );
1745
+};
1746
+like($@, qr/must be/);
1747
+
1748
+$dbi = DBIx::Custom->connect(%memory);
1749
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
1750
+$dbi->insert_at(
1751
+    {key3 => 3},
1752
+    primary_key => ['key1', 'key2'], 
1753
+    table => 'table1',
1754
+    where => [1, 2],
1755
+);
1756
+is($dbi->select(table => 'table1')->one->{key1}, 1);
1757
+is($dbi->select(table => 'table1')->one->{key2}, 2);
1758
+is($dbi->select(table => 'table1')->one->{key3}, 3);
1759
+
1760
+test 'update_at';
1761
+$dbi = DBIx::Custom->connect(%memory);
1762
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
1763
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
1764
+$dbi->update_at(
1765
+    table => 'table1',
1766
+    primary_key => ['key1', 'key2'],
1767
+    where => [1, 2],
1768
+    param => {key3 => 4}
1769
+);
1770
+is($dbi->select(table => 'table1')->one->{key1}, 1);
1771
+is($dbi->select(table => 'table1')->one->{key2}, 2);
1772
+is($dbi->select(table => 'table1')->one->{key3}, 4);
1773
+
1774
+$dbi->delete_all(table => 'table1');
1775
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
1776
+$dbi->update_at(
1777
+    table => 'table1',
1778
+    primary_key => 'key1',
1779
+    where => 1,
1780
+    param => {key3 => 4}
1781
+);
1782
+is($dbi->select(table => 'table1')->one->{key1}, 1);
1783
+is($dbi->select(table => 'table1')->one->{key2}, 2);
1784
+is($dbi->select(table => 'table1')->one->{key3}, 4);
1785
+
1786
+$dbi = DBIx::Custom->connect(%memory);
1787
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
1788
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
1789
+$dbi->update_at(
1790
+    {key3 => 4},
1791
+    table => 'table1',
1792
+    primary_key => ['key1', 'key2'],
1793
+    where => [1, 2]
1794
+);
1795
+is($dbi->select(table => 'table1')->one->{key1}, 1);
1796
+is($dbi->select(table => 'table1')->one->{key2}, 2);
1797
+is($dbi->select(table => 'table1')->one->{key3}, 4);
1798
+
1799
+test 'select_at';
1800
+$dbi = DBIx::Custom->connect(%memory);
1801
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
1802
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
1803
+$result = $dbi->select_at(
1804
+    table => 'table1',
1805
+    primary_key => ['key1', 'key2'],
1806
+    where => [1, 2]
1807
+);
1808
+$row = $result->one;
1809
+is($row->{key1}, 1);
1810
+is($row->{key2}, 2);
1811
+is($row->{key3}, 3);
1812
+
1813
+$dbi->delete_all(table => 'table1');
1814
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
1815
+$result = $dbi->select_at(
1816
+    table => 'table1',
1817
+    primary_key => 'key1',
1818
+    where => 1,
1819
+);
1820
+$row = $result->one;
1821
+is($row->{key1}, 1);
1822
+is($row->{key2}, 2);
1823
+is($row->{key3}, 3);
1824
+
1825
+$dbi->delete_all(table => 'table1');
1826
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
1827
+$result = $dbi->select_at(
1828
+    table => 'table1',
1829
+    primary_key => ['key1', 'key2'],
1830
+    where => [1, 2]
1831
+);
1832
+$row = $result->one;
1833
+is($row->{key1}, 1);
1834
+is($row->{key2}, 2);
1835
+is($row->{key3}, 3);
1836
+
1837
+eval {
1838
+    $result = $dbi->select_at(
1839
+        table => 'table1',
1840
+        primary_key => ['key1', 'key2'],
1841
+        where => {},
1842
+    );
1843
+};
1844
+like($@, qr/must be/);
1845
+
1846
+eval {
1847
+    $result = $dbi->select_at(
1848
+        table => 'table1',
1849
+        primary_key => ['key1', 'key2'],
1850
+        where => [1],
1851
+    );
1852
+};
1853
+like($@, qr/same/);
1854
+
1855
+eval {
1856
+    $result = $dbi->update_at(
1857
+        table => 'table1',
1858
+        primary_key => ['key1', 'key2'],
1859
+        where => {},
1860
+        param => {key1 => 1, key2 => 2},
1861
+    );
1862
+};
1863
+like($@, qr/must be/);
1864
+
1865
+eval {
1866
+    $result = $dbi->delete_at(
1867
+        table => 'table1',
1868
+        primary_key => ['key1', 'key2'],
1869
+        where => {},
1870
+    );
1871
+};
1872
+like($@, qr/must be/);
1873
+
1874
+test 'columns';
1875
+use MyDBI1;
1876
+$dbi = MyDBI1->connect(%memory);
1877
+$model = $dbi->model('book');
1878
+
1879
+
1880
+test 'model delete_at';
1881
+{
1882
+    package MyDBI6;
1883
+    
1884
+    use base 'DBIx::Custom';
1885
+    
1886
+    sub connect {
1887
+        my $self = shift->SUPER::connect(@_);
1888
+        
1889
+        $self->include_model('MyModel5');
1890
+        
1891
+        return $self;
1892
+    }
1893
+}
1894
+$dbi = MyDBI6->connect(%memory);
1895
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
1896
+$dbi->execute("create table table2 (key1, key2, key3)");
1897
+$dbi->execute("create table table3 (key1, key2, key3)");
1898
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
1899
+$dbi->model('table1')->delete_at(where => [1, 2]);
1900
+is_deeply($dbi->select(table => 'table1')->all, []);
1901
+$dbi->insert(table => 'table2', param => {key1 => 1, key2 => 2, key3 => 3});
1902
+$dbi->model('table1_1')->delete_at(where => [1, 2]);
1903
+is_deeply($dbi->select(table => 'table1')->all, []);
1904
+$dbi->insert(table => 'table3', param => {key1 => 1, key2 => 2, key3 => 3});
1905
+$dbi->model('table1_3')->delete_at(where => [1, 2]);
1906
+is_deeply($dbi->select(table => 'table1')->all, []);
1907
+
1908
+test 'model insert_at';
1909
+$dbi = MyDBI6->connect(%memory);
1910
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
1911
+$dbi->model('table1')->insert_at(
1912
+    where => [1, 2],
1913
+    param => {key3 => 3}
1914
+);
1915
+$result = $dbi->model('table1')->select;
1916
+$row = $result->one;
1917
+is($row->{key1}, 1);
1918
+is($row->{key2}, 2);
1919
+is($row->{key3}, 3);
1920
+
1921
+test 'model update_at';
1922
+$dbi = MyDBI6->connect(%memory);
1923
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
1924
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
1925
+$dbi->model('table1')->update_at(
1926
+    where => [1, 2],
1927
+    param => {key3 => 4}
1928
+);
1929
+$result = $dbi->model('table1')->select;
1930
+$row = $result->one;
1931
+is($row->{key1}, 1);
1932
+is($row->{key2}, 2);
1933
+is($row->{key3}, 4);
1934
+
1935
+test 'model select_at';
1936
+$dbi = MyDBI6->connect(%memory);
1937
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
1938
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
1939
+$result = $dbi->model('table1')->select_at(where => [1, 2]);
1940
+$row = $result->one;
1941
+is($row->{key1}, 1);
1942
+is($row->{key2}, 2);
1943
+is($row->{key3}, 3);
1944
+
1945
+
1946
+test 'mycolumn and column';
1947
+{
1948
+    package MyDBI7;
1949
+    
1950
+    use base 'DBIx::Custom';
1951
+    
1952
+    sub connect {
1953
+        my $self = shift->SUPER::connect(@_);
1954
+        
1955
+        $self->include_model('MyModel6');
1956
+        
1957
+        
1958
+        return $self;
1959
+    }
1960
+}
1961
+$dbi = MyDBI7->connect(%memory);
1962
+$dbi->execute($create_table_default);
1963
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
1964
+$dbi->separator('__');
1965
+$dbi->setup_model;
1966
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
1967
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 3});
1968
+$model = $dbi->model('table1');
1969
+$result = $model->select(
1970
+    column => [$model->mycolumn, $model->column('table2')],
1971
+    where => {'table1.key1' => 1}
1972
+);
1973
+is_deeply($result->one,
1974
+          {key1 => 1, key2 => 2, 'table2__key1' => 1, 'table2__key3' => 3});
1975
+
1976
+test 'update_param';
1977
+$dbi = DBIx::Custom->connect(%memory);
1978
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
1979
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
1980
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
1981
+
1982
+$param = {key2 => 11};
1983
+$update_param = $dbi->update_param($param);
1984
+$sql = <<"EOS";
1985
+update table1 $update_param
1986
+where key1 = 1
1987
+EOS
1988
+$dbi->execute($sql, param => $param);
1989
+$result = $dbi->execute('select * from table1;', table => 'table1');
1990
+$rows   = $result->all;
1991
+is_deeply($rows, [{key1 => 1, key2 => 11, key3 => 3, key4 => 4, key5 => 5},
1992
+                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
1993
+                  "basic");
1994
+
1995
+
1996
+$dbi = DBIx::Custom->connect(%memory);
1997
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
1998
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
1999
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
2000
+
2001
+$param = {key2 => 11, key3 => 33};
2002
+$update_param = $dbi->update_param($param);
2003
+$sql = <<"EOS";
2004
+update table1 $update_param
2005
+where key1 = 1
2006
+EOS
2007
+$dbi->execute($sql, param => $param);
2008
+$result = $dbi->execute('select * from table1;', table => 'table1');
2009
+$rows   = $result->all;
2010
+is_deeply($rows, [{key1 => 1, key2 => 11, key3 => 33, key4 => 4, key5 => 5},
2011
+                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
2012
+                  "basic");
2013
+
2014
+$dbi = DBIx::Custom->connect(%memory);
2015
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
2016
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
2017
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
2018
+
2019
+$param = {key2 => 11, key3 => 33};
2020
+$update_param = $dbi->update_param($param, {no_set => 1});
2021
+$sql = <<"EOS";
2022
+update table1 set $update_param
2023
+where key1 = 1
2024
+EOS
2025
+$dbi->execute($sql, param => $param);
2026
+$result = $dbi->execute('select * from table1;', table => 'table1');
2027
+$rows   = $result->all;
2028
+is_deeply($rows, [{key1 => 1, key2 => 11, key3 => 33, key4 => 4, key5 => 5},
2029
+                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
2030
+                  "update param no_set");
2031
+
2032
+            
2033
+eval { $dbi->update_param({";" => 1}) };
2034
+like($@, qr/not safety/);
2035
+
2036
+
2037
+test 'update_param';
2038
+$dbi = DBIx::Custom->connect(%memory);
2039
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
2040
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
2041
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
2042
+
2043
+$param = {key2 => 11};
2044
+$update_param = $dbi->assign_param($param);
2045
+$sql = <<"EOS";
2046
+update table1 set $update_param
2047
+where key1 = 1
2048
+EOS
2049
+$dbi->execute($sql, param => $param, table => 'table1');
2050
+$result = $dbi->execute('select * from table1;');
2051
+$rows   = $result->all;
2052
+is_deeply($rows, [{key1 => 1, key2 => 11, key3 => 3, key4 => 4, key5 => 5},
2053
+                  {key1 => 6, key2 => 7,  key3 => 8, key4 => 9, key5 => 10}],
2054
+                  "basic");
2055
+
2056
+
2057
+test 'insert_param';
2058
+$dbi = DBIx::Custom->connect(%memory);
2059
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
2060
+$param = {key1 => 1, key2 => 2};
2061
+$insert_param = $dbi->insert_param($param);
2062
+$sql = <<"EOS";
2063
+insert into table1 $insert_param
2064
+EOS
2065
+$dbi->execute($sql, param => $param, table => 'table1');
2066
+is($dbi->select(table => 'table1')->one->{key1}, 1);
2067
+is($dbi->select(table => 'table1')->one->{key2}, 2);
2068
+
2069
+$dbi = DBIx::Custom->connect(%memory);
2070
+$dbi->quote('"');
2071
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
2072
+$param = {key1 => 1, key2 => 2};
2073
+$insert_param = $dbi->insert_param($param);
2074
+$sql = <<"EOS";
2075
+insert into table1 $insert_param
2076
+EOS
2077
+$dbi->execute($sql, param => $param, table => 'table1');
2078
+is($dbi->select(table => 'table1')->one->{key1}, 1);
2079
+is($dbi->select(table => 'table1')->one->{key2}, 2);
2080
+
2081
+eval { $dbi->insert_param({";" => 1}) };
2082
+like($@, qr/not safety/);
2083
+
2084
+
2085
+test 'join';
2086
+$dbi = DBIx::Custom->connect(%memory);
2087
+$dbi->execute($create_table_default);
2088
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2089
+$dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
2090
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
2091
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 5});
2092
+$dbi->execute('create table table3 (key3 int, key4 int);');
2093
+$dbi->insert(table => 'table3', param => {key3 => 5, key4 => 4});
2094
+$rows = $dbi->select(
2095
+    table => 'table1',
2096
+    column => 'table1.key1 as table1_key1, table2.key1 as table2_key1, key2, key3',
2097
+    where   => {'table1.key2' => 2},
2098
+    join  => ['left outer join table2 on table1.key1 = table2.key1']
2099
+)->all;
2100
+is_deeply($rows, [{table1_key1 => 1, table2_key1 => 1, key2 => 2, key3 => 5}]);
2101
+
2102
+$rows = $dbi->select(
2103
+    table => 'table1',
2104
+    where   => {'key1' => 1},
2105
+    join  => ['left outer join table2 on table1.key1 = table2.key1']
2106
+)->all;
2107
+is_deeply($rows, [{key1 => 1, key2 => 2}]);
2108
+
2109
+eval {
2110
+    $rows = $dbi->select(
2111
+        table => 'table1',
2112
+        column => 'table1.key1 as table1_key1, table2.key1 as table2_key1, key2, key3',
2113
+        where   => {'table1.key2' => 2},
2114
+        join  => {'table1.key1' => 'table2.key1'}
2115
+    );
2116
+};
2117
+like ($@, qr/array/);
2118
+
2119
+$rows = $dbi->select(
2120
+    table => 'table1',
2121
+    where   => {'key1' => 1},
2122
+    join  => ['left outer join table2 on table1.key1 = table2.key1',
2123
+              'left outer join table3 on table2.key3 = table3.key3']
2124
+)->all;
2125
+is_deeply($rows, [{key1 => 1, key2 => 2}]);
2126
+
2127
+$rows = $dbi->select(
2128
+    column => 'table3.key4 as table3__key4',
2129
+    table => 'table1',
2130
+    where   => {'table1.key1' => 1},
2131
+    join  => ['left outer join table2 on table1.key1 = table2.key1',
2132
+              'left outer join table3 on table2.key3 = table3.key3']
2133
+)->all;
2134
+is_deeply($rows, [{table3__key4 => 4}]);
2135
+
2136
+$rows = $dbi->select(
2137
+    column => 'table1.key1 as table1__key1',
2138
+    table => 'table1',
2139
+    where   => {'table3.key4' => 4},
2140
+    join  => ['left outer join table2 on table1.key1 = table2.key1',
2141
+              'left outer join table3 on table2.key3 = table3.key3']
2142
+)->all;
2143
+is_deeply($rows, [{table1__key1 => 1}]);
2144
+
2145
+$dbi = DBIx::Custom->connect(%memory);
2146
+$dbi->quote('"');
2147
+$dbi->execute($create_table_default);
2148
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2149
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
2150
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 5});
2151
+$rows = $dbi->select(
2152
+    table => 'table1',
2153
+    column => '"table1"."key1" as "table1_key1", "table2"."key1" as "table2_key1", "key2", "key3"',
2154
+    where   => {'table1.key2' => 2},
2155
+    join  => ['left outer join "table2" on "table1"."key1" = "table2"."key1"'],
2156
+)->all;
2157
+is_deeply($rows, [{table1_key1 => 1, table2_key1 => 1, key2 => 2, key3 => 5}],
2158
+          'quote');
2159
+
2160
+{
2161
+    package MyDBI8;
2162
+    
2163
+    use base 'DBIx::Custom';
2164
+    
2165
+    sub connect {
2166
+        my $self = shift->SUPER::connect(@_);
2167
+        
2168
+        $self->include_model('MyModel7');
2169
+        
2170
+        return $self;
2171
+    }
2172
+}
2173
+
2174
+$dbi = DBIx::Custom->connect(%memory);
2175
+$dbi->execute($create_table_default);
2176
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2177
+$sql = <<"EOS";
2178
+left outer join (
2179
+  select * from table1 as t1
2180
+  where t1.key2 = (
2181
+    select max(t2.key2) from table1 as t2
2182
+    where t1.key1 = t2.key1
2183
+  )
2184
+) as latest_table1 on table1.key1 = latest_table1.key1
2185
+EOS
2186
+$join = [$sql];
2187
+$rows = $dbi->select(
2188
+    table => 'table1',
2189
+    column => 'latest_table1.key1 as latest_table1__key1',
2190
+    join  => $join
2191
+)->all;
2192
+is_deeply($rows, [{latest_table1__key1 => 1}]);
2193
+
2194
+$dbi = DBIx::Custom->connect(%memory);
2195
+$dbi->execute($create_table_default);
2196
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
2197
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2198
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 4});
2199
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 5});
2200
+$result = $dbi->select(
2201
+    table => 'table1',
2202
+    join => [
2203
+        "left outer join table2 on table2.key2 = '4' and table1.key1 = table2.key1"
2204
+    ]
2205
+);
2206
+is_deeply($result->all, [{key1 => 1, key2 => 2}]);
2207
+$result = $dbi->select(
2208
+    table => 'table1',
2209
+    column => [{table2 => ['key3']}],
2210
+    join => [
2211
+        "left outer join table2 on table2.key3 = '4' and table1.key1 = table2.key1"
2212
+    ]
2213
+);
2214
+is_deeply($result->all, [{'table2.key3' => 4}]);
2215
+$result = $dbi->select(
2216
+    table => 'table1',
2217
+    column => [{table2 => ['key3']}],
2218
+    join => [
2219
+        "left outer join table2 on table1.key1 = table2.key1 and table2.key3 = '4'"
2220
+    ]
2221
+);
2222
+is_deeply($result->all, [{'table2.key3' => 4}]);
2223
+
2224
+$dbi = DBIx::Custom->connect(%memory);
2225
+$dbi->execute($create_table_default);
2226
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
2227
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2228
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 4});
2229
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 5});
2230
+$result = $dbi->select(
2231
+    table => 'table1',
2232
+    column => [{table2 => ['key3']}],
2233
+    join => [
2234
+        {
2235
+            clause => "left outer join table2 on table2.key3 = '4' and table1.key1 = table2.key1",
2236
+            table => ['table1', 'table2']
2237
+        }
2238
+    ]
2239
+);
2240
+is_deeply($result->all, [{'table2.key3' => 4}]);
2241
+
2242
+test 'mycolumn';
2243
+$dbi = MyDBI8->connect(%memory);
2244
+$dbi->execute($create_table_default);
2245
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
2246
+$dbi->setup_model;
2247
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2248
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 3});
2249
+$model = $dbi->model('table1');
2250
+$result = $model->select_at(
2251
+    column => [
2252
+        $model->mycolumn,
2253
+        $model->column('table2')
2254
+    ]
2255
+);
2256
+is_deeply($result->one,
2257
+          {key1 => 1, key2 => 2, 'table2.key1' => 1, 'table2.key3' => 3});
2258
+
2259
+$result = $model->select_at(
2260
+    column => [
2261
+        $model->mycolumn(['key1']),
2262
+        $model->column(table2 => ['key1'])
2263
+    ]
2264
+);
2265
+is_deeply($result->one,
2266
+          {key1 => 1, 'table2.key1' => 1});
2267
+$result = $model->select_at(
2268
+    column => [
2269
+        $model->mycolumn(['key1']),
2270
+        {table2 => ['key1']}
2271
+    ]
2272
+);
2273
+is_deeply($result->one,
2274
+          {key1 => 1, 'table2.key1' => 1});
2275
+
2276
+$result = $model->select_at(
2277
+    column => [
2278
+        $model->mycolumn(['key1']),
2279
+        ['table2.key1', as => 'table2.key1']
2280
+    ]
2281
+);
2282
+is_deeply($result->one,
2283
+          {key1 => 1, 'table2.key1' => 1});
2284
+
2285
+$result = $model->select_at(
2286
+    column => [
2287
+        $model->mycolumn(['key1']),
2288
+        ['table2.key1' => 'table2.key1']
2289
+    ]
2290
+);
2291
+is_deeply($result->one,
2292
+          {key1 => 1, 'table2.key1' => 1});
2293
+
2294
+test 'dbi method from model';
2295
+{
2296
+    package MyDBI9;
2297
+    
2298
+    use base 'DBIx::Custom';
2299
+    
2300
+    sub connect {
2301
+        my $self = shift->SUPER::connect(@_);
2302
+        
2303
+        $self->include_model('MyModel8')->setup_model;
2304
+        
2305
+        return $self;
2306
+    }
2307
+}
2308
+$dbi = MyDBI9->connect(%memory);
2309
+$dbi->execute($create_table_default);
2310
+$model = $dbi->model('table1');
2311
+eval{$model->execute('select * from table1')};
2312
+ok(!$@);
2313
+
2314
+test 'column table option';
2315
+$dbi = MyDBI9->connect(%memory);
2316
+$dbi->execute($create_table_default);
2317
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
2318
+$dbi->setup_model;
2319
+$dbi->execute('insert into table1 (key1, key2) values (1, 2);');
2320
+$dbi->execute('insert into table2 (key1, key3) values (1, 4);');
2321
+$model = $dbi->model('table1');
2322
+$result = $model->select(
2323
+    column => [
2324
+        $model->column('table2', {alias => 'table2_alias'})
2325
+    ],
2326
+    where => {'table2_alias.key3' => 4}
2327
+);
2328
+is_deeply($result->one, 
2329
+          {'table2_alias.key1' => 1, 'table2_alias.key3' => 4});
2330
+
2331
+$dbi->separator('__');
2332
+$result = $model->select(
2333
+    column => [
2334
+        $model->column('table2', {alias => 'table2_alias'})
2335
+    ],
2336
+    where => {'table2_alias.key3' => 4}
2337
+);
2338
+is_deeply($result->one, 
2339
+          {'table2_alias__key1' => 1, 'table2_alias__key3' => 4});
2340
+
2341
+$dbi->separator('-');
2342
+$result = $model->select(
2343
+    column => [
2344
+        $model->column('table2', {alias => 'table2_alias'})
2345
+    ],
2346
+    where => {'table2_alias.key3' => 4}
2347
+);
2348
+is_deeply($result->one, 
2349
+          {'table2_alias-key1' => 1, 'table2_alias-key3' => 4});
2350
+
2351
+test 'type option'; # DEPRECATED!
2352
+$dbi = DBIx::Custom->connect(
2353
+    data_source => 'dbi:SQLite:dbname=:memory:',
2354
+    dbi_option => {
2355
+        $DBD::SQLite::VERSION > 1.26 ? (sqlite_unicode => 1) : (unicode => 1)
2356
+    }
2357
+);
2358
+my $binary = pack("I3", 1, 2, 3);
2359
+$dbi->execute('create table table1(key1, key2)');
2360
+$dbi->insert(table => 'table1', param => {key1 => $binary, key2 => 'あ'}, type => [key1 => DBI::SQL_BLOB]);
2361
+$result = $dbi->select(table => 'table1');
2362
+$row   = $result->one;
2363
+is_deeply($row, {key1 => $binary, key2 => 'あ'}, "basic");
2364
+$result = $dbi->execute('select length(key1) as key1_length from table1');
2365
+$row = $result->one;
2366
+is($row->{key1_length}, length $binary);
2367
+
2368
+$dbi->insert(table => 'table1', param => {key1 => $binary, key2 => 'あ'}, type => [['key1'] => DBI::SQL_BLOB]);
2369
+$result = $dbi->select(table => 'table1');
2370
+$row   = $result->one;
2371
+is_deeply($row, {key1 => $binary, key2 => 'あ'}, "basic");
2372
+$result = $dbi->execute('select length(key1) as key1_length from table1');
2373
+$row = $result->one;
2374
+is($row->{key1_length}, length $binary);
2375
+
2376
+
2377
+test 'bind_type option';
2378
+$dbi = DBIx::Custom->connect(
2379
+    data_source => 'dbi:SQLite:dbname=:memory:',
2380
+    dbi_option => {
2381
+        $DBD::SQLite::VERSION > 1.26 ? (sqlite_unicode => 1) : (unicode => 1)
2382
+    }
2383
+);
2384
+$binary = pack("I3", 1, 2, 3);
2385
+$dbi->execute('create table table1(key1, key2)');
2386
+$dbi->insert(table => 'table1', param => {key1 => $binary, key2 => 'あ'}, bind_type => [key1 => DBI::SQL_BLOB]);
2387
+$result = $dbi->select(table => 'table1');
2388
+$row   = $result->one;
2389
+is_deeply($row, {key1 => $binary, key2 => 'あ'}, "basic");
2390
+$result = $dbi->execute('select length(key1) as key1_length from table1');
2391
+$row = $result->one;
2392
+is($row->{key1_length}, length $binary);
2393
+
2394
+$dbi->insert(table => 'table1', param => {key1 => $binary, key2 => 'あ'}, bind_type => [['key1'] => DBI::SQL_BLOB]);
2395
+$result = $dbi->select(table => 'table1');
2396
+$row   = $result->one;
2397
+is_deeply($row, {key1 => $binary, key2 => 'あ'}, "basic");
2398
+$result = $dbi->execute('select length(key1) as key1_length from table1');
2399
+$row = $result->one;
2400
+is($row->{key1_length}, length $binary);
2401
+
2402
+test 'model type attribute';
2403
+$dbi = DBIx::Custom->connect(
2404
+    data_source => 'dbi:SQLite:dbname=:memory:',
2405
+    dbi_option => {
2406
+        $DBD::SQLite::VERSION > 1.26 ? (sqlite_unicode => 1) : (unicode => 1)
2407
+    }
2408
+);
2409
+$binary = pack("I3", 1, 2, 3);
2410
+$dbi->execute('create table table1(key1, key2)');
2411
+$model = $dbi->create_model(table => 'table1', bind_type => [key1 => DBI::SQL_BLOB]);
2412
+$model->insert(param => {key1 => $binary, key2 => 'あ'});
2413
+$result = $dbi->select(table => 'table1');
2414
+$row   = $result->one;
2415
+is_deeply($row, {key1 => $binary, key2 => 'あ'}, "basic");
2416
+$result = $dbi->execute('select length(key1) as key1_length from table1');
2417
+$row = $result->one;
2418
+is($row->{key1_length}, length $binary);
2419
+
2420
+test 'create_model';
2421
+$dbi = DBIx::Custom->connect(%memory);
2422
+$dbi->execute($create_table_default);
2423
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
2424
+
2425
+$dbi->create_model(
2426
+    table => 'table1',
2427
+    join => [
2428
+       'left outer join table2 on table1.key1 = table2.key1'
2429
+    ],
2430
+    primary_key => ['key1']
2431
+);
2432
+$model2 = $dbi->create_model(
2433
+    table => 'table2'
2434
+);
2435
+$dbi->create_model(
2436
+    table => 'table3',
2437
+    filter => [
2438
+        key1 => {in => sub { uc $_[0] }}
2439
+    ]
2440
+);
2441
+$dbi->setup_model;
2442
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2443
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 3});
2444
+$model = $dbi->model('table1');
2445
+$result = $model->select(
2446
+    column => [$model->mycolumn, $model->column('table2')],
2447
+    where => {'table1.key1' => 1}
2448
+);
2449
+is_deeply($result->one,
2450
+          {key1 => 1, key2 => 2, 'table2.key1' => 1, 'table2.key3' => 3});
2451
+is_deeply($model2->select->one, {key1 => 1, key3 => 3});
2452
+
2453
+test 'model method';
2454
+test 'create_model';
2455
+$dbi = DBIx::Custom->connect(%memory);
2456
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
2457
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 3});
2458
+$model = $dbi->create_model(
2459
+    table => 'table2'
2460
+);
2461
+$model->method(foo => sub { shift->select(@_) });
2462
+is_deeply($model->foo->one, {key1 => 1, key3 => 3});
2463
+
2464
+test 'merge_param';
2465
+$dbi = DBIx::Custom->new;
2466
+$params = [
2467
+    {key1 => 1, key2 => 2, key3 => 3},
2468
+    {key1 => 1, key2 => 2},
2469
+    {key1 => 1}
2470
+];
2471
+$param = $dbi->merge_param($params->[0], $params->[1], $params->[2]);
2472
+is_deeply($param, {key1 => [1, 1, 1], key2 => [2, 2], key3 => 3});
2473
+
2474
+$params = [
2475
+    {key1 => [1, 2], key2 => 1, key3 => [1, 2]},
2476
+    {key1 => [3, 4], key2 => [2, 3], key3 => 3}
2477
+];
2478
+$param = $dbi->merge_param($params->[0], $params->[1]);
2479
+is_deeply($param, {key1 => [1, 2, 3, 4], key2 => [1, 2, 3], key3 => [1, 2, 3]});
2480
+
2481
+test 'select() param option';
2482
+$dbi = DBIx::Custom->connect(%memory);
2483
+$dbi->execute($create_table_default);
2484
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2485
+$dbi->insert(table => 'table1', param => {key1 => 2, key2 => 3});
2486
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
2487
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 4});
2488
+$dbi->insert(table => 'table2', param => {key1 => 2, key3 => 5});
2489
+$rows = $dbi->select(
2490
+    table => 'table1',
2491
+    column => 'table1.key1 as table1_key1, key2, key3',
2492
+    where   => {'table1.key2' => 3},
2493
+    join  => ['inner join (select * from table2 where {= table2.key3})' . 
2494
+              ' as table2 on table1.key1 = table2.key1'],
2495
+    param => {'table2.key3' => 5}
2496
+)->all;
2497
+is_deeply($rows, [{table1_key1 => 2, key2 => 3, key3 => 5}]);
2498
+
2499
+
2500
+test 'select() wrap option';
2501
+$dbi = DBIx::Custom->connect(%memory);
2502
+$dbi->execute($create_table_default);
2503
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2504
+$dbi->insert(table => 'table1', param => {key1 => 2, key2 => 3});
2505
+$rows = $dbi->select(
2506
+    table => 'table1',
2507
+    column => 'key1',
2508
+    wrap => ['select * from (', ') as t where key1 = 1']
2509
+)->all;
2510
+is_deeply($rows, [{key1 => 1}]);
2511
+
2512
+eval {
2513
+$dbi->select(
2514
+    table => 'table1',
2515
+    column => 'key1',
2516
+    wrap => 'select * from ('
2517
+)
2518
+};
2519
+like($@, qr/array/);
2520
+
2521
+test 'select() string where';
2522
+$dbi = DBIx::Custom->connect(%memory);
2523
+$dbi->execute($create_table_default);
2524
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2525
+$dbi->insert(table => 'table1', param => {key1 => 2, key2 => 3});
2526
+$rows = $dbi->select(
2527
+    table => 'table1',
2528
+    where => 'key1 = :key1 and key2 = :key2',
2529
+    where_param => {key1 => 1, key2 => 2}
2530
+)->all;
2531
+is_deeply($rows, [{key1 => 1, key2 => 2}]);
2532
+
2533
+$dbi = DBIx::Custom->connect(%memory);
2534
+$dbi->execute($create_table_default);
2535
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2536
+$dbi->insert(table => 'table1', param => {key1 => 2, key2 => 3});
2537
+$rows = $dbi->select(
2538
+    table => 'table1',
2539
+    where => [
2540
+        'key1 = :key1 and key2 = :key2',
2541
+        {key1 => 1, key2 => 2}
2542
+    ]
2543
+)->all;
2544
+is_deeply($rows, [{key1 => 1, key2 => 2}]);
2545
+
2546
+test 'delete() string where';
2547
+$dbi = DBIx::Custom->connect(%memory);
2548
+$dbi->execute($create_table_default);
2549
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2550
+$dbi->insert(table => 'table1', param => {key1 => 2, key2 => 3});
2551
+$dbi->delete(
2552
+    table => 'table1',
2553
+    where => 'key1 = :key1 and key2 = :key2',
2554
+    where_param => {key1 => 1, key2 => 2}
2555
+);
2556
+$rows = $dbi->select(table => 'table1')->all;
2557
+is_deeply($rows, [{key1 => 2, key2 => 3}]);
2558
+
2559
+$dbi = DBIx::Custom->connect(%memory);
2560
+$dbi->execute($create_table_default);
2561
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2562
+$dbi->insert(table => 'table1', param => {key1 => 2, key2 => 3});
2563
+$dbi->delete(
2564
+    table => 'table1',
2565
+    where => [
2566
+        'key1 = :key1 and key2 = :key2',
2567
+         {key1 => 1, key2 => 2}
2568
+    ]
2569
+);
2570
+$rows = $dbi->select(table => 'table1')->all;
2571
+is_deeply($rows, [{key1 => 2, key2 => 3}]);
2572
+
2573
+
2574
+test 'update() string where';
2575
+$dbi = DBIx::Custom->connect(%memory);
2576
+$dbi->execute($create_table_default);
2577
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2578
+$dbi->update(
2579
+    table => 'table1',
2580
+    param => {key1 => 5},
2581
+    where => 'key1 = :key1 and key2 = :key2',
2582
+    where_param => {key1 => 1, key2 => 2}
2583
+);
2584
+$rows = $dbi->select(table => 'table1')->all;
2585
+is_deeply($rows, [{key1 => 5, key2 => 2}]);
2586
+
2587
+$dbi = DBIx::Custom->connect(%memory);
2588
+$dbi->execute($create_table_default);
2589
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2590
+$dbi->update(
2591
+    table => 'table1',
2592
+    param => {key1 => 5},
2593
+    where => [
2594
+        'key1 = :key1 and key2 = :key2',
2595
+        {key1 => 1, key2 => 2}
2596
+    ]
2597
+);
2598
+$rows = $dbi->select(table => 'table1')->all;
2599
+is_deeply($rows, [{key1 => 5, key2 => 2}]);
2600
+
2601
+test 'insert id and primary_key option';
2602
+$dbi = DBIx::Custom->connect(%memory);
2603
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
2604
+$dbi->insert(
2605
+    primary_key => ['key1', 'key2'], 
2606
+    table => 'table1',
2607
+    id => [1, 2],
2608
+    param => {key3 => 3}
2609
+);
2610
+is($dbi->select(table => 'table1')->one->{key1}, 1);
2611
+is($dbi->select(table => 'table1')->one->{key2}, 2);
2612
+is($dbi->select(table => 'table1')->one->{key3}, 3);
2613
+
2614
+$dbi->delete_all(table => 'table1');
2615
+$dbi->insert(
2616
+    primary_key => 'key1', 
2617
+    table => 'table1',
2618
+    id => 0,
2619
+    param => {key2 => 2, key3 => 3}
2620
+);
2621
+
2622
+is($dbi->select(table => 'table1')->one->{key1}, 0);
2623
+is($dbi->select(table => 'table1')->one->{key2}, 2);
2624
+is($dbi->select(table => 'table1')->one->{key3}, 3);
2625
+
2626
+$dbi = DBIx::Custom->connect(%memory);
2627
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
2628
+$dbi->insert(
2629
+    {key3 => 3},
2630
+    primary_key => ['key1', 'key2'], 
2631
+    table => 'table1',
2632
+    id => [1, 2],
2633
+);
2634
+is($dbi->select(table => 'table1')->one->{key1}, 1);
2635
+is($dbi->select(table => 'table1')->one->{key2}, 2);
2636
+is($dbi->select(table => 'table1')->one->{key3}, 3);
2637
+
2638
+
2639
+test 'model insert id and primary_key option';
2640
+$dbi = MyDBI6->connect(%memory);
2641
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
2642
+$dbi->model('table1')->insert(
2643
+    id => [1, 2],
2644
+    param => {key3 => 3}
2645
+);
2646
+$result = $dbi->model('table1')->select;
2647
+$row = $result->one;
2648
+is($row->{key1}, 1);
2649
+is($row->{key2}, 2);
2650
+is($row->{key3}, 3);
2651
+
2652
+$dbi = MyDBI6->connect(%memory);
2653
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
2654
+$dbi->model('table1')->insert(
2655
+    {key3 => 3},
2656
+    id => [1, 2]
2657
+);
2658
+$result = $dbi->model('table1')->select;
2659
+$row = $result->one;
2660
+is($row->{key1}, 1);
2661
+is($row->{key2}, 2);
2662
+is($row->{key3}, 3);
2663
+
2664
+test 'update and id option';
2665
+$dbi = DBIx::Custom->connect(%memory);
2666
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
2667
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
2668
+$dbi->update(
2669
+    table => 'table1',
2670
+    primary_key => ['key1', 'key2'],
2671
+    id => [1, 2],
2672
+    param => {key3 => 4}
2673
+);
2674
+is($dbi->select(table => 'table1')->one->{key1}, 1);
2675
+is($dbi->select(table => 'table1')->one->{key2}, 2);
2676
+is($dbi->select(table => 'table1')->one->{key3}, 4);
2677
+
2678
+$dbi->delete_all(table => 'table1');
2679
+$dbi->insert(table => 'table1', param => {key1 => 0, key2 => 2, key3 => 3});
2680
+$dbi->update(
2681
+    table => 'table1',
2682
+    primary_key => 'key1',
2683
+    id => 0,
2684
+    param => {key3 => 4}
2685
+);
2686
+is($dbi->select(table => 'table1')->one->{key1}, 0);
2687
+is($dbi->select(table => 'table1')->one->{key2}, 2);
2688
+is($dbi->select(table => 'table1')->one->{key3}, 4);
2689
+
2690
+$dbi = DBIx::Custom->connect(%memory);
2691
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
2692
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
2693
+$dbi->update(
2694
+    {key3 => 4},
2695
+    table => 'table1',
2696
+    primary_key => ['key1', 'key2'],
2697
+    id => [1, 2]
2698
+);
2699
+is($dbi->select(table => 'table1')->one->{key1}, 1);
2700
+is($dbi->select(table => 'table1')->one->{key2}, 2);
2701
+is($dbi->select(table => 'table1')->one->{key3}, 4);
2702
+
2703
+
2704
+test 'model update and id option';
2705
+$dbi = MyDBI6->connect(%memory);
2706
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
2707
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
2708
+$dbi->model('table1')->update(
2709
+    id => [1, 2],
2710
+    param => {key3 => 4}
2711
+);
2712
+$result = $dbi->model('table1')->select;
2713
+$row = $result->one;
2714
+is($row->{key1}, 1);
2715
+is($row->{key2}, 2);
2716
+is($row->{key3}, 4);
2717
+
2718
+
2719
+test 'delete and id option';
2720
+$dbi = DBIx::Custom->connect(%memory);
2721
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
2722
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
2723
+$dbi->delete(
2724
+    table => 'table1',
2725
+    primary_key => ['key1', 'key2'],
2726
+    id => [1, 2],
2727
+);
2728
+is_deeply($dbi->select(table => 'table1')->all, []);
2729
+
2730
+$dbi->insert(table => 'table1', param => {key1 => 0, key2 => 2, key3 => 3});
2731
+$dbi->delete(
2732
+    table => 'table1',
2733
+    primary_key => 'key1',
2734
+    id => 0,
2735
+);
2736
+is_deeply($dbi->select(table => 'table1')->all, []);
2737
+
2738
+
2739
+test 'model delete and id option';
2740
+$dbi = MyDBI6->connect(%memory);
2741
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
2742
+$dbi->execute("create table table2 (key1, key2, key3)");
2743
+$dbi->execute("create table table3 (key1, key2, key3)");
2744
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
2745
+$dbi->model('table1')->delete(id => [1, 2]);
2746
+is_deeply($dbi->select(table => 'table1')->all, []);
2747
+$dbi->insert(table => 'table2', param => {key1 => 1, key2 => 2, key3 => 3});
2748
+$dbi->model('table1_1')->delete(id => [1, 2]);
2749
+is_deeply($dbi->select(table => 'table1')->all, []);
2750
+$dbi->insert(table => 'table3', param => {key1 => 1, key2 => 2, key3 => 3});
2751
+$dbi->model('table1_3')->delete(id => [1, 2]);
2752
+is_deeply($dbi->select(table => 'table1')->all, []);
2753
+
2754
+
2755
+test 'select and id option';
2756
+$dbi = DBIx::Custom->connect(%memory);
2757
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
2758
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
2759
+$result = $dbi->select(
2760
+    table => 'table1',
2761
+    primary_key => ['key1', 'key2'],
2762
+    id => [1, 2]
2763
+);
2764
+$row = $result->one;
2765
+is($row->{key1}, 1);
2766
+is($row->{key2}, 2);
2767
+is($row->{key3}, 3);
2768
+
2769
+$dbi->delete_all(table => 'table1');
2770
+$dbi->insert(table => 'table1', param => {key1 => 0, key2 => 2, key3 => 3});
2771
+$result = $dbi->select(
2772
+    table => 'table1',
2773
+    primary_key => 'key1',
2774
+    id => 0,
2775
+);
2776
+$row = $result->one;
2777
+is($row->{key1}, 0);
2778
+is($row->{key2}, 2);
2779
+is($row->{key3}, 3);
2780
+
2781
+$dbi->delete_all(table => 'table1');
2782
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
2783
+$result = $dbi->select(
2784
+    table => 'table1',
2785
+    primary_key => ['key1', 'key2'],
2786
+    id => [1, 2]
2787
+);
2788
+$row = $result->one;
2789
+is($row->{key1}, 1);
2790
+is($row->{key2}, 2);
2791
+is($row->{key3}, 3);
2792
+
2793
+
2794
+test 'model select_at';
2795
+$dbi = MyDBI6->connect(%memory);
2796
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
2797
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
2798
+$result = $dbi->model('table1')->select(id => [1, 2]);
2799
+$row = $result->one;
2800
+is($row->{key1}, 1);
2801
+is($row->{key2}, 2);
2802
+is($row->{key3}, 3);
2803
+
2804
+test 'column separator is default .';
2805
+$dbi = MyDBI7->connect(%memory);
2806
+$dbi->execute($create_table_default);
2807
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
2808
+$dbi->setup_model;
2809
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
2810
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 3});
2811
+$model = $dbi->model('table1');
2812
+$result = $model->select(
2813
+    column => [$model->column('table2')],
2814
+    where => {'table1.key1' => 1}
2815
+);
2816
+is_deeply($result->one,
2817
+          {'table2.key1' => 1, 'table2.key3' => 3});
2818
+
2819
+$result = $model->select(
2820
+    column => [$model->column('table2' => [qw/key1 key3/])],
2821
+    where => {'table1.key1' => 1}
2822
+);
2823
+is_deeply($result->one,
2824
+          {'table2.key1' => 1, 'table2.key3' => 3});
2825
+
2826
+
2827
+test 'type_rule from';
2828
+$dbi = DBIx::Custom->connect(%memory);
2829
+$dbi->type_rule(
2830
+    from1 => {
2831
+        date => sub { uc $_[0] }
2832
+    }
2833
+);
2834
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
2835
+$dbi->insert({key1 => 'a'}, table => 'table1');
2836
+$result = $dbi->select(table => 'table1');
2837
+is($result->fetch_first->[0], 'A');
2838
+
2839
+$result = $dbi->select(table => 'table1');
2840
+is($result->one->{key1}, 'A');
2841
+
2842
+
2843
+test 'type_rule into';
2844
+$dbi = DBIx::Custom->connect(%memory);
2845
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
2846
+$dbi->type_rule(
2847
+    into1 => {
2848
+        date => sub { uc $_[0] }
2849
+    }
2850
+);
2851
+$dbi->insert({key1 => 'a'}, table => 'table1');
2852
+$result = $dbi->select(table => 'table1');
2853
+is($result->one->{key1}, 'A');
2854
+
2855
+$dbi = DBIx::Custom->connect(%memory);
2856
+$dbi->execute("create table table1 (key1 date, key2 datetime)");
2857
+$dbi->type_rule(
2858
+    into1 => [
2859
+         [qw/date datetime/] => sub { uc $_[0] }
2860
+    ]
2861
+);
2862
+$dbi->insert({key1 => 'a', key2 => 'b'}, table => 'table1');
2863
+$result = $dbi->select(table => 'table1');
2864
+$row = $result->one;
2865
+is($row->{key1}, 'A');
2866
+is($row->{key2}, 'B');
2867
+
2868
+$dbi = DBIx::Custom->connect(%memory);
2869
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
2870
+$dbi->insert({key1 => 'a', key2 => 'B'}, table => 'table1');
2871
+$dbi->type_rule(
2872
+    into1 => [
2873
+        [qw/date datetime/] => sub { uc $_[0] }
2874
+    ]
2875
+);
2876
+$result = $dbi->execute(
2877
+    "select * from table1 where key1 = :key1 and key2 = :table1.key2;",
2878
+    param => {key1 => 'a', 'table1.key2' => 'b'}
2879
+);
2880
+$row = $result->one;
2881
+is($row->{key1}, 'a');
2882
+is($row->{key2}, 'B');
2883
+
2884
+$dbi = DBIx::Custom->connect(%memory);
2885
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
2886
+$dbi->insert({key1 => 'A', key2 => 'B'}, table => 'table1');
2887
+$dbi->type_rule(
2888
+    into1 => [
2889
+        [qw/date datetime/] => sub { uc $_[0] }
2890
+    ]
2891
+);
2892
+$result = $dbi->execute(
2893
+    "select * from table1 where key1 = :key1 and key2 = :table1.key2;",
2894
+    param => {key1 => 'a', 'table1.key2' => 'b'},
2895
+    table => 'table1'
2896
+);
2897
+$row = $result->one;
2898
+is($row->{key1}, 'A');
2899
+is($row->{key2}, 'B');
2900
+
2901
+$dbi = DBIx::Custom->connect(%memory);
2902
+$dbi->execute("create table table1 (key1 date, key2 datetime)");
2903
+$dbi->register_filter(twice => sub { $_[0] * 2 });
2904
+$dbi->type_rule(
2905
+    from1 => {
2906
+        date => 'twice',
2907
+    },
2908
+    into1 => {
2909
+        date => 'twice',
2910
+    }
2911
+);
2912
+$dbi->insert({key1 => 2}, table => 'table1');
2913
+$result = $dbi->select(table => 'table1');
2914
+is($result->fetch->[0], 8);
2915
+
2916
+test 'type_rule and filter order';
2917
+$dbi = DBIx::Custom->connect(%memory);
2918
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
2919
+$dbi->type_rule(
2920
+    into1 => {
2921
+        date => sub { $_[0] . 'b' }
2922
+    },
2923
+    into2 => {
2924
+        date => sub { $_[0] . 'c' }
2925
+    },
2926
+    from1 => {
2927
+        date => sub { $_[0] . 'd' }
2928
+    },
2929
+    from2 => {
2930
+        date => sub { $_[0] . 'e' }
2931
+    }
2932
+);
2933
+$dbi->insert({key1 => '1'}, table => 'table1', filter => {key1 => sub { $_[0] . 'a' }});
2934
+$result = $dbi->select(table => 'table1');
2935
+$result->filter(key1 => sub { $_[0] . 'f' });
2936
+is($result->fetch_first->[0], '1abcdef');
2937
+
2938
+$dbi = DBIx::Custom->connect(%memory);
2939
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
2940
+$dbi->type_rule(
2941
+    from1 => {
2942
+        date => sub { $_[0] . 'p' }
2943
+    },
2944
+    from2 => {
2945
+        date => sub { $_[0] . 'q' }
2946
+    },
2947
+);
2948
+$dbi->insert({key1 => '1'}, table => 'table1');
2949
+$result = $dbi->select(table => 'table1');
2950
+$result->type_rule(
2951
+    from1 => {
2952
+        date => sub { $_[0] . 'd' }
2953
+    },
2954
+    from2 => {
2955
+        date => sub { $_[0] . 'e' }
2956
+    }
2957
+);
2958
+$result->filter(key1 => sub { $_[0] . 'f' });
2959
+is($result->fetch_first->[0], '1def');
2960
+
2961
+test 'type_rule_off';
2962
+$dbi = DBIx::Custom->connect(%memory);
2963
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
2964
+$dbi->type_rule(
2965
+    from1 => {
2966
+        date => sub { $_[0] * 2 },
2967
+    },
2968
+    into1 => {
2969
+        date => sub { $_[0] * 2 },
2970
+    }
2971
+);
2972
+$dbi->insert({key1 => 2}, table => 'table1', type_rule_off => 1);
2973
+$result = $dbi->select(table => 'table1', type_rule_off => 1);
2974
+is($result->type_rule_off->fetch->[0], 2);
2975
+
2976
+$dbi = DBIx::Custom->connect(%memory);
2977
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
2978
+$dbi->type_rule(
2979
+    from1 => {
2980
+        date => sub { $_[0] * 2 },
2981
+    },
2982
+    into1 => {
2983
+        date => sub { $_[0] * 3 },
2984
+    }
2985
+);
2986
+$dbi->insert({key1 => 2}, table => 'table1', type_rule_off => 1);
2987
+$result = $dbi->select(table => 'table1', type_rule_off => 1);
2988
+is($result->one->{key1}, 4);
2989
+
2990
+$dbi = DBIx::Custom->connect(%memory);
2991
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
2992
+$dbi->type_rule(
2993
+    from1 => {
2994
+        date => sub { $_[0] * 2 },
2995
+    },
2996
+    into1 => {
2997
+        date => sub { $_[0] * 3 },
2998
+    }
2999
+);
3000
+$dbi->insert({key1 => 2}, table => 'table1');
3001
+$result = $dbi->select(table => 'table1');
3002
+is($result->one->{key1}, 12);
3003
+
3004
+$dbi = DBIx::Custom->connect(%memory);
3005
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
3006
+$dbi->type_rule(
3007
+    from1 => {
3008
+        date => sub { $_[0] * 2 },
3009
+    },
3010
+    into1 => {
3011
+        date => sub { $_[0] * 3 },
3012
+    }
3013
+);
3014
+$dbi->insert({key1 => 2}, table => 'table1');
3015
+$result = $dbi->select(table => 'table1');
3016
+is($result->fetch->[0], 12);
3017
+
3018
+$dbi = DBIx::Custom->connect(%memory);
3019
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
3020
+$dbi->register_filter(ppp => sub { uc $_[0] });
3021
+$dbi->type_rule(
3022
+    into1 => {
3023
+        date => 'ppp'
3024
+    }
3025
+);
3026
+$dbi->insert({key1 => 'a'}, table => 'table1');
3027
+$result = $dbi->select(table => 'table1');
3028
+is($result->one->{key1}, 'A');
3029
+
3030
+eval{$dbi->type_rule(
3031
+    into1 => {
3032
+        date => 'pp'
3033
+    }
3034
+)};
3035
+like($@, qr/not registered/);
3036
+
3037
+$dbi = DBIx::Custom->connect(%memory);
3038
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
3039
+eval {
3040
+    $dbi->type_rule(
3041
+        from1 => {
3042
+            Date => sub { $_[0] * 2 },
3043
+        }
3044
+    );
3045
+};
3046
+like($@, qr/lower/);
3047
+
3048
+eval {
3049
+    $dbi->type_rule(
3050
+        into1 => {
3051
+            Date => sub { $_[0] * 2 },
3052
+        }
3053
+    );
3054
+};
3055
+like($@, qr/lower/);
3056
+
3057
+$dbi = DBIx::Custom->connect(%memory);
3058
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
3059
+$dbi->type_rule(
3060
+    from1 => {
3061
+        date => sub { $_[0] * 2 },
3062
+    },
3063
+    into1 => {
3064
+        date => sub { $_[0] * 3 },
3065
+    }
3066
+);
3067
+$dbi->insert({key1 => 2}, table => 'table1');
3068
+$result = $dbi->select(table => 'table1');
3069
+$result->type_rule_off;
3070
+is($result->one->{key1}, 6);
3071
+
3072
+$dbi = DBIx::Custom->connect(%memory);
3073
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
3074
+$dbi->type_rule(
3075
+    from1 => {
3076
+        date => sub { $_[0] * 2 },
3077
+        datetime => sub { $_[0] * 4 },
3078
+    },
3079
+);
3080
+$dbi->insert({key1 => 2, key2 => 2}, table => 'table1');
3081
+$result = $dbi->select(table => 'table1');
3082
+$result->type_rule(
3083
+    from1 => {
3084
+        date => sub { $_[0] * 3 }
3085
+    }
3086
+);
3087
+$row = $result->one;
3088
+is($row->{key1}, 6);
3089
+is($row->{key2}, 2);
3090
+
3091
+$result = $dbi->select(table => 'table1');
3092
+$result->type_rule(
3093
+    from1 => {
3094
+        date => sub { $_[0] * 3 }
3095
+    }
3096
+);
3097
+$row = $result->one;
3098
+is($row->{key1}, 6);
3099
+is($row->{key2}, 2);
3100
+
3101
+$result = $dbi->select(table => 'table1');
3102
+$result->type_rule(
3103
+    from1 => {
3104
+        date => sub { $_[0] * 3 }
3105
+    }
3106
+);
3107
+$row = $result->one;
3108
+is($row->{key1}, 6);
3109
+is($row->{key2}, 2);
3110
+$result = $dbi->select(table => 'table1');
3111
+$result->type_rule(
3112
+    from1 => [date => sub { $_[0] * 3 }]
3113
+);
3114
+$row = $result->one;
3115
+is($row->{key1}, 6);
3116
+is($row->{key2}, 2);
3117
+$dbi->register_filter(fivetimes => sub { $_[0] * 5});
3118
+$result = $dbi->select(table => 'table1');
3119
+$result->type_rule(
3120
+    from1 => [date => 'fivetimes']
3121
+);
3122
+$row = $result->one;
3123
+is($row->{key1}, 10);
3124
+is($row->{key2}, 2);
3125
+$result = $dbi->select(table => 'table1');
3126
+$result->type_rule(
3127
+    from1 => [date => undef]
3128
+);
3129
+$row = $result->one;
3130
+is($row->{key1}, 2);
3131
+is($row->{key2}, 2);
3132
+
3133
+$dbi = DBIx::Custom->connect(%memory);
3134
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
3135
+$dbi->type_rule(
3136
+    from1 => {
3137
+        date => sub { $_[0] * 2 },
3138
+    },
3139
+);
3140
+$dbi->insert({key1 => 2}, table => 'table1');
3141
+$result = $dbi->select(table => 'table1');
3142
+$result->filter(key1 => sub { $_[0] * 3 });
3143
+is($result->one->{key1}, 12);
3144
+
3145
+$dbi = DBIx::Custom->connect(%memory);
3146
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
3147
+$dbi->type_rule(
3148
+    from1 => {
3149
+        date => sub { $_[0] * 2 },
3150
+    },
3151
+);
3152
+$dbi->insert({key1 => 2}, table => 'table1');
3153
+$result = $dbi->select(table => 'table1');
3154
+$result->filter(key1 => sub { $_[0] * 3 });
3155
+is($result->fetch->[0], 12);
3156
+
3157
+$dbi = DBIx::Custom->connect(%memory);
3158
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
3159
+$dbi->type_rule(
3160
+    into1 => {
3161
+        date => sub { $_[0] . 'b' }
3162
+    },
3163
+    into2 => {
3164
+        date => sub { $_[0] . 'c' }
3165
+    },
3166
+    from1 => {
3167
+        date => sub { $_[0] . 'd' }
3168
+    },
3169
+    from2 => {
3170
+        date => sub { $_[0] . 'e' }
3171
+    }
3172
+);
3173
+$dbi->insert({key1 => '1'}, table => 'table1', type_rule_off => 1);
3174
+$result = $dbi->select(table => 'table1');
3175
+is($result->type_rule_off->fetch_first->[0], '1');
3176
+$result = $dbi->select(table => 'table1');
3177
+is($result->type_rule_on->fetch_first->[0], '1de');
3178
+
3179
+$dbi = DBIx::Custom->connect(%memory);
3180
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
3181
+$dbi->type_rule(
3182
+    into1 => {
3183
+        date => sub { $_[0] . 'b' }
3184
+    },
3185
+    into2 => {
3186
+        date => sub { $_[0] . 'c' }
3187
+    },
3188
+    from1 => {
3189
+        date => sub { $_[0] . 'd' }
3190
+    },
3191
+    from2 => {
3192
+        date => sub { $_[0] . 'e' }
3193
+    }
3194
+);
3195
+$dbi->insert({key1 => '1'}, table => 'table1', type_rule1_off => 1);
3196
+$result = $dbi->select(table => 'table1');
3197
+is($result->type_rule1_off->fetch_first->[0], '1ce');
3198
+$result = $dbi->select(table => 'table1');
3199
+is($result->type_rule1_on->fetch_first->[0], '1cde');
3200
+
3201
+$dbi = DBIx::Custom->connect(%memory);
3202
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
3203
+$dbi->type_rule(
3204
+    into1 => {
3205
+        date => sub { $_[0] . 'b' }
3206
+    },
3207
+    into2 => {
3208
+        date => sub { $_[0] . 'c' }
3209
+    },
3210
+    from1 => {
3211
+        date => sub { $_[0] . 'd' }
3212
+    },
3213
+    from2 => {
3214
+        date => sub { $_[0] . 'e' }
3215
+    }
3216
+);
3217
+$dbi->insert({key1 => '1'}, table => 'table1', type_rule2_off => 1);
3218
+$result = $dbi->select(table => 'table1');
3219
+is($result->type_rule2_off->fetch_first->[0], '1bd');
3220
+$result = $dbi->select(table => 'table1');
3221
+is($result->type_rule2_on->fetch_first->[0], '1bde');
3222
+
3223
+test 'separator';
3224
+$dbi = DBIx::Custom->connect(%memory);
3225
+$dbi->execute($create_table_default);
3226
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
3227
+
3228
+$dbi->create_model(
3229
+    table => 'table1',
3230
+    join => [
3231
+       'left outer join table2 on table1.key1 = table2.key1'
3232
+    ],
3233
+    primary_key => ['key1'],
3234
+);
3235
+$model2 = $dbi->create_model(
3236
+    table => 'table2',
3237
+);
3238
+$dbi->setup_model;
3239
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
3240
+$dbi->insert(table => 'table2', param => {key1 => 1, key3 => 3});
3241
+$model = $dbi->model('table1');
3242
+$result = $model->select(
3243
+    column => [
3244
+        $model->mycolumn,
3245
+        {table2 => [qw/key1 key3/]}
3246
+    ],
3247
+    where => {'table1.key1' => 1}
3248
+);
3249
+is_deeply($result->one,
3250
+          {key1 => 1, key2 => 2, 'table2.key1' => 1, 'table2.key3' => 3});
3251
+is_deeply($model2->select->one, {key1 => 1, key3 => 3});
3252
+
3253
+$dbi->separator('__');
3254
+$model = $dbi->model('table1');
3255
+$result = $model->select(
3256
+    column => [
3257
+        $model->mycolumn,
3258
+        {table2 => [qw/key1 key3/]}
3259
+    ],
3260
+    where => {'table1.key1' => 1}
3261
+);
3262
+is_deeply($result->one,
3263
+          {key1 => 1, key2 => 2, 'table2__key1' => 1, 'table2__key3' => 3});
3264
+is_deeply($model2->select->one, {key1 => 1, key3 => 3});
3265
+
3266
+$dbi->separator('-');
3267
+$model = $dbi->model('table1');
3268
+$result = $model->select(
3269
+    column => [
3270
+        $model->mycolumn,
3271
+        {table2 => [qw/key1 key3/]}
3272
+    ],
3273
+    where => {'table1.key1' => 1}
3274
+);
3275
+is_deeply($result->one,
3276
+          {key1 => 1, key2 => 2, 'table2-key1' => 1, 'table2-key3' => 3});
3277
+is_deeply($model2->select->one, {key1 => 1, key3 => 3});
3278
+
3279
+
3280
+test 'filter_off';
3281
+$dbi = DBIx::Custom->connect(%memory);
3282
+$dbi->execute($create_table_default);
3283
+$dbi->execute('create table table2 (key1 char(255), key3 char(255));');
3284
+
3285
+$dbi->create_model(
3286
+    table => 'table1',
3287
+    join => [
3288
+       'left outer join table2 on table1.key1 = table2.key1'
3289
+    ],
3290
+    primary_key => ['key1'],
3291
+);
3292
+$dbi->setup_model;
3293
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
3294
+$model = $dbi->model('table1');
3295
+$result = $model->select(column => 'key1');
3296
+$result->filter(key1 => sub { $_[0] * 2 });
3297
+is_deeply($result->one, {key1 => 2});
3298
+
3299
+test 'available_date_type';
3300
+$dbi = DBIx::Custom->connect(%memory);
3301
+ok($dbi->can('available_data_type'));
3302
+
3303
+
3304
+test 'select prefix option';
3305
+$dbi = DBIx::Custom->connect(%memory);
3306
+$dbi->execute($create_table_default);
3307
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
3308
+$rows = $dbi->select(prefix => 'key1,', column => 'key2', table => 'table1')->all;
3309
+is_deeply($rows, [{key1 => 1, key2 => 2}], "table");
3310
+
3311
+
3312
+test 'separator';
3313
+$dbi = DBIx::Custom->connect(%memory);
3314
+is($dbi->separator, '.');
3315
+$dbi->separator('-');
3316
+is($dbi->separator, '-');
3317
+$dbi->separator('__');
3318
+is($dbi->separator, '__');
3319
+eval { $dbi->separator('?') };
3320
+like($@, qr/Separator/);
3321
+
3322
+
3323
+test 'map_param';
3324
+$dbi = DBIx::Custom->connect(%memory);
3325
+$param = $dbi->map_param(
3326
+    {id => 1, author => 'Ken', price => 1900},
3327
+    id => 'book.id',
3328
+    author => ['book.author', sub { '%' . $_[0] . '%' }],
3329
+    price => ['book.price', {if => sub { $_[0] eq 1900 }}]
3330
+);
3331
+is_deeply($param, {'book.id' => 1, 'book.author' => '%Ken%',
3332
+  'book.price' => 1900});
3333
+
3334
+$param = $dbi->map_param(
3335
+    {id => 0, author => 0, price => 0},
3336
+    id => 'book.id',
3337
+    author => ['book.author', sub { '%' . $_[0] . '%' }],
3338
+    price => ['book.price', sub { '%' . $_[0] . '%' },
3339
+      {if => sub { $_[0] eq 0 }}]
3340
+);
3341
+is_deeply($param, {'book.id' => 0, 'book.author' => '%0%', 'book.price' => '%0%'});
3342
+
3343
+$param = $dbi->map_param(
3344
+    {id => '', author => '', price => ''},
3345
+    id => 'book.id',
3346
+    author => ['book.author', sub { '%' . $_[0] . '%' }],
3347
+    price => ['book.price', sub { '%' . $_[0] . '%' },
3348
+      {if => sub { $_[0] eq 1 }}]
3349
+);
3350
+is_deeply($param, {});
3351
+
3352
+$param = $dbi->map_param(
3353
+    {id => undef, author => undef, price => undef},
3354
+    id => 'book.id',
3355
+    price => ['book.price', {if => 'exists'}]
3356
+);
3357
+is_deeply($param, {'book.price' => undef});
3358
+
3359
+$param = $dbi->map_param(
3360
+    {price => 'a'},
3361
+    id => ['book.id', {if => 'exists'}],
3362
+    price => ['book.price', sub { '%' . $_[0] }, {if => 'exists'}]
3363
+);
3364
+is_deeply($param, {'book.price' => '%a'});
3365
+
3366
+
3367
+test 'table_alias';
3368
+$dbi = DBIx::Custom->connect(%memory);
3369
+$dbi->execute("create table table1 (key1 Date, key2 datetime)");
3370
+$dbi->type_rule(
3371
+    into1 => {
3372
+        date => sub { uc $_[0] }
3373
+    }
3374
+);
3375
+$dbi->execute("insert into table1 (key1) values (:table2.key1)", {'table2.key1' => 'a'},
3376
+  table_alias => {table2 => 'table1'});
3377
+$result = $dbi->select(table => 'table1');
3378
+is($result->one->{key1}, 'A');
3379
+
3380
+
3381
+test 'order';
3382
+$dbi = DBIx::Custom->connect(%memory);
3383
+$dbi->execute("create table table1 (key1, key2)");
3384
+$dbi->insert({key1 => 1, key2 => 1}, table => 'table1');
3385
+$dbi->insert({key1 => 1, key2 => 3}, table => 'table1');
3386
+$dbi->insert({key1 => 2, key2 => 2}, table => 'table1');
3387
+$dbi->insert({key1 => 2, key2 => 4}, table => 'table1');
3388
+my $order = $dbi->order;
3389
+$order->prepend('key1', 'key2 desc');
3390
+$result = $dbi->select(table => 'table1', append => "$order");
3391
+is_deeply($result->all, [{key1 => 1, key2 => 3}, {key1 => 1, key2 => 1},
3392
+  {key1 => 2, key2 => 4}, {key1 => 2, key2 => 2}]);
3393
+$order->prepend('key1 desc');
3394
+$result = $dbi->select(table => 'table1', append => "$order");
3395
+is_deeply($result->all, [{key1 => 2, key2 => 4}, {key1 => 2, key2 => 2},
3396
+  {key1 => 1, key2 => 3}, {key1 => 1, key2 => 1}]);
3397
+
3398
+$order = $dbi->order;
3399
+$order->prepend(['table1-key1'], [qw/table1-key2 desc/]);
3400
+$result = $dbi->select(table => 'table1',
3401
+  column => [[key1 => 'table1-key1'], [key2 => 'table1-key2']],
3402
+  append => "$order");
3403
+is_deeply($result->all, [{'table1-key1' => 1, 'table1-key2' => 3},
3404
+  {'table1-key1' => 1, 'table1-key2' => 1},
3405
+  {'table1-key1' => 2, 'table1-key2' => 4},
3406
+  {'table1-key1' => 2, 'table1-key2' => 2}]);
3407
+
3408
+test 'tag_parse';
3409
+$dbi = DBIx::Custom->connect(%memory);
3410
+$dbi->tag_parse(0);
3411
+$dbi->execute("create table table1 (key1, key2)");
3412
+$dbi->insert({key1 => 1, key2 => 1}, table => 'table1');
3413
+eval {$dbi->execute("select * from table1 where {= key1}", {key1 => 1})};
3414
+ok($@);
3415
+
3416
+test 'last_sql';
3417
+$dbi = DBIx::Custom->connect(%memory);
3418
+$dbi->execute("create table table1 (key1, key2)");
3419
+$dbi->execute('select * from table1');
3420
+is($dbi->last_sql, 'select * from table1;');
3421
+
3422
+eval{$dbi->execute("aaa")};
3423
+is($dbi->last_sql, 'aaa;');
3424
+
3425
+test 'DBIx::Custom header';
3426
+$dbi = DBIx::Custom->connect(%memory);
3427
+$dbi->execute("create table table1 (key1, key2)");
3428
+$result = $dbi->execute('select key1 as h1, key2 as h2 from table1');
3429
+is_deeply($result->header, [qw/h1 h2/]);
3430
+
3431
+test 'Named placeholder :name(operater) syntax';
3432
+$dbi->execute('drop table table1');
3433
+$dbi->execute('create table table1 (key1 char(255), key2 char(255), key3 char(255), key4 char(255), key5 char(255));');
3434
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5});
3435
+$dbi->insert(table => 'table1', param => {key1 => 6, key2 => 7, key3 => 8, key4 => 9, key5 => 10});
3436
+
3437
+$source = "select * from table1 where :key1{=} and :key2{=}";
3438
+$result = $dbi->execute($source, param => {key1 => 1, key2 => 2});
3439
+$rows = $result->all;
3440
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}]);
3441
+
3442
+$source = "select * from table1 where :key1{ = } and :key2{=}";
3443
+$result = $dbi->execute($source, param => {key1 => 1, key2 => 2});
3444
+$rows = $result->all;
3445
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}]);
3446
+
3447
+$source = "select * from table1 where :key1{<} and :key2{=}";
3448
+$result = $dbi->execute($source, param => {key1 => 5, key2 => 2});
3449
+$rows = $result->all;
3450
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}]);
3451
+
3452
+$source = "select * from table1 where :table1.key1{=} and :table1.key2{=}";
3453
+$result = $dbi->execute(
3454
+    $source,
3455
+    param => {'table1.key1' => 1, 'table1.key2' => 1},
3456
+    filter => {'table1.key2' => sub { $_[0] * 2 }}
3457
+);
3458
+$rows = $result->all;
3459
+is_deeply($rows, [{key1 => 1, key2 => 2, key3 => 3, key4 => 4, key5 => 5}]);
3460
+
3461
+test 'high perfomance way';
3462
+$dbi->execute('drop table table1');
3463
+$dbi->execute("create table table1 (ab, bc, ik, hi, ui, pq, dc);");
3464
+$rows = [
3465
+    {ab => 1, bc => 2, ik => 3, hi => 4, ui => 5, pq => 6, dc => 7},
3466
+    {ab => 1, bc => 2, ik => 3, hi => 4, ui => 5, pq => 6, dc => 8},
3467
+];
3468
+{
3469
+    my $query;
3470
+    foreach my $row (@$rows) {
3471
+      $query ||= $dbi->insert($row, table => 'table1', query => 1);
3472
+      $dbi->execute($query, $row, filter => {ab => sub { $_[0] * 2 }});
3473
+    }
3474
+    is_deeply($dbi->select(table => 'table1')->all,
3475
+      [
3476
+          {ab => 2, bc => 2, ik => 3, hi => 4, ui => 5, pq => 6, dc => 7},
3477
+          {ab => 2, bc => 2, ik => 3, hi => 4, ui => 5, pq => 6, dc => 8},
3478
+      ]
3479
+    );
3480
+}
3481
+
3482
+$dbi->execute('drop table table1');
3483
+$dbi->execute("create table table1 (ab, bc, ik, hi, ui, pq, dc);");
3484
+$rows = [
3485
+    {ab => 1, bc => 2, ik => 3, hi => 4, ui => 5, pq => 6, dc => 7},
3486
+    {ab => 1, bc => 2, ik => 3, hi => 4, ui => 5, pq => 6, dc => 8},
3487
+];
3488
+{
3489
+    my $query;
3490
+    my $sth;
3491
+    foreach my $row (@$rows) {
3492
+      $query ||= $dbi->insert($row, table => 'table1', query => 1);
3493
+      $sth ||= $query->sth;
3494
+      $sth->execute(map { $row->{$_} } sort keys %$row);
3495
+    }
3496
+    is_deeply($dbi->select(table => 'table1')->all,
3497
+      [
3498
+          {ab => 1, bc => 2, ik => 3, hi => 4, ui => 5, pq => 6, dc => 7},
3499
+          {ab => 1, bc => 2, ik => 3, hi => 4, ui => 5, pq => 6, dc => 8},
3500
+      ]
3501
+    );
3502
+}
3503
+
3504
+test 'result';
3505
+$dbi = DBIx::Custom->connect(%memory);
3506
+$dbi->execute($create_table_default);
3507
+$dbi->insert({key1 => 1, key2 => 2}, table => 'table1');
3508
+$dbi->insert({key1 => 3, key2 => 4}, table => 'table1');
3509
+
3510
+$result = $dbi->select(table => 'table1');
3511
+@rows = ();
3512
+while (my $row = $result->fetch) {
3513
+    push @rows, [@$row];
3514
+}
3515
+is_deeply(\@rows, [[1, 2], [3, 4]]);
3516
+
3517
+$result = $dbi->select(table => 'table1');
3518
+@rows = ();
3519
+while (my $row = $result->fetch_hash) {
3520
+    push @rows, {%$row};
3521
+}
3522
+is_deeply(\@rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}]);
3523
+
3524
+$result = $dbi->select(table => 'table1');
3525
+$row = $result->fetch_first;
3526
+is_deeply($row, [1, 2], "row");
3527
+$row = $result->fetch;
3528
+ok(!$row, "finished");
3529
+
3530
+$result = $dbi->select(table => 'table1');
3531
+$row = $result->fetch_hash_first;
3532
+is_deeply($row, {key1 => 1, key2 => 2}, "row");
3533
+$row = $result->fetch_hash;
3534
+ok(!$row, "finished");
3535
+
3536
+$dbi->execute('create table table2 (key1, key2);');
3537
+$result = $dbi->select(table => 'table2');
3538
+$row = $result->fetch_hash_first;
3539
+ok(!$row, "no row fetch");
3540
+
3541
+$dbi = DBIx::Custom->connect(%memory);
3542
+$dbi->execute($create_table_default);
3543
+$dbi->insert({key1 => 1, key2 => 2}, table => 'table1');
3544
+$dbi->insert({key1 => 3, key2 => 4}, table => 'table1');
3545
+$dbi->insert({key1 => 5, key2 => 6}, table => 'table1');
3546
+$dbi->insert({key1 => 7, key2 => 8}, table => 'table1');
3547
+$dbi->insert({key1 => 9, key2 => 10}, table => 'table1');
3548
+$result = $dbi->select(table => 'table1');
3549
+$rows = $result->fetch_multi(2);
3550
+is_deeply($rows, [[1, 2],
3551
+                  [3, 4]], "fetch_multi first");
3552
+$rows = $result->fetch_multi(2);
3553
+is_deeply($rows, [[5, 6],
3554
+                  [7, 8]], "fetch_multi secound");
3555
+$rows = $result->fetch_multi(2);
3556
+is_deeply($rows, [[9, 10]], "fetch_multi third");
3557
+$rows = $result->fetch_multi(2);
3558
+ok(!$rows);
3559
+
3560
+$result = $dbi->select(table => 'table1');
3561
+eval {$result->fetch_multi};
3562
+like($@, qr/Row count must be specified/, "Not specified row count");
3563
+
3564
+$result = $dbi->select(table => 'table1');
3565
+$rows = $result->fetch_hash_multi(2);
3566
+is_deeply($rows, [{key1 => 1, key2 => 2},
3567
+                  {key1 => 3, key2 => 4}], "fetch_multi first");
3568
+$rows = $result->fetch_hash_multi(2);
3569
+is_deeply($rows, [{key1 => 5, key2 => 6},
3570
+                  {key1 => 7, key2 => 8}], "fetch_multi secound");
3571
+$rows = $result->fetch_hash_multi(2);
3572
+is_deeply($rows, [{key1 => 9, key2 => 10}], "fetch_multi third");
3573
+$rows = $result->fetch_hash_multi(2);
3574
+ok(!$rows);
3575
+
3576
+$result = $dbi->select(table => 'table1');
3577
+eval {$result->fetch_hash_multi};
3578
+like($@, qr/Row count must be specified/, "Not specified row count");
3579
+
3580
+$dbi = DBIx::Custom->connect(%memory);
3581
+$dbi->execute($create_table_default);
3582
+$dbi->insert({key1 => 1, key2 => 2}, table => 'table1');
3583
+$dbi->insert({key1 => 3, key2 => 4}, table => 'table1');
3584
+
3585
+test 'fetch_all';
3586
+$result = $dbi->select(table => 'table1');
3587
+$rows = $result->fetch_all;
3588
+is_deeply($rows, [[1, 2], [3, 4]]);
3589
+
3590
+$result = $dbi->select(table => 'table1');
3591
+$rows = $result->fetch_hash_all;
3592
+is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}]);
3593
+
3594
+$result = $dbi->select(table => 'table1');
3595
+$result->dbi->filters({three_times => sub { $_[0] * 3}});
3596
+$result->filter({key1 => 'three_times'});
3597
+
3598
+$rows = $result->fetch_all;
3599
+is_deeply($rows, [[3, 2], [9, 4]], "array");
3600
+
3601
+$result = $dbi->select(table => 'table1');
3602
+$result->dbi->filters({three_times => sub { $_[0] * 3}});
3603
+$result->filter({key1 => 'three_times'});
3604
+$rows = $result->fetch_hash_all;
3605
+is_deeply($rows, [{key1 => 3, key2 => 2}, {key1 => 9, key2 => 4}], "hash");
3606
+
3607
+test "query_builder";
3608
+$datas = [
3609
+    # Basic tests
3610
+    {   name            => 'placeholder basic',
3611
+        source            => "a {?  k1} b {=  k2} {<> k3} {>  k4} {<  k5} {>= k6} {<= k7} {like k8}", ,
3612
+        sql_expected    => "a ? b k2 = ? k3 <> ? k4 > ? k5 < ? k6 >= ? k7 <= ? k8 like ?;",
3613
+        columns_expected   => [qw/k1 k2 k3 k4 k5 k6 k7 k8/]
3614
+    },
3615
+    {
3616
+        name            => 'placeholder in',
3617
+        source            => "{in k1 3};",
3618
+        sql_expected    => "k1 in (?, ?, ?);",
3619
+        columns_expected   => [qw/k1 k1 k1/]
3620
+    },
3621
+    
3622
+    # Table name
3623
+    {
3624
+        name            => 'placeholder with table name',
3625
+        source            => "{= a.k1} {= a.k2}",
3626
+        sql_expected    => "a.k1 = ? a.k2 = ?;",
3627
+        columns_expected  => [qw/a.k1 a.k2/]
3628
+    },
3629
+    {   
3630
+        name            => 'placeholder in with table name',
3631
+        source            => "{in a.k1 2} {in b.k2 2}",
3632
+        sql_expected    => "a.k1 in (?, ?) b.k2 in (?, ?);",
3633
+        columns_expected  => [qw/a.k1 a.k1 b.k2 b.k2/]
3634
+    },
3635
+    {
3636
+        name            => 'not contain tag',
3637
+        source            => "aaa",
3638
+        sql_expected    => "aaa;",
3639
+        columns_expected  => [],
3640
+    }
3641
+];
3642
+
3643
+for (my $i = 0; $i < @$datas; $i++) {
3644
+    my $data = $datas->[$i];
3645
+    my $builder = DBIx::Custom->new->query_builder;
3646
+    my $query = $builder->build_query($data->{source});
3647
+    is($query->{sql}, $data->{sql_expected}, "$data->{name} : sql");
3648
+    is_deeply($query->columns, $data->{columns_expected}, "$data->{name} : columns");
3649
+}
3650
+
3651
+$builder = DBIx::Custom->new->query_builder;
3652
+$ret_val = $builder->register_tag(
3653
+    p => sub {
3654
+        my @args = @_;
3655
+        
3656
+        my $expand    = "? $args[0] $args[1]";
3657
+        my $columns = [2];
3658
+        return [$expand, $columns];
3659
+    }
3660
+);
3661
+
3662
+$query = $builder->build_query("{p a b}");
3663
+is($query->{sql}, "? a b;", "register_tag sql");
3664
+is_deeply($query->{columns}, [2], "register_tag columns");
3665
+isa_ok($ret_val, 'DBIx::Custom::QueryBuilder');
3666
+
3667
+$builder = DBIx::Custom->new->query_builder;
3668
+
3669
+eval{$builder->build_query('{? }')};
3670
+like($@, qr/\QColumn name must be specified in tag "{? }"/, "? not arguments");
3671
+
3672
+eval{$builder->build_query("{a }")};
3673
+like($@, qr/\QTag "a" is not registered/, "tag not exist");
3674
+
3675
+$builder->register_tag({
3676
+    q => 'string'
3677
+});
3678
+
3679
+eval{$builder->build_query("{q}", {})};
3680
+like($@, qr/Tag "q" must be sub reference/, "tag not code ref");
3681
+
3682
+$builder->register_tag({
3683
+   r => sub {} 
3684
+});
3685
+
3686
+eval{$builder->build_query("{r}")};
3687
+like($@, qr/\QTag "r" must return [STRING, ARRAY_REFERENCE]/, "tag return noting");
3688
+
3689
+$builder->register_tag({
3690
+   s => sub { return ["a", ""]} 
3691
+});
3692
+
3693
+eval{$builder->build_query("{s}")};
3694
+like($@, qr/\QTag "s" must return [STRING, ARRAY_REFERENCE]/, "tag return not array columns");
3695
+
3696
+$builder->register_tag(
3697
+    t => sub {return ["a", []]}
3698
+);
3699
+
3700
+
3701
+test 'General error case';
3702
+$builder = DBIx::Custom->new->query_builder;
3703
+$builder->register_tag(
3704
+    a => sub {
3705
+        return ["? ? ?", ['']];
3706
+    }
3707
+);
3708
+eval{$builder->build_query("{a}")};
3709
+like($@, qr/\QPlaceholder count/, "placeholder count is invalid");
3710
+
3711
+
3712
+test 'Default tag Error case';
3713
+eval{$builder->build_query("{= }")};
3714
+like($@, qr/Column name must be specified in tag "{= }"/, "basic '=' : key not exist");
3715
+
3716
+eval{$builder->build_query("{in }")};
3717
+like($@, qr/Column name and count of values must be specified in tag "{in }"/, "in : key not exist");
3718
+
3719
+eval{$builder->build_query("{in a}")};
3720
+like($@, qr/\QColumn name and count of values must be specified in tag "{in }"/,
3721
+     "in : key not exist");
3722
+
3723
+eval{$builder->build_query("{in a r}")};
3724
+like($@, qr/\QColumn name and count of values must be specified in tag "{in }"/,
3725
+     "in : key not exist");
3726
+
3727
+test 'variouse source';
3728
+$source = "a {= b} c \\{ \\} {= \\{} {= \\}} d;";
3729
+$query = $builder->build_query($source);
3730
+is($query->sql, 'a b = ? c { } { = ? } = ? d;', "basic : 1");
3731
+
3732
+$source = "abc;";
3733
+$query = $builder->build_query($source);
3734
+is($query->sql, 'abc;', "basic : 2");
3735
+
3736
+$source = "{= a}";
3737
+$query = $builder->build_query($source);
3738
+is($query->sql, 'a = ?;', "only tag");
3739
+
3740
+$source = "000;";
3741
+$query = $builder->build_query($source);
3742
+is($query->sql, '000;', "contain 0 value");
3743
+
3744
+$source = "a {= b} }";
3745
+eval{$builder->build_query($source)};
3746
+like($@, qr/unexpected "}"/, "error : 1");
3747
+
3748
+$source = "a {= {}";
3749
+eval{$builder->build_query($source)};
3750
+like($@, qr/unexpected "{"/, "error : 2");
+19
DBIx-Custom-0.1711/t/basic/MyDBI1.pm
... ...
@@ -0,0 +1,19 @@
1
+package MyDBI1;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use base 'DBIx::Custom';
7
+
8
+sub connect {
9
+    my $self = shift->SUPER::connect(@_);
10
+    
11
+    $self->include_model(
12
+        MyModel1 => [
13
+            'book',
14
+            {class => 'Company', name => 'company'}
15
+        ]
16
+    );
17
+}
18
+
19
+1;
+17
DBIx-Custom-0.1711/t/basic/MyModel1/Company.pm
... ...
@@ -0,0 +1,17 @@
1
+package MyModel1::Company;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use base 'DBIx::Custom::Model';
7
+
8
+
9
+sub insert {
10
+    my ($self, $param) = @_;
11
+    
12
+    return $self->SUPER::insert(param => $param);
13
+}
14
+
15
+sub list { shift->select; }
16
+
17
+1;
+13
DBIx-Custom-0.1711/t/basic/MyModel1/book.pm
... ...
@@ -0,0 +1,13 @@
1
+package MyModel1::book;
2
+
3
+use DBIx::Custom::Model -base;
4
+
5
+sub insert {
6
+    my ($self, $param) = @_;
7
+    
8
+    return $self->SUPER::insert(param => $param);
9
+}
10
+
11
+sub list { shift->select; }
12
+
13
+1;
+5
DBIx-Custom-0.1711/t/basic/MyModel4.pm
... ...
@@ -0,0 +1,5 @@
1
+package MyModel4;
2
+
3
+use base 'DBIx::Custom::Model';
4
+
5
+1;
+9
DBIx-Custom-0.1711/t/basic/MyModel4/book.pm
... ...
@@ -0,0 +1,9 @@
1
+package MyModel4::book;
2
+
3
+use base 'MyModel4';
4
+
5
+sub table { 'table1' }
6
+
7
+sub list { shift->select }
8
+
9
+1;
+8
DBIx-Custom-0.1711/t/basic/MyModel4/company.pm
... ...
@@ -0,0 +1,8 @@
1
+package MyModel4::company;
2
+
3
+use base 'MyModel4';
4
+
5
+sub insert { shift->SUPER::insert(param => $_[0]) }
6
+sub list { shift->select }
7
+
8
+1;
+5
DBIx-Custom-0.1711/t/basic/MyModel5.pm
... ...
@@ -0,0 +1,5 @@
1
+package MyModel5;
2
+
3
+use base 'DBIx::Custom::Model';
4
+
5
+1;
+7
DBIx-Custom-0.1711/t/basic/MyModel5/table1.pm
... ...
@@ -0,0 +1,7 @@
1
+package MyModel5::table1;
2
+
3
+use MyModel5 -base;
4
+
5
+has primary_key => sub { ['key1', 'key2'] };
6
+
7
+1;
+12
DBIx-Custom-0.1711/t/basic/MyModel5/table1_1.pm
... ...
@@ -0,0 +1,12 @@
1
+package MyModel5::table1_1;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use base 'MyModel5';
7
+
8
+__PACKAGE__->attr(table => 'table2');
9
+
10
+__PACKAGE__->attr('primary_key' => sub { ['key1', 'key2'] });
11
+
12
+1;
+13
DBIx-Custom-0.1711/t/basic/MyModel5/table1_2.pm
... ...
@@ -0,0 +1,13 @@
1
+package MyModel5::table1_2;
2
+
3
+use strict;
4
+use warnings;
5
+
6
+use base 'MyModel5';
7
+
8
+__PACKAGE__->attr(name => 'table1_3');
9
+__PACKAGE__->attr(table => 'table3');
10
+
11
+__PACKAGE__->attr('primary_key' => sub { ['key1', 'key2'] });
12
+
13
+1;
+5
DBIx-Custom-0.1711/t/basic/MyModel6.pm
... ...
@@ -0,0 +1,5 @@
1
+package MyModel6;
2
+
3
+use base 'DBIx::Custom::Model';
4
+
5
+1;
+14
DBIx-Custom-0.1711/t/basic/MyModel6/table1.pm
... ...
@@ -0,0 +1,14 @@
1
+package MyModel6::table1;
2
+
3
+use base 'MyModel6';
4
+
5
+__PACKAGE__->attr(
6
+    join => sub {
7
+        [
8
+            'left outer join table2 on table1.key1 = table2.key1'
9
+        ]
10
+    },
11
+    primary_key => sub { ['key1'] }
12
+);
13
+
14
+1;
+5
DBIx-Custom-0.1711/t/basic/MyModel6/table2.pm
... ...
@@ -0,0 +1,5 @@
1
+package MyModel6::table2;
2
+
3
+use base 'MyModel6';
4
+
5
+1;
+11
DBIx-Custom-0.1711/t/basic/MyModel6/table3.pm
... ...
@@ -0,0 +1,11 @@
1
+package MyModel6::table3;
2
+
3
+use base 'MyModel6';
4
+
5
+__PACKAGE__->attr(filter => sub {
6
+    [
7
+        key1 => {in => sub { uc $_[0] }}
8
+    ]
9
+});
10
+
11
+1;
+5
DBIx-Custom-0.1711/t/basic/MyModel7.pm
... ...
@@ -0,0 +1,5 @@
1
+package MyModel7;
2
+
3
+use base 'DBIx::Custom::Model';
4
+
5
+1;
+14
DBIx-Custom-0.1711/t/basic/MyModel7/table1.pm
... ...
@@ -0,0 +1,14 @@
1
+package MyModel7::table1;
2
+
3
+use base 'MyModel7';
4
+
5
+__PACKAGE__->attr(
6
+    primary_key => sub { ['key1'] },
7
+    join => sub {
8
+        [
9
+            'left outer join table2 on table1.key1 = table2.key1'
10
+        ]
11
+    },
12
+);
13
+
14
+1;
+5
DBIx-Custom-0.1711/t/basic/MyModel7/table2.pm
... ...
@@ -0,0 +1,5 @@
1
+package MyModel7::table2;
2
+
3
+use base 'MyModel7';
4
+
5
+1;
+4
DBIx-Custom-0.1711/t/basic/MyModel8.pm
... ...
@@ -0,0 +1,4 @@
1
+package MyModel8;
2
+use DBIx::Custom::Model -base;
3
+
4
+1;
+7
DBIx-Custom-0.1711/t/basic/MyModel8/table1.pm
... ...
@@ -0,0 +1,7 @@
1
+package MyModel8::table1;
2
+use MyModel8 -base;
3
+
4
+has join => sub { ['left join table2 as table2_alias on table1.key1 = table2_alias.key1'] };
5
+
6
+
7
+1;
+10
DBIx-Custom-0.1711/t/basic/MyModel8/table2.pm
... ...
@@ -0,0 +1,10 @@
1
+package MyModel8::table2;
2
+use MyModel8 -base;
3
+
4
+has filter => sub {
5
+    {
6
+        key3 => {out => sub { $_[0] * 2}, in => sub { $_[0] * 3}, end => sub { $_[0] * 4 }}
7
+    }
8
+};
9
+
10
+1;
+20
DBIx-Custom-0.1711/t/common-postgresql-private.t
... ...
@@ -0,0 +1,20 @@
1
+use strict;
2
+use warnings;
3
+
4
+use FindBin;
5
+$ENV{DBIX_CUSTOM_TEST_RUN} = 1
6
+  if -f "$FindBin::Bin/run/common-postgresql-private.tmp";
7
+$ENV{DBIX_CUSTOM_SKIP_MESSAGE} = 'postgresql private test';
8
+
9
+use DBIx::Custom;
10
+{
11
+    package DBIx::Custom;
12
+    no warnings 'redefine';
13
+    sub dsn { "dbi:Pg:dbname=dbix_custom" }
14
+    sub user { 'dbix_custom' }
15
+    sub password { 'dbix_custom' }
16
+    
17
+    sub create_table1 { 'create table table1 (key1 varchar(255), key2 varchar(255));' }
18
+}
19
+
20
+require "$FindBin::Bin/common.t";
+15
DBIx-Custom-0.1711/t/common-sqlite.t
... ...
@@ -0,0 +1,15 @@
1
+use strict;
2
+use warnings;
3
+
4
+use FindBin;
5
+$ENV{DBIX_CUSTOM_TEST_RUN} = 1;
6
+
7
+use DBIx::Custom;
8
+{
9
+    package DBIx::Custom;
10
+    no warnings 'redefine';
11
+    sub dsn { 'dbi:SQLite:dbname=:memory:' }
12
+    sub create_table1 { 'create table table1 (key1, key2);' }
13
+}
14
+
15
+require "$FindBin::Bin/common.t";
+30
DBIx-Custom-0.1711/t/common.t
... ...
@@ -0,0 +1,30 @@
1
+use Test::More;
2
+use strict;
3
+use warnings;
4
+use DBIx::Custom;
5
+
6
+$SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /DEPRECATED/};
7
+
8
+my $dbi;
9
+
10
+plan skip_all => $ENV{DBIX_CUSTOM_SKIP_MESSAGE} || 'common.t is always skipped'
11
+  unless $ENV{DBIX_CUSTOM_TEST_RUN}
12
+    && eval { $dbi = DBIx::Custom->connect; 1 };
13
+
14
+plan 'no_plan';
15
+
16
+# Constant
17
+my $create_table1 = $dbi->create_table1;
18
+
19
+# Variable
20
+my $model;
21
+
22
+# Drop table
23
+eval { $dbi->execute('drop table table1') };
24
+
25
+# Create table
26
+$dbi->execute($create_table1);
27
+$model = $dbi->create_model(table => 'table1');
28
+$model->insert({key1 => 1, key2 => 2});
29
+is_deeply($model->select->all, [{key1 => 1, key2 => 2}]);
30
+
+252
DBIx-Custom-0.1711/t/mysql-private.t
... ...
@@ -0,0 +1,252 @@
1
+use Test::More;
2
+use strict;
3
+use warnings;
4
+
5
+use FindBin;
6
+
7
+plan skip_all => 'mysql private test' unless -f "$FindBin::Bin/run/mysql-private.tmp";
8
+plan 'no_plan';
9
+
10
+$SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /DEPRECATED/};
11
+
12
+# user password database
13
+our ($user, $password, $database) = qw/appuser 123456 usertest/;
14
+
15
+require DBIx::Connector;
16
+
17
+# Function for test name
18
+sub test { print "# $_[0]\n" }
19
+
20
+# Varialbes for tests
21
+my $dbi;
22
+my $dbname;
23
+my $rows;
24
+my $result;
25
+
26
+test 'connect';
27
+eval {
28
+    $dbi = DBIx::Custom->new(
29
+        dsn => "dbi:mysql:database=$database;host=localhost;port=10000",
30
+        user => $user,
31
+        password => $password
32
+    );
33
+};
34
+ok(!$@);
35
+
36
+test 'limit';
37
+$dbi = DBIx::Custom->connect(
38
+    dsn => "dbi:mysql:database=$database",
39
+    user => $user,
40
+    password => $password
41
+);
42
+$dbi->delete_all(table => 'table1');
43
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
44
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 4});
45
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 6});
46
+$dbi->query_builder->register_tag_processor(
47
+    limit => sub {
48
+        my ($count, $offset) = @_;
49
+        
50
+        my $s = '';
51
+        $offset = 0 unless defined $offset;
52
+        $s .= "limit $offset";
53
+        $s .= ", $count";
54
+        
55
+        return [$s, []];
56
+    }
57
+);
58
+$rows = $dbi->select(
59
+  table => 'table1',
60
+  where => {key1 => 1},
61
+  append => "order by key2 {limit 1 0}"
62
+)->fetch_hash_all;
63
+is_deeply($rows, [{key1 => 1, key2 => 2}]);
64
+$rows = $dbi->select(
65
+  table => 'table1',
66
+  where => {key1 => 1},
67
+  append => "order by key2 {limit 2 1}"
68
+)->fetch_hash_all;
69
+is_deeply($rows, [{key1 => 1, key2 => 4},{key1 => 1, key2 => 6}]);
70
+$rows = $dbi->select(
71
+  table => 'table1',
72
+  where => {key1 => 1},
73
+  append => "order by key2 {limit 1}"
74
+)->fetch_hash_all;
75
+is_deeply($rows, [{key1 => 1, key2 => 2}]);
76
+
77
+$dbi->dbh->disconnect;
78
+$dbi = undef;
79
+$dbi = DBIx::Custom->connect(
80
+    dsn => "dbi:mysql:database=$database",
81
+    user => $user,
82
+    password => $password
83
+);
84
+$rows = $dbi->select(
85
+  table => 'table1',
86
+  where => {key1 => 1, key2 => 4},
87
+  append => "order by key2 limit 0, 1"
88
+)->fetch_hash_all;
89
+is_deeply($rows, [{key1 => 1, key2 => 4}]);
90
+$dbi->delete_all(table => 'table1');
91
+
92
+test 'type_rule';
93
+$dbi = DBIx::Custom->connect(
94
+    dsn => "dbi:mysql:database=$database",
95
+    user => $user,
96
+    password => $password
97
+);
98
+eval{$dbi->execute("create table date_test (date DATE, datetime DATETIME)")};
99
+$dbi->each_column(
100
+    sub {
101
+        my ($self, $table, $column, $column_info) = @_;
102
+    }
103
+);
104
+
105
+$dbi->type_rule(
106
+    into1 => {
107
+        date=> sub {
108
+            my $date = shift;
109
+            $date =~ s/aaaaa//g;
110
+            return $date;
111
+        },
112
+        datetime => sub {
113
+            my $date = shift;
114
+            $date =~ s/ccccc//g;
115
+            return $date;
116
+        },
117
+    },
118
+    from1 => {
119
+        # DATE
120
+        9 => sub {
121
+                my $date = shift;
122
+                $date .= 'bbbbb';
123
+                return $date;
124
+        },
125
+        # DATETIME or TIMPESTANM
126
+        11 => sub {
127
+                my $date = shift;
128
+                $date .= 'ddddd';
129
+                return $date;
130
+        }
131
+    }
132
+);
133
+
134
+$dbi->insert(
135
+    {
136
+        date => 'aaaaa2010-aaaaa11-12aaaaa',
137
+        datetime => '2010-11ccccc-12 10:ccccc55:56'
138
+    },
139
+    table => 'date_test'
140
+);
141
+is_deeply(
142
+    $dbi->select(table => 'date_test')->fetch,
143
+    ['2010-11-12bbbbb', '2010-11-12 10:55:56ddddd']
144
+);
145
+
146
+$dbi->execute("drop table date_test");
147
+
148
+test 'dbh';
149
+{
150
+    my $connector = DBIx::Connector->new(
151
+        "dbi:mysql:database=$database",
152
+        $user,
153
+        $password,
154
+        DBIx::Custom->new->default_dbi_option
155
+    );
156
+
157
+    my $dbi = DBIx::Custom->connect(connector => $connector);
158
+    $dbi->delete_all(table => 'table1');
159
+    $dbi->do('insert into table1 (key1, key2) values (1, 2)');
160
+    is($dbi->select(table => 'table1')->fetch_hash_first->{key1}, 1);
161
+    
162
+    $dbi = DBIx::Custom->new;
163
+    $dbi->dbh('a');
164
+    is($dbi->{dbh}, 'a');
165
+}
166
+
167
+test 'transaction';
168
+test 'dbh';
169
+{
170
+    my $connector = DBIx::Connector->new(
171
+        "dbi:mysql:database=$database",
172
+        $user,
173
+        $password,
174
+        DBIx::Custom->new->default_dbi_option
175
+    );
176
+
177
+    my $dbi = DBIx::Custom->connect(connector => $connector);
178
+    $dbi->delete_all(table => 'table1');
179
+    
180
+    $dbi->connector->txn(sub {
181
+        $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
182
+        $dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
183
+    });
184
+    is_deeply($dbi->select(table => 'table1')->fetch_hash_all,
185
+              [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}]);
186
+
187
+    $dbi->delete_all(table => 'table1');
188
+    eval {
189
+        $dbi->connector->txn(sub {
190
+            $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
191
+            die "Error";
192
+            $dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
193
+        });
194
+    };
195
+    is_deeply($dbi->select(table => 'table1')->fetch_hash_all,
196
+              []);
197
+}
198
+
199
+use DBIx::Custom;
200
+use Scalar::Util 'blessed';
201
+{
202
+    my $dbi = DBIx::Custom->connect(
203
+        user => $user,
204
+        password => $password,
205
+        dsn => "dbi:mysql:dbname=$database"
206
+    );
207
+    $dbi->connect;
208
+    
209
+    ok(blessed $dbi->dbh);
210
+    can_ok($dbi->dbh, qw/prepare/);
211
+    ok($dbi->dbh->{AutoCommit});
212
+    ok(!$dbi->dbh->{mysql_enable_utf8});
213
+}
214
+
215
+{
216
+    my $dbi = DBIx::Custom->connect(
217
+        user => $user,
218
+        password => $password,
219
+        dsn => "dbi:mysql:dbname=$database",
220
+        dbi_options => {AutoCommit => 0, mysql_enable_utf8 => 1}
221
+    );
222
+    $dbi->connect;
223
+    ok(!$dbi->dbh->{AutoCommit});
224
+    #ok($dbi->dbh->{mysql_enable_utf8});
225
+}
226
+
227
+test 'fork';
228
+{
229
+    my $connector = DBIx::Connector->new(
230
+        "dbi:mysql:database=$database",
231
+        $user,
232
+        $password,
233
+        DBIx::Custom->new->default_dbi_option
234
+    );
235
+    
236
+    my $dbi = DBIx::Custom->new(connector => $connector);
237
+    $dbi->delete_all(table => 'table1');
238
+    $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
239
+    die "Can't fork" unless defined (my $pid = fork);
240
+
241
+    if ($pid) {
242
+        # Parent
243
+        my $result = $dbi->select(table => 'table1');
244
+        is_deeply($result->fetch_hash_first, {key1 => 1, key2 => 2});
245
+    }
246
+    else {
247
+        # Child
248
+        my $result = $dbi->select(table => 'table1');
249
+        die "Not OK" unless $result->fetch_hash_first->{key1} == 1;
250
+    }
251
+}
252
+
+51
DBIx-Custom-0.1711/xt/boilerplate.t
... ...
@@ -0,0 +1,51 @@
1
+#!perl -T
2
+
3
+use strict;
4
+use warnings;
5
+use Test::More tests => 3;
6
+
7
+sub not_in_file_ok {
8
+    my ($filename, %regex) = @_;
9
+    open( my $fh, '<', $filename )
10
+        or die "couldn't open $filename for reading: $!";
11
+
12
+    my %violated;
13
+
14
+    while (my $line = <$fh>) {
15
+        while (my ($desc, $regex) = each %regex) {
16
+            if ($line =~ $regex) {
17
+                push @{$violated{$desc}||=[]}, $.;
18
+            }
19
+        }
20
+    }
21
+
22
+    if (%violated) {
23
+        fail("$filename contains boilerplate text");
24
+        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
25
+    } else {
26
+        pass("$filename contains no boilerplate text");
27
+    }
28
+}
29
+
30
+sub module_boilerplate_ok {
31
+    my ($module) = @_;
32
+    not_in_file_ok($module =>
33
+        'the great new $MODULENAME'   => qr/ - The great new /,
34
+        'boilerplate description'     => qr/Quick summary of what the module/,
35
+        'stub function definition'    => qr/function[12]/,
36
+    );
37
+}
38
+
39
+
40
+  not_in_file_ok(README =>
41
+    "The README is used..."       => qr/The README is used/,
42
+    "'version information here'"  => qr/to provide version information/,
43
+  );
44
+
45
+  not_in_file_ok(Changes =>
46
+    "placeholder date/time"       => qr(Date/time)
47
+  );
48
+
49
+  module_boilerplate_ok('lib/DBIx/Custom.pm');
50
+
51
+
+11
DBIx-Custom-0.1711/xt/pod.t
... ...
@@ -0,0 +1,11 @@
1
+
2
+use strict;
3
+use warnings;
4
+use Test::More;
5
+
6
+# Ensure a recent version of Test::Pod
7
+my $min_tp = 1.22;
8
+eval "use Test::Pod $min_tp";
9
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
10
+
11
+all_pod_files_ok();
+20
t/common-mysql-private.t
... ...
@@ -0,0 +1,20 @@
1
+use strict;
2
+use warnings;
3
+
4
+use FindBin;
5
+$ENV{DBIX_CUSTOM_TEST_RUN} = 1
6
+  if -f "$FindBin::Bin/run/common-mysql-private.tmp";
7
+$ENV{DBIX_CUSTOM_SKIP_MESSAGE} = 'mysql private test';
8
+
9
+use DBIx::Custom;
10
+{
11
+    package DBIx::Custom;
12
+    no warnings 'redefine';
13
+    sub dsn { "dbi:mysql:database=dbix_custom" }
14
+    sub user { 'dbix_custom' }
15
+    sub password { 'dbix_custom' }
16
+    
17
+    sub create_table1 { 'create table table1 (key1 varchar(255), key2 varchar(255));' }
18
+}
19
+
20
+require "$FindBin::Bin/common.t";
+20
t/common-postgresql-private.t
... ...
@@ -0,0 +1,20 @@
1
+use strict;
2
+use warnings;
3
+
4
+use FindBin;
5
+$ENV{DBIX_CUSTOM_TEST_RUN} = 1
6
+  if -f "$FindBin::Bin/run/common-postgresql-private.tmp";
7
+$ENV{DBIX_CUSTOM_SKIP_MESSAGE} = 'postgresql private test';
8
+
9
+use DBIx::Custom;
10
+{
11
+    package DBIx::Custom;
12
+    no warnings 'redefine';
13
+    sub dsn { "dbi:Pg:dbname=dbix_custom" }
14
+    sub user { 'dbix_custom' }
15
+    sub password { 'dbix_custom' }
16
+    
17
+    sub create_table1 { 'create table table1 (key1 varchar(255), key2 varchar(255));' }
18
+}
19
+
20
+require "$FindBin::Bin/common.t";
+15
t/common-sqlite.t
... ...
@@ -0,0 +1,15 @@
1
+use strict;
2
+use warnings;
3
+
4
+use FindBin;
5
+$ENV{DBIX_CUSTOM_TEST_RUN} = 1;
6
+
7
+use DBIx::Custom;
8
+{
9
+    package DBIx::Custom;
10
+    no warnings 'redefine';
11
+    sub dsn { 'dbi:SQLite:dbname=:memory:' }
12
+    sub create_table1 { 'create table table1 (key1, key2);' }
13
+}
14
+
15
+require "$FindBin::Bin/common.t";
+30
t/common.t
... ...
@@ -0,0 +1,30 @@
1
+use Test::More;
2
+use strict;
3
+use warnings;
4
+use DBIx::Custom;
5
+
6
+$SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /DEPRECATED/};
7
+
8
+my $dbi;
9
+
10
+plan skip_all => $ENV{DBIX_CUSTOM_SKIP_MESSAGE} || 'common.t is always skipped'
11
+  unless $ENV{DBIX_CUSTOM_TEST_RUN}
12
+    && eval { $dbi = DBIx::Custom->connect; 1 };
13
+
14
+plan 'no_plan';
15
+
16
+# Constant
17
+my $create_table1 = $dbi->create_table1;
18
+
19
+# Variable
20
+my $model;
21
+
22
+# Drop table
23
+eval { $dbi->execute('drop table table1') };
24
+
25
+# Create table
26
+$dbi->execute($create_table1);
27
+$model = $dbi->create_model(table => 'table1');
28
+$model->insert({key1 => 1, key2 => 2});
29
+is_deeply($model->select->all, [{key1 => 1, key2 => 2}]);
30
+
+252
t/mysql-private.t
... ...
@@ -0,0 +1,252 @@
1
+use Test::More;
2
+use strict;
3
+use warnings;
4
+
5
+use FindBin;
6
+
7
+plan skip_all => 'mysql private test' unless -f "$FindBin::Bin/run/mysql-private.tmp";
8
+plan 'no_plan';
9
+
10
+$SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /DEPRECATED/};
11
+
12
+# user password database
13
+our ($user, $password, $database) = qw/appuser 123456 usertest/;
14
+
15
+require DBIx::Connector;
16
+
17
+# Function for test name
18
+sub test { print "# $_[0]\n" }
19
+
20
+# Varialbes for tests
21
+my $dbi;
22
+my $dbname;
23
+my $rows;
24
+my $result;
25
+
26
+test 'connect';
27
+eval {
28
+    $dbi = DBIx::Custom->new(
29
+        dsn => "dbi:mysql:database=$database;host=localhost;port=10000",
30
+        user => $user,
31
+        password => $password
32
+    );
33
+};
34
+ok(!$@);
35
+
36
+test 'limit';
37
+$dbi = DBIx::Custom->connect(
38
+    dsn => "dbi:mysql:database=$database",
39
+    user => $user,
40
+    password => $password
41
+);
42
+$dbi->delete_all(table => 'table1');
43
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
44
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 4});
45
+$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 6});
46
+$dbi->query_builder->register_tag_processor(
47
+    limit => sub {
48
+        my ($count, $offset) = @_;
49
+        
50
+        my $s = '';
51
+        $offset = 0 unless defined $offset;
52
+        $s .= "limit $offset";
53
+        $s .= ", $count";
54
+        
55
+        return [$s, []];
56
+    }
57
+);
58
+$rows = $dbi->select(
59
+  table => 'table1',
60
+  where => {key1 => 1},
61
+  append => "order by key2 {limit 1 0}"
62
+)->fetch_hash_all;
63
+is_deeply($rows, [{key1 => 1, key2 => 2}]);
64
+$rows = $dbi->select(
65
+  table => 'table1',
66
+  where => {key1 => 1},
67
+  append => "order by key2 {limit 2 1}"
68
+)->fetch_hash_all;
69
+is_deeply($rows, [{key1 => 1, key2 => 4},{key1 => 1, key2 => 6}]);
70
+$rows = $dbi->select(
71
+  table => 'table1',
72
+  where => {key1 => 1},
73
+  append => "order by key2 {limit 1}"
74
+)->fetch_hash_all;
75
+is_deeply($rows, [{key1 => 1, key2 => 2}]);
76
+
77
+$dbi->dbh->disconnect;
78
+$dbi = undef;
79
+$dbi = DBIx::Custom->connect(
80
+    dsn => "dbi:mysql:database=$database",
81
+    user => $user,
82
+    password => $password
83
+);
84
+$rows = $dbi->select(
85
+  table => 'table1',
86
+  where => {key1 => 1, key2 => 4},
87
+  append => "order by key2 limit 0, 1"
88
+)->fetch_hash_all;
89
+is_deeply($rows, [{key1 => 1, key2 => 4}]);
90
+$dbi->delete_all(table => 'table1');
91
+
92
+test 'type_rule';
93
+$dbi = DBIx::Custom->connect(
94
+    dsn => "dbi:mysql:database=$database",
95
+    user => $user,
96
+    password => $password
97
+);
98
+eval{$dbi->execute("create table date_test (date DATE, datetime DATETIME)")};
99
+$dbi->each_column(
100
+    sub {
101
+        my ($self, $table, $column, $column_info) = @_;
102
+    }
103
+);
104
+
105
+$dbi->type_rule(
106
+    into1 => {
107
+        date=> sub {
108
+            my $date = shift;
109
+            $date =~ s/aaaaa//g;
110
+            return $date;
111
+        },
112
+        datetime => sub {
113
+            my $date = shift;
114
+            $date =~ s/ccccc//g;
115
+            return $date;
116
+        },
117
+    },
118
+    from1 => {
119
+        # DATE
120
+        9 => sub {
121
+                my $date = shift;
122
+                $date .= 'bbbbb';
123
+                return $date;
124
+        },
125
+        # DATETIME or TIMPESTANM
126
+        11 => sub {
127
+                my $date = shift;
128
+                $date .= 'ddddd';
129
+                return $date;
130
+        }
131
+    }
132
+);
133
+
134
+$dbi->insert(
135
+    {
136
+        date => 'aaaaa2010-aaaaa11-12aaaaa',
137
+        datetime => '2010-11ccccc-12 10:ccccc55:56'
138
+    },
139
+    table => 'date_test'
140
+);
141
+is_deeply(
142
+    $dbi->select(table => 'date_test')->fetch,
143
+    ['2010-11-12bbbbb', '2010-11-12 10:55:56ddddd']
144
+);
145
+
146
+$dbi->execute("drop table date_test");
147
+
148
+test 'dbh';
149
+{
150
+    my $connector = DBIx::Connector->new(
151
+        "dbi:mysql:database=$database",
152
+        $user,
153
+        $password,
154
+        DBIx::Custom->new->default_dbi_option
155
+    );
156
+
157
+    my $dbi = DBIx::Custom->connect(connector => $connector);
158
+    $dbi->delete_all(table => 'table1');
159
+    $dbi->do('insert into table1 (key1, key2) values (1, 2)');
160
+    is($dbi->select(table => 'table1')->fetch_hash_first->{key1}, 1);
161
+    
162
+    $dbi = DBIx::Custom->new;
163
+    $dbi->dbh('a');
164
+    is($dbi->{dbh}, 'a');
165
+}
166
+
167
+test 'transaction';
168
+test 'dbh';
169
+{
170
+    my $connector = DBIx::Connector->new(
171
+        "dbi:mysql:database=$database",
172
+        $user,
173
+        $password,
174
+        DBIx::Custom->new->default_dbi_option
175
+    );
176
+
177
+    my $dbi = DBIx::Custom->connect(connector => $connector);
178
+    $dbi->delete_all(table => 'table1');
179
+    
180
+    $dbi->connector->txn(sub {
181
+        $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
182
+        $dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
183
+    });
184
+    is_deeply($dbi->select(table => 'table1')->fetch_hash_all,
185
+              [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}]);
186
+
187
+    $dbi->delete_all(table => 'table1');
188
+    eval {
189
+        $dbi->connector->txn(sub {
190
+            $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
191
+            die "Error";
192
+            $dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
193
+        });
194
+    };
195
+    is_deeply($dbi->select(table => 'table1')->fetch_hash_all,
196
+              []);
197
+}
198
+
199
+use DBIx::Custom;
200
+use Scalar::Util 'blessed';
201
+{
202
+    my $dbi = DBIx::Custom->connect(
203
+        user => $user,
204
+        password => $password,
205
+        dsn => "dbi:mysql:dbname=$database"
206
+    );
207
+    $dbi->connect;
208
+    
209
+    ok(blessed $dbi->dbh);
210
+    can_ok($dbi->dbh, qw/prepare/);
211
+    ok($dbi->dbh->{AutoCommit});
212
+    ok(!$dbi->dbh->{mysql_enable_utf8});
213
+}
214
+
215
+{
216
+    my $dbi = DBIx::Custom->connect(
217
+        user => $user,
218
+        password => $password,
219
+        dsn => "dbi:mysql:dbname=$database",
220
+        dbi_options => {AutoCommit => 0, mysql_enable_utf8 => 1}
221
+    );
222
+    $dbi->connect;
223
+    ok(!$dbi->dbh->{AutoCommit});
224
+    #ok($dbi->dbh->{mysql_enable_utf8});
225
+}
226
+
227
+test 'fork';
228
+{
229
+    my $connector = DBIx::Connector->new(
230
+        "dbi:mysql:database=$database",
231
+        $user,
232
+        $password,
233
+        DBIx::Custom->new->default_dbi_option
234
+    );
235
+    
236
+    my $dbi = DBIx::Custom->new(connector => $connector);
237
+    $dbi->delete_all(table => 'table1');
238
+    $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
239
+    die "Can't fork" unless defined (my $pid = fork);
240
+
241
+    if ($pid) {
242
+        # Parent
243
+        my $result = $dbi->select(table => 'table1');
244
+        is_deeply($result->fetch_hash_first, {key1 => 1, key2 => 2});
245
+    }
246
+    else {
247
+        # Child
248
+        my $result = $dbi->select(table => 'table1');
249
+        die "Not OK" unless $result->fetch_hash_first->{key1} == 1;
250
+    }
251
+}
252
+