Showing 94 changed files with 0 additions and 25906 deletions
-527
DBIx-Custom-0.1711/Changes
... ...
@@ -1,527 +0,0 @@
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
... ...
@@ -1,527 +0,0 @@
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
... ...
@@ -1,3203 +0,0 @@
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
... ...
@@ -1,603 +0,0 @@
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
... ...
@@ -1,13 +0,0 @@
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
... ...
@@ -1,116 +0,0 @@
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
... ...
@@ -1,329 +0,0 @@
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
... ...
@@ -1,41 +0,0 @@
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
... ...
@@ -1,11 +0,0 @@
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
... ...
@@ -1,19 +0,0 @@
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
... ...
@@ -1,13 +0,0 @@
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
... ...
@@ -1,8 +0,0 @@
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
... ...
@@ -1,5 +0,0 @@
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
... ...
@@ -1,7 +0,0 @@
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
... ...
@@ -1,12 +0,0 @@
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
... ...
@@ -1,5 +0,0 @@
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
... ...
@@ -1,14 +0,0 @@
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
... ...
@@ -1,5 +0,0 @@
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
... ...
@@ -1,14 +0,0 @@
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
... ...
@@ -1,5 +0,0 @@
1
-package MyModel7::table2;
2
-
3
-use base 'MyModel7';
4
-
5
-1;
-11
DBIx-Custom-0.1711/DBIx-Custom-0.1711/xt/pod.t
... ...
@@ -1,11 +0,0 @@
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
... ...
@@ -1,22 +0,0 @@
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
... ...
@@ -1,15 +0,0 @@
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
... ...
@@ -1,3203 +0,0 @@
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
... ...
@@ -1,603 +0,0 @@
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
... ...
@@ -1,13 +0,0 @@
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
... ...
@@ -1,247 +0,0 @@
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
... ...
@@ -1,108 +0,0 @@
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
... ...
@@ -1,116 +0,0 @@
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
... ...
@@ -1,329 +0,0 @@
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
... ...
@@ -1,573 +0,0 @@
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
... ...
@@ -1,98 +0,0 @@
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
... ...
@@ -1,41 +0,0 @@
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
... ...
@@ -1,208 +0,0 @@
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
... ...
@@ -1,1894 +0,0 @@
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
... ...
@@ -1,924 +0,0 @@
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
... ...
@@ -1,139 +0,0 @@
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
... ...
@@ -1,303 +0,0 @@
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
... ...
@@ -1,203 +0,0 @@
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
... ...
@@ -1,174 +0,0 @@
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
... ...
@@ -1,165 +0,0 @@
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
... ...
@@ -1,409 +0,0 @@
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
... ...
@@ -1,134 +0,0 @@
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
... ...
@@ -1,134 +0,0 @@
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
... ...
@@ -1,198 +0,0 @@
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
... ...
@@ -1,3203 +0,0 @@
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
... ...
@@ -1,603 +0,0 @@
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
... ...
@@ -1,13 +0,0 @@
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
... ...
@@ -1,247 +0,0 @@
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
... ...
@@ -1,108 +0,0 @@
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
... ...
@@ -1,116 +0,0 @@
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
... ...
@@ -1,329 +0,0 @@
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
... ...
@@ -1,573 +0,0 @@
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
... ...
@@ -1,98 +0,0 @@
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
... ...
@@ -1,41 +0,0 @@
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
... ...
@@ -1,208 +0,0 @@
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
... ...
@@ -1,11 +0,0 @@
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
... ...
@@ -1,3750 +0,0 @@
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
... ...
@@ -1,19 +0,0 @@
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
... ...
@@ -1,17 +0,0 @@
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
... ...
@@ -1,13 +0,0 @@
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
... ...
@@ -1,5 +0,0 @@
1
-package MyModel4;
2
-
3
-use base 'DBIx::Custom::Model';
4
-
5
-1;
-9
DBIx-Custom-0.1711/t/basic/MyModel4/book.pm
... ...
@@ -1,9 +0,0 @@
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
... ...
@@ -1,8 +0,0 @@
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
... ...
@@ -1,5 +0,0 @@
1
-package MyModel5;
2
-
3
-use base 'DBIx::Custom::Model';
4
-
5
-1;
-7
DBIx-Custom-0.1711/t/basic/MyModel5/table1.pm
... ...
@@ -1,7 +0,0 @@
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
... ...
@@ -1,12 +0,0 @@
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
... ...
@@ -1,13 +0,0 @@
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
... ...
@@ -1,5 +0,0 @@
1
-package MyModel6;
2
-
3
-use base 'DBIx::Custom::Model';
4
-
5
-1;
-14
DBIx-Custom-0.1711/t/basic/MyModel6/table1.pm
... ...
@@ -1,14 +0,0 @@
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
... ...
@@ -1,5 +0,0 @@
1
-package MyModel6::table2;
2
-
3
-use base 'MyModel6';
4
-
5
-1;
-11
DBIx-Custom-0.1711/t/basic/MyModel6/table3.pm
... ...
@@ -1,11 +0,0 @@
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
... ...
@@ -1,5 +0,0 @@
1
-package MyModel7;
2
-
3
-use base 'DBIx::Custom::Model';
4
-
5
-1;
-14
DBIx-Custom-0.1711/t/basic/MyModel7/table1.pm
... ...
@@ -1,14 +0,0 @@
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
... ...
@@ -1,5 +0,0 @@
1
-package MyModel7::table2;
2
-
3
-use base 'MyModel7';
4
-
5
-1;
-4
DBIx-Custom-0.1711/t/basic/MyModel8.pm
... ...
@@ -1,4 +0,0 @@
1
-package MyModel8;
2
-use DBIx::Custom::Model -base;
3
-
4
-1;
-7
DBIx-Custom-0.1711/t/basic/MyModel8/table1.pm
... ...
@@ -1,7 +0,0 @@
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
... ...
@@ -1,10 +0,0 @@
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
... ...
@@ -1,20 +0,0 @@
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
... ...
@@ -1,15 +0,0 @@
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
... ...
@@ -1,30 +0,0 @@
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
... ...
@@ -1,252 +0,0 @@
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
... ...
@@ -1,51 +0,0 @@
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
... ...
@@ -1,11 +0,0 @@
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();
-252
t/private-mysql.t
... ...
@@ -1,252 +0,0 @@
1
-use Test::More;
2
-use strict;
3
-use warnings;
4
-
5
-use FindBin;
6
-
7
-plan skip_all => 'private test' unless -f "$FindBin::Bin/private-mysql-run.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
-
-46
t/private-postgresql.t
... ...
@@ -1,46 +0,0 @@
1
-use Test::More;
2
-use strict;
3
-use warnings;
4
-use FindBin;
5
-use DBIx::Custom;
6
-
7
-
8
-$SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /DEPRECATED/};
9
-
10
-# Constant
11
-my $user = 'dbix_custom';
12
-my $password = 'dbix_custom';
13
-my $database = 'dbix_custom';
14
-my %connect_args_default = (
15
-        dsn => "dbi:Pg:dbname=$database",
16
-        user => $user,
17
-        password => $password
18
-);
19
-my $create_table_default = 'create table table1 (key1 varchar(255), key2 varchar(255));';
20
-
21
-plan skip_all => 'private test'
22
-  unless -f "$FindBin::Bin/private-postgresql-run.tmp"
23
-    && eval { DBIx::Custom->connect(%connect_args_default); 1 };
24
-
25
-plan 'no_plan';
26
-
27
-
28
-# Variable
29
-my $dbi;
30
-my $model;
31
-
32
-# Connect
33
-eval { $dbi = DBIx::Custom->connect(%connect_args_default); 1 };
34
-ok(!$@);
35
-
36
-# Drop table
37
-eval { $dbi->execute('drop table table1') };
38
-
39
-# Create table
40
-$dbi->execute($create_table_default);
41
-$model = $dbi->create_model(table => 'table1');
42
-$model->insert({key1 => 1, key2 => 2});
43
-is_deeply($model->select->all, [{key1 => 1, key2 => 2}]);
44
-
45
-
46
-