DBIx-Custom / lib / DBIx / Custom.pm /
Yuki Kimoto cleanup test
4067c45 13 years ago
4 contributor
3203 lines | 83.27kb
  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. $self->{_cached} ||= {};
  28. if (@_ > 1) {
  29. $self->{_cached}{$_[0]} = $_[1];
  30. }
  31. else {
  32. return $self->{_cached}{$_[0]};
  33. }
  34. }
  35. },
  36. dbi_option => sub { {} },
  37. default_dbi_option => sub {
  38. {
  39. RaiseError => 1,
  40. PrintError => 0,
  41. AutoCommit => 1
  42. }
  43. },
  44. filters => sub {
  45. {
  46. encode_utf8 => sub { encode_utf8($_[0]) },
  47. decode_utf8 => sub { decode_utf8($_[0]) }
  48. }
  49. },
  50. last_sql => '',
  51. models => sub { {} },
  52. query_builder => sub { DBIx::Custom::QueryBuilder->new(dbi => shift) },
  53. result_class => 'DBIx::Custom::Result',
  54. safety_character => '\w',
  55. stash => sub { {} },
  56. tag_parse => 1;
  57.  
  58. our $AUTOLOAD;
  59. sub AUTOLOAD {
  60. my $self = shift;
  61.  
  62. # Method name
  63. my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
  64.  
  65. # Call method
  66. $self->{_methods} ||= {};
  67. if (my $method = $self->{_methods}->{$mname}) {
  68. return $self->$method(@_)
  69. }
  70. elsif ($self->{dbh} && (my $dbh_method = $self->dbh->can($mname))) {
  71. $self->dbh->$dbh_method(@_);
  72. }
  73. else {
  74. croak qq{Can't locate object method "$mname" via "$package" }
  75. . _subname;
  76. }
  77. }
  78.  
  79. sub assign_param {
  80. my ($self, $param) = @_;
  81. # Create set tag
  82. my @params;
  83. my $safety = $self->safety_character;
  84. foreach my $column (sort keys %$param) {
  85. croak qq{"$column" is not safety column name } . _subname
  86. unless $column =~ /^[$safety\.]+$/;
  87. my $column_quote = $self->_q($column);
  88. $column_quote =~ s/\./$self->_q(".")/e;
  89. push @params, ref $param->{$column} eq 'SCALAR'
  90. ? "$column_quote = " . ${$param->{$column}}
  91. : "$column_quote = :$column";
  92.  
  93. }
  94. my $tag = join(', ', @params);
  95. return $tag;
  96. }
  97.  
  98. sub column {
  99. my $self = shift;
  100. my $option = pop if ref $_[-1] eq 'HASH';
  101. my $real_table = shift;
  102. my $columns = shift;
  103. my $table = $option->{alias} || $real_table;
  104. # Columns
  105. unless ($columns) {
  106. $columns ||= $self->model($real_table)->columns;
  107. }
  108. # Separator
  109. my $separator = $self->separator;
  110. # Column clause
  111. my @column;
  112. $columns ||= [];
  113. push @column, $self->_q($table) . "." . $self->_q($_) .
  114. " as " . $self->_q("${table}${separator}$_")
  115. for @$columns;
  116. return join (', ', @column);
  117. }
  118.  
  119. sub connect {
  120. my $self = ref $_[0] ? shift : shift->new(@_);;
  121. # Connect
  122. $self->dbh;
  123. return $self;
  124. }
  125.  
  126. sub dbh {
  127. my $self = shift;
  128. # Set
  129. if (@_) {
  130. $self->{dbh} = $_[0];
  131. return $self;
  132. }
  133. # Get
  134. else {
  135. # From Connction manager
  136. if (my $connector = $self->connector) {
  137. croak "connector must have dbh() method " . _subname
  138. unless ref $connector && $connector->can('dbh');
  139. $self->{dbh} = $connector->dbh;
  140. }
  141. # Connect
  142. $self->{dbh} ||= $self->_connect;
  143. # Quote
  144. if (!defined $self->reserved_word_quote && !defined $self->quote) {
  145. my $driver = $self->{dbh}->{Driver}->{Name};
  146. my $quote = $driver eq 'mysql' ? '`' : '"';
  147. $self->quote($quote);
  148. }
  149. return $self->{dbh};
  150. }
  151. }
  152.  
  153. sub delete {
  154. my ($self, %args) = @_;
  155.  
  156. # Arguments
  157. my $table = $args{table} || '';
  158. croak qq{"table" option must be specified. } . _subname
  159. unless $table;
  160. my $where = delete $args{where} || {};
  161. my $append = delete $args{append};
  162. my $allow_delete_all = delete $args{allow_delete_all};
  163. my $where_param = delete $args{where_param} || {};
  164. my $id = delete $args{id};
  165. my $primary_key = delete $args{primary_key};
  166. croak "update method primary_key option " .
  167. "must be specified when id is specified " . _subname
  168. if defined $id && !defined $primary_key;
  169. $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
  170. my $prefix = delete $args{prefix};
  171. # Where
  172. $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
  173. my $where_clause = '';
  174. if (ref $where eq 'ARRAY' && !ref $where->[0]) {
  175. $where_clause = "where " . $where->[0];
  176. $where_param = $where->[1];
  177. }
  178. elsif (ref $where) {
  179. $where = $self->_where_to_obj($where);
  180. $where_param = keys %$where_param
  181. ? $self->merge_param($where_param, $where->param)
  182. : $where->param;
  183. # String where
  184. $where_clause = $where->to_string;
  185. }
  186. elsif ($where) { $where_clause = "where $where" }
  187. croak qq{"where" must be specified } . _subname
  188. if $where_clause eq '' && !$allow_delete_all;
  189.  
  190. # Delete statement
  191. my @sql;
  192. push @sql, "delete";
  193. push @sql, $prefix if defined $prefix;
  194. push @sql, "from " . $self->_q($table) . " $where_clause";
  195. push @sql, $append if defined $append;
  196. my $sql = join(' ', @sql);
  197. # Execute query
  198. return $self->execute($sql, $where_param, table => $table, %args);
  199. }
  200.  
  201. sub delete_all { shift->delete(allow_delete_all => 1, @_) }
  202.  
  203. sub DESTROY { }
  204.  
  205. sub create_model {
  206. my $self = shift;
  207. # Arguments
  208. my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
  209. $args->{dbi} = $self;
  210. my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
  211. my $model_name = delete $args->{name};
  212. my $model_table = delete $args->{table};
  213. $model_name ||= $model_table;
  214. # Create model
  215. my $model = $model_class->new($args);
  216. $model->name($model_name) unless $model->name;
  217. $model->table($model_table) unless $model->table;
  218. # Apply filter(DEPRECATED logic)
  219. if ($model->{filter}) {
  220. my $filter = ref $model->filter eq 'HASH'
  221. ? [%{$model->filter}]
  222. : $model->filter;
  223. $filter ||= [];
  224. warn "DBIx::Custom::Model filter method is DEPRECATED!"
  225. if @$filter;
  226. $self->_apply_filter($model->table, @$filter);
  227. }
  228. # Set model
  229. $self->model($model->name, $model);
  230. return $self->model($model->name);
  231. }
  232.  
  233. sub each_column {
  234. my ($self, $cb) = @_;
  235. # Iterate all tables
  236. my $sth_tables = $self->dbh->table_info;
  237. while (my $table_info = $sth_tables->fetchrow_hashref) {
  238. # Table
  239. my $table = $table_info->{TABLE_NAME};
  240. # Iterate all columns
  241. my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
  242. while (my $column_info = $sth_columns->fetchrow_hashref) {
  243. my $column = $column_info->{COLUMN_NAME};
  244. $self->$cb($table, $column, $column_info);
  245. }
  246. }
  247. }
  248.  
  249. sub each_table {
  250. my ($self, $cb) = @_;
  251. # Iterate all tables
  252. my $sth_tables = $self->dbh->table_info;
  253. while (my $table_info = $sth_tables->fetchrow_hashref) {
  254. # Table
  255. my $table = $table_info->{TABLE_NAME};
  256. $self->$cb($table, $table_info);
  257. }
  258. }
  259.  
  260. our %VALID_ARGS = map { $_ => 1 } qw/append allow_delete_all
  261. allow_update_all bind_type column filter id join param prefix primary_key
  262. query relation table table_alias type type_rule_off type_rule1_off
  263. type_rule2_off wrap/;
  264.  
  265. sub execute {
  266. my $self = shift;
  267. my $query = shift;
  268. my $param;
  269. $param = shift if @_ % 2;
  270. my %args = @_;
  271. # Arguments
  272. my $p = delete $args{param} || {};
  273. $param ||= $p;
  274. my $tables = delete $args{table} || [];
  275. $tables = [$tables] unless ref $tables eq 'ARRAY';
  276. my $filter = delete $args{filter};
  277. $filter = _array_to_hash($filter);
  278. my $bind_type = delete $args{bind_type} || delete $args{type};
  279. $bind_type = _array_to_hash($bind_type);
  280. my $type_rule_off = delete $args{type_rule_off};
  281. my $type_rule_off_parts = {
  282. 1 => delete $args{type_rule1_off},
  283. 2 => delete $args{type_rule2_off}
  284. };
  285. my $query_return = delete $args{query};
  286. my $table_alias = delete $args{table_alias} || {};
  287. # Check argument names
  288. foreach my $name (keys %args) {
  289. croak qq{"$name" is wrong option } . _subname
  290. unless $VALID_ARGS{$name};
  291. }
  292. # Create query
  293. $query = $self->_create_query($query) unless ref $query;
  294. # Save query
  295. $self->last_sql($query->sql);
  296.  
  297. return $query if $query_return;
  298. # DEPRECATED! Merge query filter
  299. $filter ||= $query->{filter} || {};
  300. # Tables
  301. unshift @$tables, @{$query->{tables} || []};
  302. my $main_table = @{$tables}[-1];
  303. # DEPRECATED! Cleanup tables
  304. $tables = $self->_remove_duplicate_table($tables, $main_table)
  305. if @$tables > 1;
  306. # Type rule
  307. my $type_filters = {};
  308. unless ($type_rule_off) {
  309. foreach my $i (1, 2) {
  310. unless ($type_rule_off_parts->{$i}) {
  311. $type_filters->{$i} = {};
  312. foreach my $alias (keys %$table_alias) {
  313. my $table = $table_alias->{$alias};
  314. foreach my $column (keys %{$self->{"_into$i"}{key}{$table} || {}}) {
  315. $type_filters->{$i}->{"$alias.$column"} = $self->{"_into$i"}{key}{$table}{$column};
  316. }
  317. }
  318. $type_filters->{$i} = {%{$type_filters->{$i}}, %{$self->{"_into$i"}{key}{$main_table} || {}}}
  319. if $main_table;
  320. }
  321. }
  322. }
  323. # DEPRECATED! Applied filter
  324. if ($self->{filter}{on}) {
  325. my $applied_filter = {};
  326. foreach my $table (@$tables) {
  327. $applied_filter = {
  328. %$applied_filter,
  329. %{$self->{filter}{out}->{$table} || {}}
  330. }
  331. }
  332. $filter = {%$applied_filter, %$filter};
  333. }
  334. # Replace filter name to code
  335. foreach my $column (keys %$filter) {
  336. my $name = $filter->{$column};
  337. if (!defined $name) {
  338. $filter->{$column} = undef;
  339. }
  340. elsif (ref $name ne 'CODE') {
  341. croak qq{Filter "$name" is not registered" } . _subname
  342. unless exists $self->filters->{$name};
  343. $filter->{$column} = $self->filters->{$name};
  344. }
  345. }
  346. # Create bind values
  347. my $bind = $self->_create_bind_values(
  348. $param,
  349. $query->columns,
  350. $filter,
  351. $type_filters,
  352. $bind_type
  353. );
  354. # Execute
  355. my $sth = $query->sth;
  356. my $affected;
  357. eval {
  358. for (my $i = 0; $i < @$bind; $i++) {
  359. my $bind_type = $bind->[$i]->{bind_type};
  360. $sth->bind_param(
  361. $i + 1,
  362. $bind->[$i]->{value},
  363. $bind_type ? $bind_type : ()
  364. );
  365. }
  366. $affected = $sth->execute;
  367. };
  368. $self->_croak($@, qq{. Following SQL is executed.\n}
  369. . qq{$query->{sql}\n} . _subname) if $@;
  370. # DEBUG message
  371. if (DEBUG) {
  372. print STDERR "SQL:\n" . $query->sql . "\n";
  373. my @output;
  374. foreach my $b (@$bind) {
  375. my $value = $b->{value};
  376. $value = 'undef' unless defined $value;
  377. $value = encode(DEBUG_ENCODING(), $value)
  378. if utf8::is_utf8($value);
  379. push @output, $value;
  380. }
  381. print STDERR "Bind values: " . join(', ', @output) . "\n\n";
  382. }
  383. # Select statement
  384. if ($sth->{NUM_OF_FIELDS}) {
  385. # DEPRECATED! Filter
  386. my $filter = {};
  387. if ($self->{filter}{on}) {
  388. $filter->{in} = {};
  389. $filter->{end} = {};
  390. push @$tables, $main_table if $main_table;
  391. foreach my $table (@$tables) {
  392. foreach my $way (qw/in end/) {
  393. $filter->{$way} = {
  394. %{$filter->{$way}},
  395. %{$self->{filter}{$way}{$table} || {}}
  396. };
  397. }
  398. }
  399. }
  400. # Result
  401. my $result = $self->result_class->new(
  402. sth => $sth,
  403. dbi => $self,
  404. default_filter => $self->{default_in_filter},
  405. filter => $filter->{in} || {},
  406. end_filter => $filter->{end} || {},
  407. type_rule => {
  408. from1 => $self->type_rule->{from1},
  409. from2 => $self->type_rule->{from2}
  410. },
  411. );
  412.  
  413. return $result;
  414. }
  415. # Not select statement
  416. else { return $affected }
  417. }
  418.  
  419. sub insert {
  420. my $self = shift;
  421. # Arguments
  422. my $param;
  423. $param = shift if @_ % 2;
  424. my %args = @_;
  425. my $table = delete $args{table};
  426. croak qq{"table" option must be specified } . _subname
  427. unless defined $table;
  428. my $p = delete $args{param} || {};
  429. $param ||= $p;
  430. my $append = delete $args{append} || '';
  431. my $id = delete $args{id};
  432. my $primary_key = delete $args{primary_key};
  433. croak "insert method primary_key option " .
  434. "must be specified when id is specified " . _subname
  435. if defined $id && !defined $primary_key;
  436. $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
  437. my $prefix = delete $args{prefix};
  438.  
  439. # Merge parameter
  440. if (defined $id) {
  441. my $id_param = $self->_create_param_from_id($id, $primary_key);
  442. $param = $self->merge_param($id_param, $param);
  443. }
  444.  
  445. # Insert statement
  446. my @sql;
  447. push @sql, "insert";
  448. push @sql, $prefix if defined $prefix;
  449. push @sql, "into " . $self->_q($table) . " " . $self->insert_param($param);
  450. push @sql, $append if defined $append;
  451. my $sql = join (' ', @sql);
  452. # Execute query
  453. return $self->execute($sql, $param, table => $table, %args);
  454. }
  455.  
  456. sub insert_param {
  457. my ($self, $param) = @_;
  458. # Create insert parameter tag
  459. my $safety = $self->safety_character;
  460. my @columns;
  461. my @placeholders;
  462. foreach my $column (sort keys %$param) {
  463. croak qq{"$column" is not safety column name } . _subname
  464. unless $column =~ /^[$safety\.]+$/;
  465. my $column_quote = $self->_q($column);
  466. $column_quote =~ s/\./$self->_q(".")/e;
  467. push @columns, $column_quote;
  468. push @placeholders, ref $param->{$column} eq 'SCALAR'
  469. ? ${$param->{$column}} : ":$column";
  470. }
  471. return '(' . join(', ', @columns) . ') ' . 'values ' .
  472. '(' . join(', ', @placeholders) . ')'
  473. }
  474.  
  475. sub include_model {
  476. my ($self, $name_space, $model_infos) = @_;
  477. # Name space
  478. $name_space ||= '';
  479. # Get Model infomations
  480. unless ($model_infos) {
  481.  
  482. # Load name space module
  483. croak qq{"$name_space" is invalid class name } . _subname
  484. if $name_space =~ /[^\w:]/;
  485. eval "use $name_space";
  486. croak qq{Name space module "$name_space.pm" is needed. $@ }
  487. . _subname
  488. if $@;
  489. # Search model modules
  490. my $path = $INC{"$name_space.pm"};
  491. $path =~ s/\.pm$//;
  492. opendir my $dh, $path
  493. or croak qq{Can't open directory "$path": $! } . _subname
  494. $model_infos = [];
  495. while (my $module = readdir $dh) {
  496. push @$model_infos, $module
  497. if $module =~ s/\.pm$//;
  498. }
  499. close $dh;
  500. }
  501. # Include models
  502. foreach my $model_info (@$model_infos) {
  503. # Load model
  504. my $model_class;
  505. my $model_name;
  506. my $model_table;
  507. if (ref $model_info eq 'HASH') {
  508. $model_class = $model_info->{class};
  509. $model_name = $model_info->{name};
  510. $model_table = $model_info->{table};
  511. $model_name ||= $model_class;
  512. $model_table ||= $model_name;
  513. }
  514. else { $model_class = $model_name = $model_table = $model_info }
  515. my $mclass = "${name_space}::$model_class";
  516. croak qq{"$mclass" is invalid class name } . _subname
  517. if $mclass =~ /[^\w:]/;
  518. unless ($mclass->can('isa')) {
  519. eval "use $mclass";
  520. croak "$@ " . _subname if $@;
  521. }
  522. # Create model
  523. my $args = {};
  524. $args->{model_class} = $mclass if $mclass;
  525. $args->{name} = $model_name if $model_name;
  526. $args->{table} = $model_table if $model_table;
  527. $self->create_model($args);
  528. }
  529. return $self;
  530. }
  531.  
  532. sub map_param {
  533. my $self = shift;
  534. my $param = shift;
  535. my %map = @_;
  536. # Mapping
  537. my $map_param = {};
  538. foreach my $key (keys %map) {
  539. my $value_cb;
  540. my $condition;
  541. my $map_key;
  542. # Get mapping information
  543. if (ref $map{$key} eq 'ARRAY') {
  544. foreach my $some (@{$map{$key}}) {
  545. $map_key = $some unless ref $some;
  546. $condition = $some->{if} if ref $some eq 'HASH';
  547. $value_cb = $some if ref $some eq 'CODE';
  548. }
  549. }
  550. else {
  551. $map_key = $map{$key};
  552. }
  553. $value_cb ||= sub { $_[0] };
  554. $condition ||= sub { defined $_[0] && length $_[0] };
  555.  
  556. # Map parameter
  557. my $value;
  558. if (ref $condition eq 'CODE') {
  559. $map_param->{$map_key} = $value_cb->($param->{$key})
  560. if $condition->($param->{$key});
  561. }
  562. elsif ($condition eq 'exists') {
  563. $map_param->{$map_key} = $value_cb->($param->{$key})
  564. if exists $param->{$key};
  565. }
  566. else { croak qq/Condition must be code reference or "exists" / . _subname }
  567. }
  568. return $map_param;
  569. }
  570.  
  571. sub merge_param {
  572. my ($self, @params) = @_;
  573. # Merge parameters
  574. my $merge = {};
  575. foreach my $param (@params) {
  576. foreach my $column (keys %$param) {
  577. my $param_is_array = ref $param->{$column} eq 'ARRAY' ? 1 : 0;
  578. if (exists $merge->{$column}) {
  579. $merge->{$column} = [$merge->{$column}]
  580. unless ref $merge->{$column} eq 'ARRAY';
  581. push @{$merge->{$column}},
  582. ref $param->{$column} ? @{$param->{$column}} : $param->{$column};
  583. }
  584. else {
  585. $merge->{$column} = $param->{$column};
  586. }
  587. }
  588. }
  589. return $merge;
  590. }
  591.  
  592. sub method {
  593. my $self = shift;
  594. # Register method
  595. my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
  596. $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
  597. return $self;
  598. }
  599.  
  600. sub model {
  601. my ($self, $name, $model) = @_;
  602. # Set model
  603. if ($model) {
  604. $self->models->{$name} = $model;
  605. return $self;
  606. }
  607. # Check model existance
  608. croak qq{Model "$name" is not included } . _subname
  609. unless $self->models->{$name};
  610. # Get model
  611. return $self->models->{$name};
  612. }
  613.  
  614. sub mycolumn {
  615. my ($self, $table, $columns) = @_;
  616. # Create column clause
  617. my @column;
  618. $columns ||= [];
  619. push @column, $self->_q($table) . "." . $self->_q($_) .
  620. " as " . $self->_q($_)
  621. for @$columns;
  622. return join (', ', @column);
  623. }
  624.  
  625. sub new {
  626. my $self = shift->SUPER::new(@_);
  627. # Check attributes
  628. my @attrs = keys %$self;
  629. foreach my $attr (@attrs) {
  630. croak qq{"$attr" is wrong name } . _subname
  631. unless $self->can($attr);
  632. }
  633. # DEPRECATED!
  634. $self->query_builder->{tags} = {
  635. '?' => \&DBIx::Custom::Tag::placeholder,
  636. '=' => \&DBIx::Custom::Tag::equal,
  637. '<>' => \&DBIx::Custom::Tag::not_equal,
  638. '>' => \&DBIx::Custom::Tag::greater_than,
  639. '<' => \&DBIx::Custom::Tag::lower_than,
  640. '>=' => \&DBIx::Custom::Tag::greater_than_equal,
  641. '<=' => \&DBIx::Custom::Tag::lower_than_equal,
  642. 'like' => \&DBIx::Custom::Tag::like,
  643. 'in' => \&DBIx::Custom::Tag::in,
  644. 'insert_param' => \&DBIx::Custom::Tag::insert_param,
  645. 'update_param' => \&DBIx::Custom::Tag::update_param
  646. };
  647. return $self;
  648. }
  649.  
  650. sub not_exists { bless {}, 'DBIx::Custom::NotExists' }
  651.  
  652. sub order {
  653. my $self = shift;
  654. return DBIx::Custom::Order->new(dbi => $self, @_);
  655. }
  656.  
  657. sub register_filter {
  658. my $self = shift;
  659. # Register filter
  660. my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
  661. $self->filters({%{$self->filters}, %$filters});
  662. return $self;
  663. }
  664.  
  665. sub select {
  666. my ($self, %args) = @_;
  667.  
  668. # Arguments
  669. my $table = delete $args{table};
  670. my $tables = ref $table eq 'ARRAY' ? $table
  671. : defined $table ? [$table]
  672. : [];
  673. my $columns = delete $args{column};
  674. my $where = delete $args{where} || {};
  675. my $append = delete $args{append};
  676. my $join = delete $args{join} || [];
  677. croak qq{"join" must be array reference } . _subname
  678. unless ref $join eq 'ARRAY';
  679. my $relation = delete $args{relation};
  680. warn "select() relation option is DEPRECATED!"
  681. if $relation;
  682. my $param = delete $args{param} || {}; # DEPRECATED!
  683. warn "select() param option is DEPRECATED!"
  684. if keys %$param;
  685. my $where_param = delete $args{where_param} || $param || {};
  686. my $wrap = delete $args{wrap};
  687. my $id = delete $args{id};
  688. my $primary_key = delete $args{primary_key};
  689. croak "update method primary_key option " .
  690. "must be specified when id is specified " . _subname
  691. if defined $id && !defined $primary_key;
  692. $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
  693. my $prefix = delete $args{prefix};
  694. # Add relation tables(DEPRECATED!);
  695. $self->_add_relation_table($tables, $relation);
  696. # Select statement
  697. my @sql;
  698. push @sql, 'select';
  699. # Prefix
  700. push @sql, $prefix if defined $prefix;
  701. # Column clause
  702. if ($columns) {
  703. $columns = [$columns] unless ref $columns eq 'ARRAY';
  704. foreach my $column (@$columns) {
  705. if (ref $column eq 'HASH') {
  706. $column = $self->column(%$column) if ref $column eq 'HASH';
  707. }
  708. elsif (ref $column eq 'ARRAY') {
  709. if (@$column == 3 && $column->[1] eq 'as') {
  710. warn "[COLUMN, as => ALIAS] is DEPRECATED! use [COLUMN => ALIAS]";
  711. splice @$column, 1, 1;
  712. }
  713. $column = join(' ', $column->[0], 'as', $self->_q($column->[1]));
  714. }
  715. unshift @$tables, @{$self->_search_tables($column)};
  716. push @sql, ($column, ',');
  717. }
  718. pop @sql if $sql[-1] eq ',';
  719. }
  720. else { push @sql, '*' }
  721. # Table
  722. push @sql, 'from';
  723. if ($relation) {
  724. my $found = {};
  725. foreach my $table (@$tables) {
  726. push @sql, ($self->_q($table), ',') unless $found->{$table};
  727. $found->{$table} = 1;
  728. }
  729. }
  730. else {
  731. my $main_table = $tables->[-1] || '';
  732. push @sql, $self->_q($main_table);
  733. }
  734. pop @sql if ($sql[-1] || '') eq ',';
  735. croak "Not found table name " . _subname
  736. unless $tables->[-1];
  737.  
  738. # Add tables in parameter
  739. unshift @$tables,
  740. @{$self->_search_tables(join(' ', keys %$where_param) || '')};
  741. # Where
  742. my $where_clause = '';
  743. $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
  744. if (ref $where eq 'ARRAY' && !ref $where->[0]) {
  745. $where_clause = "where " . $where->[0];
  746. $where_param = $where->[1];
  747. }
  748. elsif (ref $where) {
  749. $where = $self->_where_to_obj($where);
  750. $where_param = keys %$where_param
  751. ? $self->merge_param($where_param, $where->param)
  752. : $where->param;
  753. # String where
  754. $where_clause = $where->to_string;
  755. }
  756. elsif ($where) { $where_clause = "where $where" }
  757. # Add table names in where clause
  758. unshift @$tables, @{$self->_search_tables($where_clause)};
  759. # Push join
  760. $self->_push_join(\@sql, $join, $tables);
  761. # Add where clause
  762. push @sql, $where_clause;
  763. # Relation(DEPRECATED!);
  764. $self->_push_relation(\@sql, $tables, $relation, $where_clause eq '' ? 1 : 0);
  765. # Append
  766. push @sql, $append if defined $append;
  767. # Wrap
  768. if ($wrap) {
  769. croak "wrap option must be array refrence " . _subname
  770. unless ref $wrap eq 'ARRAY';
  771. unshift @sql, $wrap->[0];
  772. push @sql, $wrap->[1];
  773. }
  774. # SQL
  775. my $sql = join (' ', @sql);
  776. # Execute query
  777. my $result = $self->execute($sql, $where_param, table => $tables, %args);
  778. return $result;
  779. }
  780.  
  781. sub separator {
  782. my $self = shift;
  783. if (@_) {
  784. my $separator = $_[0] || '';
  785. croak qq{Separator must be "." or "__" or "-" } . _subname
  786. unless $separator eq '.' || $separator eq '__'
  787. || $separator eq '-';
  788. $self->{separator} = $separator;
  789. return $self;
  790. }
  791. return $self->{separator} ||= '.';
  792. }
  793.  
  794. sub setup_model {
  795. my $self = shift;
  796. # Setup model
  797. $self->each_column(
  798. sub {
  799. my ($self, $table, $column, $column_info) = @_;
  800. if (my $model = $self->models->{$table}) {
  801. push @{$model->columns}, $column;
  802. }
  803. }
  804. );
  805. return $self;
  806. }
  807.  
  808. sub available_data_type {
  809. my $self = shift;
  810. my $data_types = '';
  811. foreach my $i (-1000 .. 1000) {
  812. my $type_info = $self->dbh->type_info($i);
  813. my $data_type = $type_info->{DATA_TYPE};
  814. my $type_name = $type_info->{TYPE_NAME};
  815. $data_types .= "$data_type ($type_name)\n"
  816. if defined $data_type;
  817. }
  818. return "Data Type maybe equal to Type Name" unless $data_types;
  819. $data_types = "Data Type (Type name)\n" . $data_types;
  820. return $data_types;
  821. }
  822.  
  823. sub available_type_name {
  824. my $self = shift;
  825. # Type Names
  826. my $type_names = {};
  827. $self->each_column(sub {
  828. my ($self, $table, $column, $column_info) = @_;
  829. $type_names->{$column_info->{TYPE_NAME}} = 1
  830. if $column_info->{TYPE_NAME};
  831. });
  832. my @output = sort keys %$type_names;
  833. unshift @output, "Type Name";
  834. return join "\n", @output;
  835. }
  836.  
  837. sub type_rule {
  838. my $self = shift;
  839. if (@_) {
  840. my $type_rule = ref $_[0] eq 'HASH' ? $_[0] : {@_};
  841. # Into
  842. foreach my $i (1 .. 2) {
  843. my $into = "into$i";
  844. $type_rule->{$into} = _array_to_hash($type_rule->{$into});
  845. $self->{type_rule} = $type_rule;
  846. $self->{"_$into"} = {};
  847. foreach my $type_name (keys %{$type_rule->{$into} || {}}) {
  848. croak qq{type name of $into section must be lower case}
  849. if $type_name =~ /[A-Z]/;
  850. }
  851. $self->each_column(sub {
  852. my ($dbi, $table, $column, $column_info) = @_;
  853. my $type_name = lc $column_info->{TYPE_NAME};
  854. if ($type_rule->{$into} &&
  855. (my $filter = $type_rule->{$into}->{$type_name}))
  856. {
  857. return unless exists $type_rule->{$into}->{$type_name};
  858. if (defined $filter && ref $filter ne 'CODE')
  859. {
  860. my $fname = $filter;
  861. croak qq{Filter "$fname" is not registered" } . _subname
  862. unless exists $self->filters->{$fname};
  863. $filter = $self->filters->{$fname};
  864. }
  865.  
  866. $self->{"_$into"}{key}{$table}{$column} = $filter;
  867. $self->{"_$into"}{dot}{"$table.$column"} = $filter;
  868. }
  869. });
  870. }
  871.  
  872. # From
  873. foreach my $i (1 .. 2) {
  874. $type_rule->{"from$i"} = _array_to_hash($type_rule->{"from$i"});
  875. foreach my $data_type (keys %{$type_rule->{"from$i"} || {}}) {
  876. croak qq{data type of from$i section must be lower case or number}
  877. if $data_type =~ /[A-Z]/;
  878. my $fname = $type_rule->{"from$i"}{$data_type};
  879. if (defined $fname && ref $fname ne 'CODE') {
  880. croak qq{Filter "$fname" is not registered" } . _subname
  881. unless exists $self->filters->{$fname};
  882. $type_rule->{"from$i"}{$data_type} = $self->filters->{$fname};
  883. }
  884. }
  885. }
  886. return $self;
  887. }
  888. return $self->{type_rule} || {};
  889. }
  890.  
  891. sub update {
  892. my $self = shift;
  893.  
  894. # Arguments
  895. my $param;
  896. $param = shift if @_ % 2;
  897. my %args = @_;
  898. my $table = delete $args{table} || '';
  899. croak qq{"table" option must be specified } . _subname
  900. unless $table;
  901. my $p = delete $args{param} || {};
  902. $param ||= $p;
  903. my $where = delete $args{where} || {};
  904. my $where_param = delete $args{where_param} || {};
  905. my $append = delete $args{append} || '';
  906. my $allow_update_all = delete $args{allow_update_all};
  907. my $id = delete $args{id};
  908. my $primary_key = delete $args{primary_key};
  909. croak "update method primary_key option " .
  910. "must be specified when id is specified " . _subname
  911. if defined $id && !defined $primary_key;
  912. $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
  913. my $prefix = delete $args{prefix};
  914.  
  915. # Update clause
  916. my $update_clause = $self->update_param($param);
  917.  
  918. # Where
  919. $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
  920. my $where_clause = '';
  921. if (ref $where eq 'ARRAY' && !ref $where->[0]) {
  922. $where_clause = "where " . $where->[0];
  923. $where_param = $where->[1];
  924. }
  925. elsif (ref $where) {
  926. $where = $self->_where_to_obj($where);
  927. $where_param = keys %$where_param
  928. ? $self->merge_param($where_param, $where->param)
  929. : $where->param;
  930. # String where
  931. $where_clause = $where->to_string;
  932. }
  933. elsif ($where) { $where_clause = "where $where" }
  934. croak qq{"where" must be specified } . _subname
  935. if "$where_clause" eq '' && !$allow_update_all;
  936. # Merge param
  937. $param = $self->merge_param($param, $where_param) if keys %$where_param;
  938. # Update statement
  939. my @sql;
  940. push @sql, "update";
  941. push @sql, $prefix if defined $prefix;
  942. push @sql, $self->_q($table) . " $update_clause $where_clause";
  943. push @sql, $append if defined $append;
  944. # SQL
  945. my $sql = join(' ', @sql);
  946. # Execute query
  947. return $self->execute($sql, $param, table => $table, %args);
  948. }
  949.  
  950. sub update_all { shift->update(allow_update_all => 1, @_) };
  951.  
  952. sub update_param {
  953. my ($self, $param, $opt) = @_;
  954. # Create update parameter tag
  955. my $tag = $self->assign_param($param);
  956. $tag = "set $tag" unless $opt->{no_set};
  957.  
  958. return $tag;
  959. }
  960.  
  961. sub where { DBIx::Custom::Where->new(dbi => shift, @_) }
  962.  
  963. sub _create_query {
  964. my ($self, $source) = @_;
  965. # Cache
  966. my $cache = $self->cache;
  967. # Query
  968. my $query;
  969. # Get cached query
  970. if ($cache) {
  971. # Get query
  972. my $q = $self->cache_method->($self, $source);
  973. # Create query
  974. if ($q) {
  975. $query = DBIx::Custom::Query->new($q);
  976. $query->{filters} = $self->filters;
  977. }
  978. }
  979. # Create query
  980. unless ($query) {
  981.  
  982. # Create query
  983. my $builder = $self->query_builder;
  984. $query = $builder->build_query($source);
  985.  
  986. # Remove reserved word quote
  987. if (my $q = $self->_quote) {
  988. $q = quotemeta($q);
  989. $_ =~ s/[$q]//g for @{$query->columns}
  990. }
  991.  
  992. # Save query to cache
  993. $self->cache_method->(
  994. $self, $source,
  995. {
  996. sql => $query->sql,
  997. columns => $query->columns,
  998. tables => $query->{tables} || []
  999. }
  1000. ) if $cache;
  1001. }
  1002. # Save sql
  1003. $self->last_sql($query->sql);
  1004. # Prepare statement handle
  1005. my $sth;
  1006. eval { $sth = $self->dbh->prepare($query->{sql})};
  1007. if ($@) {
  1008. $self->_croak($@, qq{. Following SQL is executed.\n}
  1009. . qq{$query->{sql}\n} . _subname);
  1010. }
  1011. # Set statement handle
  1012. $query->sth($sth);
  1013. # Set filters
  1014. $query->{filters} = $self->filters;
  1015. return $query;
  1016. }
  1017.  
  1018. sub _create_bind_values {
  1019. my ($self, $params, $columns, $filter, $type_filters, $bind_type) = @_;
  1020. # Create bind values
  1021. my $bind = [];
  1022. my $count = {};
  1023. my $not_exists = {};
  1024. foreach my $column (@$columns) {
  1025. # Value
  1026. my $value;
  1027. if(ref $params->{$column} eq 'ARRAY') {
  1028. my $i = $count->{$column} || 0;
  1029. $i += $not_exists->{$column} || 0;
  1030. my $found;
  1031. for (my $k = $i; $i < @{$params->{$column}}; $k++) {
  1032. if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
  1033. $not_exists->{$column}++;
  1034. }
  1035. else {
  1036. $value = $params->{$column}->[$k];
  1037. $found = 1;
  1038. last
  1039. }
  1040. }
  1041. next unless $found;
  1042. }
  1043. else { $value = $params->{$column} }
  1044. # Filter
  1045. my $f = $filter->{$column} || $self->{default_out_filter} || '';
  1046. $value = $f->($value) if $f;
  1047. # Type rule
  1048. foreach my $i (1 .. 2) {
  1049. my $type_filter = $type_filters->{$i};
  1050. my $tf = $self->{"_into$i"}->{dot}->{$column} || $type_filter->{$column};
  1051. $value = $tf->($value) if $tf;
  1052. }
  1053. # Bind values
  1054. push @$bind, {value => $value, bind_type => $bind_type->{$column}};
  1055. # Count up
  1056. $count->{$column}++;
  1057. }
  1058. return $bind;
  1059. }
  1060.  
  1061. sub _create_param_from_id {
  1062. my ($self, $id, $primary_keys) = @_;
  1063. # Create parameter
  1064. my $param = {};
  1065. if (defined $id) {
  1066. $id = [$id] unless ref $id;
  1067. croak qq{"id" must be constant value or array reference}
  1068. . " (" . (caller 1)[3] . ")"
  1069. unless !ref $id || ref $id eq 'ARRAY';
  1070. croak qq{"id" must contain values same count as primary key}
  1071. . " (" . (caller 1)[3] . ")"
  1072. unless @$primary_keys eq @$id;
  1073. for(my $i = 0; $i < @$primary_keys; $i ++) {
  1074. $param->{$primary_keys->[$i]} = $id->[$i];
  1075. }
  1076. }
  1077. return $param;
  1078. }
  1079.  
  1080. sub _connect {
  1081. my $self = shift;
  1082. # Attributes
  1083. my $dsn = $self->data_source;
  1084. warn "data_source is DEPRECATED!\n"
  1085. if $dsn;
  1086. $dsn ||= $self->dsn;
  1087. croak qq{"dsn" must be specified } . _subname
  1088. unless $dsn;
  1089. my $user = $self->user;
  1090. my $password = $self->password;
  1091. my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
  1092. warn "dbi_options is DEPRECATED! use dbi_option instead\n"
  1093. if keys %{$self->dbi_options};
  1094. # Connect
  1095. my $dbh = eval {DBI->connect(
  1096. $dsn,
  1097. $user,
  1098. $password,
  1099. {
  1100. %{$self->default_dbi_option},
  1101. %$dbi_option
  1102. }
  1103. )};
  1104. # Connect error
  1105. croak "$@ " . _subname if $@;
  1106. return $dbh;
  1107. }
  1108.  
  1109. sub _croak {
  1110. my ($self, $error, $append) = @_;
  1111. # Append
  1112. $append ||= "";
  1113. # Verbose
  1114. if ($Carp::Verbose) { croak $error }
  1115. # Not verbose
  1116. else {
  1117. # Remove line and module infromation
  1118. my $at_pos = rindex($error, ' at ');
  1119. $error = substr($error, 0, $at_pos);
  1120. $error =~ s/\s+$//;
  1121. croak "$error$append";
  1122. }
  1123. }
  1124.  
  1125. sub _need_tables {
  1126. my ($self, $tree, $need_tables, $tables) = @_;
  1127. # Get needed tables
  1128. foreach my $table (@$tables) {
  1129. if ($tree->{$table}) {
  1130. $need_tables->{$table} = 1;
  1131. $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
  1132. }
  1133. }
  1134. }
  1135.  
  1136. sub _push_join {
  1137. my ($self, $sql, $join, $join_tables) = @_;
  1138. # No join
  1139. return unless @$join;
  1140. # Push join clause
  1141. my $tree = {};
  1142. for (my $i = 0; $i < @$join; $i++) {
  1143. # Arrange
  1144. my $join_clause;;
  1145. my $option;
  1146. if (ref $join->[$i] eq 'HASH') {
  1147. $join_clause = $join->[$i]->{clause};
  1148. $option = {table => $join->[$i]->{table}};
  1149. }
  1150. else {
  1151. $join_clause = $join->[$i];
  1152. $option = {};
  1153. };
  1154.  
  1155. # Find tables in join clause
  1156. my $table1;
  1157. my $table2;
  1158. if (my $table = $option->{table}) {
  1159. $table1 = $table->[0];
  1160. $table2 = $table->[1];
  1161. }
  1162. else {
  1163. my $q = $self->_quote;
  1164. my $j_clause = (split /\s+on\s+/, $join_clause)[-1];
  1165. $j_clause =~ s/'.+?'//g;
  1166. my $q_re = quotemeta($q);
  1167. $j_clause =~ s/[$q_re]//g;
  1168. my $c = $self->safety_character;
  1169. my $join_re = qr/(?:^|\s)($c+)\.$c+\s+=\s+($c+)\.$c+/;
  1170. if ($j_clause =~ $join_re) {
  1171. $table1 = $1;
  1172. $table2 = $2;
  1173. }
  1174. }
  1175. croak qq{join clause must have two table name after "on" keyword. } .
  1176. qq{"$join_clause" is passed } . _subname
  1177. unless defined $table1 && defined $table2;
  1178. croak qq{right side table of "$join_clause" must be unique }
  1179. . _subname
  1180. if exists $tree->{$table2};
  1181. croak qq{Same table "$table1" is specified} . _subname
  1182. if $table1 eq $table2;
  1183. $tree->{$table2}
  1184. = {position => $i, parent => $table1, join => $join_clause};
  1185. }
  1186. # Search need tables
  1187. my $need_tables = {};
  1188. $self->_need_tables($tree, $need_tables, $join_tables);
  1189. my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
  1190. # Add join clause
  1191. foreach my $need_table (@need_tables) {
  1192. push @$sql, $tree->{$need_table}{join};
  1193. }
  1194. }
  1195.  
  1196. sub _quote {
  1197. my $self = shift;
  1198. return defined $self->reserved_word_quote ? $self->reserved_word_quote
  1199. : defined $self->quote ? $self->quote
  1200. : '';
  1201. }
  1202.  
  1203. sub _q {
  1204. my ($self, $value) = @_;
  1205. my $quote = $self->_quote;
  1206. my $q = substr($quote, 0, 1) || '';
  1207. my $p;
  1208. if (defined $quote && length $quote > 1) {
  1209. $p = substr($quote, 1, 1);
  1210. }
  1211. else { $p = $q }
  1212. return "$q$value$p";
  1213. }
  1214.  
  1215. sub _remove_duplicate_table {
  1216. my ($self, $tables, $main_table) = @_;
  1217. # Remove duplicate table
  1218. my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
  1219. delete $tables{$main_table} if $main_table;
  1220. my $new_tables = [keys %tables, $main_table ? $main_table : ()];
  1221. if (my $q = $self->_quote) {
  1222. $q = quotemeta($q);
  1223. $_ =~ s/[$q]//g for @$new_tables;
  1224. }
  1225.  
  1226. return $new_tables;
  1227. }
  1228.  
  1229. sub _search_tables {
  1230. my ($self, $source) = @_;
  1231. # Search tables
  1232. my $tables = [];
  1233. my $safety_character = $self->safety_character;
  1234. my $q = $self->_quote;
  1235. my $q_re = quotemeta($q);
  1236. my $quoted_safety_character_re = $self->_q("?([$safety_character]+)");
  1237. my $table_re = $q ? qr/(?:^|[^$safety_character])$quoted_safety_character_re?\./
  1238. : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
  1239. while ($source =~ /$table_re/g) {
  1240. push @$tables, $1;
  1241. }
  1242. return $tables;
  1243. }
  1244.  
  1245. sub _where_to_obj {
  1246. my ($self, $where) = @_;
  1247. my $obj;
  1248. # Hash
  1249. if (ref $where eq 'HASH') {
  1250. my $clause = ['and'];
  1251. my $q = $self->_quote;
  1252. foreach my $column (keys %$where) {
  1253. my $column_quote = $self->_q($column);
  1254. $column_quote =~ s/\./$self->_q(".")/e;
  1255. push @$clause, "$column_quote = :$column" for keys %$where;
  1256. }
  1257. $obj = $self->where(clause => $clause, param => $where);
  1258. }
  1259. # DBIx::Custom::Where object
  1260. elsif (ref $where eq 'DBIx::Custom::Where') {
  1261. $obj = $where;
  1262. }
  1263. # Array
  1264. elsif (ref $where eq 'ARRAY') {
  1265. $obj = $self->where(
  1266. clause => $where->[0],
  1267. param => $where->[1]
  1268. );
  1269. }
  1270. # Check where argument
  1271. croak qq{"where" must be hash reference or DBIx::Custom::Where object}
  1272. . qq{or array reference, which contains where clause and parameter}
  1273. . _subname
  1274. unless ref $obj eq 'DBIx::Custom::Where';
  1275. return $obj;
  1276. }
  1277.  
  1278. sub _apply_filter {
  1279. my ($self, $table, @cinfos) = @_;
  1280.  
  1281. # Initialize filters
  1282. $self->{filter} ||= {};
  1283. $self->{filter}{on} = 1;
  1284. $self->{filter}{out} ||= {};
  1285. $self->{filter}{in} ||= {};
  1286. $self->{filter}{end} ||= {};
  1287. # Usage
  1288. my $usage = "Usage: \$dbi->apply_filter(" .
  1289. "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1, end => ENDFILTER1}, " .
  1290. "COLUMN2, {in => INFILTER2, out => OUTFILTER2, end => ENDFILTER2}, ...)";
  1291. # Apply filter
  1292. for (my $i = 0; $i < @cinfos; $i += 2) {
  1293. # Column
  1294. my $column = $cinfos[$i];
  1295. if (ref $column eq 'ARRAY') {
  1296. foreach my $c (@$column) {
  1297. push @cinfos, $c, $cinfos[$i + 1];
  1298. }
  1299. next;
  1300. }
  1301. # Filter infomation
  1302. my $finfo = $cinfos[$i + 1] || {};
  1303. croak "$usage (table: $table) " . _subname
  1304. unless ref $finfo eq 'HASH';
  1305. foreach my $ftype (keys %$finfo) {
  1306. croak "$usage (table: $table) " . _subname
  1307. unless $ftype eq 'in' || $ftype eq 'out' || $ftype eq 'end';
  1308. }
  1309. # Set filters
  1310. foreach my $way (qw/in out end/) {
  1311. # Filter
  1312. my $filter = $finfo->{$way};
  1313. # Filter state
  1314. my $state = !exists $finfo->{$way} ? 'not_exists'
  1315. : !defined $filter ? 'not_defined'
  1316. : ref $filter eq 'CODE' ? 'code'
  1317. : 'name';
  1318. # Filter is not exists
  1319. next if $state eq 'not_exists';
  1320. # Check filter name
  1321. croak qq{Filter "$filter" is not registered } . _subname
  1322. if $state eq 'name'
  1323. && ! exists $self->filters->{$filter};
  1324. # Set filter
  1325. my $f = $state eq 'not_defined' ? undef
  1326. : $state eq 'code' ? $filter
  1327. : $self->filters->{$filter};
  1328. $self->{filter}{$way}{$table}{$column} = $f;
  1329. $self->{filter}{$way}{$table}{"$table.$column"} = $f;
  1330. $self->{filter}{$way}{$table}{"${table}__$column"} = $f;
  1331. $self->{filter}{$way}{$table}{"${table}-$column"} = $f;
  1332. }
  1333. }
  1334. return $self;
  1335. }
  1336.  
  1337. # DEPRECATED!
  1338. sub create_query {
  1339. warn "create_query is DEPRECATED! use query option of each method";
  1340. shift->_create_query(@_);
  1341. }
  1342.  
  1343. # DEPRECATED!
  1344. sub apply_filter {
  1345. my $self = shift;
  1346. warn "apply_filter is DEPRECATED!";
  1347. return $self->_apply_filter(@_);
  1348. }
  1349.  
  1350. # DEPRECATED!
  1351. our %SELECT_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
  1352. sub select_at {
  1353. my ($self, %args) = @_;
  1354.  
  1355. warn "select_at is DEPRECATED! use update and id option instead";
  1356.  
  1357. # Arguments
  1358. my $primary_keys = delete $args{primary_key};
  1359. $primary_keys = [$primary_keys] unless ref $primary_keys;
  1360. my $where = delete $args{where};
  1361. my $param = delete $args{param};
  1362. # Check arguments
  1363. foreach my $name (keys %args) {
  1364. croak qq{"$name" is wrong option } . _subname
  1365. unless $SELECT_AT_ARGS{$name};
  1366. }
  1367. # Table
  1368. croak qq{"table" option must be specified } . _subname
  1369. unless $args{table};
  1370. my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
  1371. # Create where parameter
  1372. my $where_param = $self->_create_param_from_id($where, $primary_keys);
  1373. return $self->select(where => $where_param, %args);
  1374. }
  1375.  
  1376. # DEPRECATED!
  1377. our %DELETE_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
  1378. sub delete_at {
  1379. my ($self, %args) = @_;
  1380.  
  1381. warn "delete_at is DEPRECATED! use update and id option instead";
  1382. # Arguments
  1383. my $primary_keys = delete $args{primary_key};
  1384. $primary_keys = [$primary_keys] unless ref $primary_keys;
  1385. my $where = delete $args{where};
  1386. # Check arguments
  1387. foreach my $name (keys %args) {
  1388. croak qq{"$name" is wrong option } . _subname
  1389. unless $DELETE_AT_ARGS{$name};
  1390. }
  1391. # Create where parameter
  1392. my $where_param = $self->_create_param_from_id($where, $primary_keys);
  1393. return $self->delete(where => $where_param, %args);
  1394. }
  1395.  
  1396. # DEPRECATED!
  1397. our %UPDATE_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
  1398. sub update_at {
  1399. my $self = shift;
  1400.  
  1401. warn "update_at is DEPRECATED! use update and id option instead";
  1402. # Arguments
  1403. my $param;
  1404. $param = shift if @_ % 2;
  1405. my %args = @_;
  1406. my $primary_keys = delete $args{primary_key};
  1407. $primary_keys = [$primary_keys] unless ref $primary_keys;
  1408. my $where = delete $args{where};
  1409. my $p = delete $args{param} || {};
  1410. $param ||= $p;
  1411. # Check arguments
  1412. foreach my $name (keys %args) {
  1413. croak qq{"$name" is wrong option } . _subname
  1414. unless $UPDATE_AT_ARGS{$name};
  1415. }
  1416. # Create where parameter
  1417. my $where_param = $self->_create_param_from_id($where, $primary_keys);
  1418. return $self->update(where => $where_param, param => $param, %args);
  1419. }
  1420.  
  1421. # DEPRECATED!
  1422. our %INSERT_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
  1423. sub insert_at {
  1424. my $self = shift;
  1425. warn "insert_at is DEPRECATED! use insert and id option instead";
  1426. # Arguments
  1427. my $param;
  1428. $param = shift if @_ % 2;
  1429. my %args = @_;
  1430. my $primary_key = delete $args{primary_key};
  1431. $primary_key = [$primary_key] unless ref $primary_key;
  1432. my $where = delete $args{where};
  1433. my $p = delete $args{param} || {};
  1434. $param ||= $p;
  1435. # Check arguments
  1436. foreach my $name (keys %args) {
  1437. croak qq{"$name" is wrong option } . _subname
  1438. unless $INSERT_AT_ARGS{$name};
  1439. }
  1440. # Create where parameter
  1441. my $where_param = $self->_create_param_from_id($where, $primary_key);
  1442. $param = $self->merge_param($where_param, $param);
  1443. return $self->insert(param => $param, %args);
  1444. }
  1445.  
  1446. # DEPRECATED!
  1447. sub register_tag {
  1448. warn "register_tag is DEPRECATED!";
  1449. shift->query_builder->register_tag(@_)
  1450. }
  1451.  
  1452. # DEPRECATED!
  1453. has 'data_source';
  1454. has dbi_options => sub { {} };
  1455. has filter_check => 1;
  1456. has 'reserved_word_quote';
  1457.  
  1458. # DEPRECATED!
  1459. sub default_bind_filter {
  1460. my $self = shift;
  1461. warn "default_bind_filter is DEPRECATED!";
  1462. if (@_) {
  1463. my $fname = $_[0];
  1464. if (@_ && !$fname) {
  1465. $self->{default_out_filter} = undef;
  1466. }
  1467. else {
  1468. croak qq{Filter "$fname" is not registered}
  1469. unless exists $self->filters->{$fname};
  1470. $self->{default_out_filter} = $self->filters->{$fname};
  1471. }
  1472. return $self;
  1473. }
  1474. return $self->{default_out_filter};
  1475. }
  1476.  
  1477. # DEPRECATED!
  1478. sub default_fetch_filter {
  1479. my $self = shift;
  1480.  
  1481. warn "default_fetch_filter is DEPRECATED!";
  1482. if (@_) {
  1483. my $fname = $_[0];
  1484.  
  1485. if (@_ && !$fname) {
  1486. $self->{default_in_filter} = undef;
  1487. }
  1488. else {
  1489. croak qq{Filter "$fname" is not registered}
  1490. unless exists $self->filters->{$fname};
  1491. $self->{default_in_filter} = $self->filters->{$fname};
  1492. }
  1493. return $self;
  1494. }
  1495. return $self->{default_in_filter};
  1496. }
  1497.  
  1498. # DEPRECATED!
  1499. sub insert_param_tag {
  1500. warn "insert_param_tag is DEPRECATED! " .
  1501. "use insert_param instead!";
  1502. return shift->insert_param(@_);
  1503. }
  1504.  
  1505. # DEPRECATED!
  1506. sub register_tag_processor {
  1507. warn "register_tag_processor is DEPRECATED!";
  1508. return shift->query_builder->register_tag_processor(@_);
  1509. }
  1510.  
  1511. # DEPRECATED!
  1512. sub update_param_tag {
  1513. warn "update_param_tag is DEPRECATED! " .
  1514. "use update_param instead";
  1515. return shift->update_param(@_);
  1516. }
  1517. # DEPRECATED!
  1518. sub _push_relation {
  1519. my ($self, $sql, $tables, $relation, $need_where) = @_;
  1520. if (keys %{$relation || {}}) {
  1521. push @$sql, $need_where ? 'where' : 'and';
  1522. foreach my $rcolumn (keys %$relation) {
  1523. my $table1 = (split (/\./, $rcolumn))[0];
  1524. my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
  1525. push @$tables, ($table1, $table2);
  1526. push @$sql, ("$rcolumn = " . $relation->{$rcolumn}, 'and');
  1527. }
  1528. }
  1529. pop @$sql if $sql->[-1] eq 'and';
  1530. }
  1531.  
  1532. # DEPRECATED!
  1533. sub _add_relation_table {
  1534. my ($self, $tables, $relation) = @_;
  1535. if (keys %{$relation || {}}) {
  1536. foreach my $rcolumn (keys %$relation) {
  1537. my $table1 = (split (/\./, $rcolumn))[0];
  1538. my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
  1539. my $table1_exists;
  1540. my $table2_exists;
  1541. foreach my $table (@$tables) {
  1542. $table1_exists = 1 if $table eq $table1;
  1543. $table2_exists = 1 if $table eq $table2;
  1544. }
  1545. unshift @$tables, $table1 unless $table1_exists;
  1546. unshift @$tables, $table2 unless $table2_exists;
  1547. }
  1548. }
  1549. }
  1550.  
  1551. 1;
  1552.  
  1553. =head1 NAME
  1554.  
  1555. DBIx::Custom - Execute insert, update, delete, and select statement easily
  1556.  
  1557. =head1 SYNOPSYS
  1558.  
  1559. use DBIx::Custom;
  1560. # Connect
  1561. my $dbi = DBIx::Custom->connect(
  1562. dsn => "dbi:mysql:database=dbname",
  1563. user => 'ken',
  1564. password => '!LFKD%$&',
  1565. dbi_option => {mysql_enable_utf8 => 1}
  1566. );
  1567.  
  1568. # Insert
  1569. $dbi->insert({title => 'Perl', author => 'Ken'}, table => 'book');
  1570. # Update
  1571. $dbi->update({title => 'Perl', author => 'Ken'}, table => 'book',
  1572. where => {id => 5});
  1573. # Delete
  1574. $dbi->delete(table => 'book', where => {author => 'Ken'});
  1575.  
  1576. # Select
  1577. my $result = $dbi->select(table => 'book',
  1578. column => ['title', 'author'], where => {author => 'Ken'});
  1579.  
  1580. # Select, more complex
  1581. my $result = $dbi->select(
  1582. table => 'book',
  1583. column => [
  1584. {book => [qw/title author/]},
  1585. {company => ['name']}
  1586. ],
  1587. where => {'book.author' => 'Ken'},
  1588. join => ['left outer join company on book.company_id = company.id'],
  1589. append => 'order by id limit 5'
  1590. );
  1591. # Fetch
  1592. while (my $row = $result->fetch) {
  1593. }
  1594. # Fetch as hash
  1595. while (my $row = $result->fetch_hash) {
  1596. }
  1597. # Execute SQL with parameter.
  1598. $dbi->execute(
  1599. "select id from book where author = :author and title like :title",
  1600. {author => 'ken', title => '%Perl%'}
  1601. );
  1602. =head1 DESCRIPTIONS
  1603.  
  1604. L<DBIx::Custom> is L<DBI> wrapper module to execute SQL easily.
  1605. This module have the following features.
  1606.  
  1607. =over 4
  1608.  
  1609. =item *
  1610.  
  1611. Execute C<insert>, C<update>, C<delete>, or C<select> statement easily
  1612.  
  1613. =item *
  1614.  
  1615. Create C<where> clause flexibly
  1616.  
  1617. =item *
  1618.  
  1619. Named place holder support
  1620.  
  1621. =item *
  1622.  
  1623. Model support
  1624.  
  1625. =item *
  1626.  
  1627. Connection manager support
  1628.  
  1629. =item *
  1630.  
  1631. Choice your favorite relational database management system,
  1632. C<MySQL>, C<SQLite>, C<PostgreSQL>, C<Oracle>,
  1633. C<Microsoft SQL Server>, C<Microsoft Access>, C<DB2> or anything,
  1634.  
  1635. =item *
  1636.  
  1637. Filtering by data type or column name(EXPERIMENTAL)
  1638.  
  1639. =item *
  1640.  
  1641. Create C<order by> clause flexibly(EXPERIMENTAL)
  1642.  
  1643. =back
  1644.  
  1645. =head1 DOCUMENTATIONS
  1646.  
  1647. L<DBIx::Custom::Guide> - How to use L<DBIx::Custom>
  1648.  
  1649. L<DBIx::Custom Wiki|https://github.com/yuki-kimoto/DBIx-Custom/wiki>
  1650. - Theare are various examples.
  1651.  
  1652. Module documentations -
  1653. L<DBIx::Custom::Result>,
  1654. L<DBIx::Custom::Query>,
  1655. L<DBIx::Custom::Where>,
  1656. L<DBIx::Custom::Model>,
  1657. L<DBIx::Custom::Order>
  1658.  
  1659. =head1 ATTRIBUTES
  1660.  
  1661. =head2 C<connector>
  1662.  
  1663. my $connector = $dbi->connector;
  1664. $dbi = $dbi->connector($connector);
  1665.  
  1666. Connection manager object. if C<connector> is set, you can get C<dbh>
  1667. through connection manager. Conection manager object must have C<dbh> mehtod.
  1668.  
  1669. This is L<DBIx::Connector> example. Please pass
  1670. C<default_dbi_option> to L<DBIx::Connector> C<new> method.
  1671.  
  1672. my $connector = DBIx::Connector->new(
  1673. "dbi:mysql:database=$DATABASE",
  1674. $USER,
  1675. $PASSWORD,
  1676. DBIx::Custom->new->default_dbi_option
  1677. );
  1678. my $dbi = DBIx::Custom->connect(connector => $connector);
  1679.  
  1680. =head2 C<dsn>
  1681.  
  1682. my $dsn = $dbi->dsn;
  1683. $dbi = $dbi->dsn("DBI:mysql:database=dbname");
  1684.  
  1685. Data source name, used when C<connect> method is executed.
  1686.  
  1687. =head2 C<dbi_option>
  1688.  
  1689. my $dbi_option = $dbi->dbi_option;
  1690. $dbi = $dbi->dbi_option($dbi_option);
  1691.  
  1692. L<DBI> option, used when C<connect> method is executed.
  1693. Each value in option override the value of C<default_dbi_option>.
  1694.  
  1695. =head2 C<default_dbi_option>
  1696.  
  1697. my $default_dbi_option = $dbi->default_dbi_option;
  1698. $dbi = $dbi->default_dbi_option($default_dbi_option);
  1699.  
  1700. L<DBI> default option, used when C<connect> method is executed,
  1701. default to the following values.
  1702.  
  1703. {
  1704. RaiseError => 1,
  1705. PrintError => 0,
  1706. AutoCommit => 1,
  1707. }
  1708.  
  1709. =head2 C<filters>
  1710.  
  1711. my $filters = $dbi->filters;
  1712. $dbi = $dbi->filters(\%filters);
  1713.  
  1714. Filters, registered by C<register_filter> method.
  1715.  
  1716. =head2 C<last_sql>
  1717.  
  1718. my $last_sql = $dbi->last_sql;
  1719. $dbi = $dbi->last_sql($last_sql);
  1720.  
  1721. Get last successed SQL executed by C<execute> method.
  1722.  
  1723. =head2 C<models>
  1724.  
  1725. my $models = $dbi->models;
  1726. $dbi = $dbi->models(\%models);
  1727.  
  1728. Models, included by C<include_model> method.
  1729.  
  1730. =head2 C<password>
  1731.  
  1732. my $password = $dbi->password;
  1733. $dbi = $dbi->password('lkj&le`@s');
  1734.  
  1735. Password, used when C<connect> method is executed.
  1736.  
  1737. =head2 C<query_builder>
  1738.  
  1739. my $sql_class = $dbi->query_builder;
  1740. $dbi = $dbi->query_builder(DBIx::Custom::QueryBuilder->new);
  1741.  
  1742. Query builder, default to L<DBIx::Custom::QueryBuilder> object.
  1743.  
  1744. =head2 C<quote>
  1745.  
  1746. my quote = $dbi->quote;
  1747. $dbi = $dbi->quote('"');
  1748.  
  1749. Reserved word quote.
  1750. Default to double quote '"' except for mysql.
  1751. In mysql, default to back quote '`'
  1752.  
  1753. You can set quote pair.
  1754.  
  1755. $dbi->quote('[]');
  1756.  
  1757. =head2 C<result_class>
  1758.  
  1759. my $result_class = $dbi->result_class;
  1760. $dbi = $dbi->result_class('DBIx::Custom::Result');
  1761.  
  1762. Result class, default to L<DBIx::Custom::Result>.
  1763.  
  1764. =head2 C<safety_character>
  1765.  
  1766. my $safety_character = $self->safety_character;
  1767. $dbi = $self->safety_character($character);
  1768.  
  1769. Regex of safety character for table and column name, default to '\w'.
  1770. Note that you don't have to specify like '[\w]'.
  1771.  
  1772. =head2 C<tag_parse>
  1773.  
  1774. my $tag_parse = $dbi->tag_parse(0);
  1775. $dbi = $dbi->tag_parse;
  1776.  
  1777. Enable DEPRECATED tag parsing functionality, default to 1.
  1778. If you want to disable tag parsing functionality, set to 0.
  1779.  
  1780. =head2 C<user>
  1781.  
  1782. my $user = $dbi->user;
  1783. $dbi = $dbi->user('Ken');
  1784.  
  1785. User name, used when C<connect> method is executed.
  1786.  
  1787. =head1 METHODS
  1788.  
  1789. L<DBIx::Custom> inherits all methods from L<Object::Simple>
  1790. and use all methods of L<DBI>
  1791. and implements the following new ones.
  1792.  
  1793. =head2 C<available_data_type> EXPERIMENTAL
  1794.  
  1795. print $dbi->available_data_type;
  1796.  
  1797. Get available data types. You can use these data types
  1798. in C<type rule>'s C<from1> and C<from2> section.
  1799.  
  1800. =head2 C<available_type_name> EXPERIMENTAL
  1801.  
  1802. print $dbi->available_type_name;
  1803.  
  1804. Get available type names. You can use these type names in
  1805. C<type_rule>'s C<into1> and C<into2> section.
  1806.  
  1807. =head2 C<assign_param> EXPERIMENTAL
  1808.  
  1809. my $assign_param = $dbi->assign_param({title => 'a', age => 2});
  1810.  
  1811. Create assign parameter.
  1812.  
  1813. title = :title, author = :author
  1814.  
  1815. This is equal to C<update_param> exept that set is not added.
  1816.  
  1817. =head2 C<column>
  1818.  
  1819. my $column = $dbi->column(book => ['author', 'title']);
  1820.  
  1821. Create column clause. The follwoing column clause is created.
  1822.  
  1823. book.author as "book.author",
  1824. book.title as "book.title"
  1825.  
  1826. You can change separator by C<separator> method.
  1827.  
  1828. # Separator is double underbar
  1829. $dbi->separator('__');
  1830. book.author as "book__author",
  1831. book.title as "book__title"
  1832.  
  1833. # Separator is hyphen
  1834. $dbi->separator('-');
  1835. book.author as "book-author",
  1836. book.title as "book-title"
  1837. =head2 C<connect>
  1838.  
  1839. my $dbi = DBIx::Custom->connect(
  1840. dsn => "dbi:mysql:database=dbname",
  1841. user => 'ken',
  1842. password => '!LFKD%$&',
  1843. dbi_option => {mysql_enable_utf8 => 1}
  1844. );
  1845.  
  1846. Connect to the database and create a new L<DBIx::Custom> object.
  1847.  
  1848. L<DBIx::Custom> is a wrapper of L<DBI>.
  1849. C<AutoCommit> and C<RaiseError> options are true,
  1850. and C<PrintError> option is false by default.
  1851.  
  1852. =head2 create_model
  1853.  
  1854. my $model = $dbi->create_model(
  1855. table => 'book',
  1856. primary_key => 'id',
  1857. join => [
  1858. 'inner join company on book.comparny_id = company.id'
  1859. ],
  1860. );
  1861.  
  1862. Create L<DBIx::Custom::Model> object and initialize model.
  1863. the module is also used from C<model> method.
  1864.  
  1865. $dbi->model('book')->select(...);
  1866.  
  1867. =head2 C<dbh>
  1868.  
  1869. my $dbh = $dbi->dbh;
  1870.  
  1871. Get L<DBI> database handle. if C<connector> is set, you can get
  1872. database handle through C<connector> object.
  1873.  
  1874. =head2 C<each_column>
  1875.  
  1876. $dbi->each_column(
  1877. sub {
  1878. my ($dbi, $table, $column, $column_info) = @_;
  1879. my $type = $column_info->{TYPE_NAME};
  1880. if ($type eq 'DATE') {
  1881. # ...
  1882. }
  1883. }
  1884. );
  1885.  
  1886. Iterate all column informations of all table from database.
  1887. Argument is callback when one column is found.
  1888. Callback receive four arguments, dbi object, table name,
  1889. column name and column information.
  1890.  
  1891. =head2 C<each_table>
  1892.  
  1893. $dbi->each_table(
  1894. sub {
  1895. my ($dbi, $table, $table_info) = @_;
  1896. my $table_name = $table_info->{TABLE_NAME};
  1897. }
  1898. );
  1899.  
  1900. Iterate all table informationsfrom database.
  1901. Argument is callback when one table is found.
  1902. Callback receive three arguments, dbi object, table name,
  1903. table information.
  1904.  
  1905. =head2 C<execute>
  1906.  
  1907. my $result = $dbi->execute(
  1908. "select * from book where title = :title and author like :author",
  1909. {title => 'Perl', author => '%Ken%'}
  1910. );
  1911.  
  1912. my $result = $dbi->execute(
  1913. "select * from book where title = :book.title and author like :book.author",
  1914. {'book.title' => 'Perl', 'book.author' => '%Ken%'}
  1915. );
  1916.  
  1917. Execute SQL. SQL can contain column parameter such as :author and :title.
  1918. You can append table name to column name such as :book.title and :book.author.
  1919. Second argunet is data, embedded into column parameter.
  1920. Return value is L<DBIx::Custom::Result> object when select statement is executed,
  1921. or the count of affected rows when insert, update, delete statement is executed.
  1922.  
  1923. Named placeholder such as C<:title> is replaced by placeholder C<?>.
  1924. # Original
  1925. select * from book where title = :title and author like :author
  1926. # Replaced
  1927. select * from where title = ? and author like ?;
  1928.  
  1929. You can specify operator with named placeholder
  1930. by C<name{operator}> syntax.
  1931.  
  1932. # Original
  1933. select * from book where :title{=} and :author{like}
  1934. # Replaced
  1935. select * from where title = ? and author like ?;
  1936.  
  1937. Note that colons in time format such as 12:13:15 is exeption,
  1938. it is not parsed as named placeholder.
  1939. If you want to use colon generally, you must escape it by C<\\>
  1940.  
  1941. select * from where title = "aa\\:bb";
  1942.  
  1943. The following opitons are available.
  1944.  
  1945. =over 4
  1946.  
  1947. =item C<filter>
  1948. filter => {
  1949. title => sub { uc $_[0] }
  1950. author => sub { uc $_[0] }
  1951. }
  1952.  
  1953. # Filter name
  1954. filter => {
  1955. title => 'upper_case',
  1956. author => 'upper_case'
  1957. }
  1958. # At once
  1959. filter => [
  1960. [qw/title author/] => sub { uc $_[0] }
  1961. ]
  1962.  
  1963. Filter. You can set subroutine or filter name
  1964. registered by by C<register_filter>.
  1965. This filter is executed before data is saved into database.
  1966. and before type rule filter is executed.
  1967.  
  1968. =item C<query>
  1969.  
  1970. query => 1
  1971.  
  1972. C<execute> method return L<DBIx::Custom::Query> object, not executing SQL.
  1973. You can check SQL or get statment handle.
  1974.  
  1975. my $sql = $query->sql;
  1976. my $sth = $query->sth;
  1977. my $columns = $query->columns;
  1978. If you want to execute SQL fast, you can do the following way.
  1979.  
  1980. my $query;
  1981. foreach my $row (@$rows) {
  1982. $query ||= $dbi->insert($row, table => 'table1', query => 1);
  1983. $dbi->execute($query, $row, filter => {ab => sub { $_[0] * 2 }});
  1984. }
  1985.  
  1986. Statement handle is reused and SQL parsing is finished,
  1987. so you can get more performance than normal way.
  1988.  
  1989. If you want to execute SQL as possible as fast and don't need filtering.
  1990. You can do the following way.
  1991. my $query;
  1992. my $sth;
  1993. foreach my $row (@$rows) {
  1994. $query ||= $dbi->insert($row, table => 'book', query => 1);
  1995. $sth ||= $query->sth;
  1996. $sth->execute(map { $row->{$_} } sort keys %$row);
  1997. }
  1998.  
  1999. Note that $row must be simple hash reference, such as
  2000. {title => 'Perl', author => 'Ken'}.
  2001. and don't forget to sort $row values by $row key asc order.
  2002.  
  2003. =item C<table>
  2004. table => 'author'
  2005.  
  2006. If you want to omit table name in column name
  2007. and enable C<into1> and C<into2> type filter,
  2008. You must set C<table> option.
  2009.  
  2010. $dbi->execute("select * from book where title = :title and author = :author",
  2011. {title => 'Perl', author => 'Ken', table => 'book');
  2012.  
  2013. # Same
  2014. $dbi->execute(
  2015. "select * from book where title = :book.title and author = :book.author",
  2016. {title => 'Perl', author => 'Ken');
  2017.  
  2018. =item C<bind_type>
  2019.  
  2020. Specify database bind data type.
  2021.  
  2022. bind_type => [image => DBI::SQL_BLOB]
  2023. bind_type => [[qw/image audio/] => DBI::SQL_BLOB]
  2024.  
  2025. This is used to bind parameter by C<bind_param> of statment handle.
  2026.  
  2027. $sth->bind_param($pos, $value, DBI::SQL_BLOB);
  2028.  
  2029. =item C<table_alias> EXPERIMENTAL
  2030.  
  2031. table_alias => {user => 'hiker'}
  2032.  
  2033. Table alias. Key is real table name, value is alias table name.
  2034. If you set C<table_alias>, you can enable C<into1> and C<into2> type rule
  2035. on alias table name.
  2036.  
  2037. =item C<type_rule_off> EXPERIMENTAL
  2038.  
  2039. type_rule_off => 1
  2040.  
  2041. Turn C<into1> and C<into2> type rule off.
  2042.  
  2043. =item C<type_rule1_off> EXPERIMENTAL
  2044.  
  2045. type_rule1_off => 1
  2046.  
  2047. Turn C<into1> type rule off.
  2048.  
  2049. =item C<type_rule2_off> EXPERIMENTAL
  2050.  
  2051. type_rule2_off => 1
  2052.  
  2053. Turn C<into2> type rule off.
  2054.  
  2055. =back
  2056.  
  2057. =head2 C<delete>
  2058.  
  2059. $dbi->delete(table => 'book', where => {title => 'Perl'});
  2060.  
  2061. Execute delete statement.
  2062.  
  2063. The following opitons are available.
  2064.  
  2065. =over 4
  2066.  
  2067. =item C<append>
  2068.  
  2069. Same as C<select> method's C<append> option.
  2070.  
  2071. =item C<filter>
  2072.  
  2073. Same as C<execute> method's C<filter> option.
  2074.  
  2075. =item C<id>
  2076.  
  2077. id => 4
  2078. id => [4, 5]
  2079.  
  2080. ID corresponding to C<primary_key>.
  2081. You can delete rows by C<id> and C<primary_key>.
  2082.  
  2083. $dbi->delete(
  2084. parimary_key => ['id1', 'id2'],
  2085. id => [4, 5],
  2086. table => 'book',
  2087. );
  2088.  
  2089. The above is same as the followin one.
  2090.  
  2091. $dbi->delete(where => {id1 => 4, id2 => 5}, table => 'book');
  2092.  
  2093. =item C<prefix>
  2094.  
  2095. prefix => 'some'
  2096.  
  2097. prefix before table name section.
  2098.  
  2099. delete some from book
  2100.  
  2101. =item C<query>
  2102.  
  2103. Same as C<execute> method's C<query> option.
  2104.  
  2105. =item C<table>
  2106.  
  2107. table => 'book'
  2108.  
  2109. Table name.
  2110.  
  2111. =item C<where>
  2112.  
  2113. Same as C<select> method's C<where> option.
  2114.  
  2115. =item C<primary_key>
  2116.  
  2117. See C<id> option.
  2118.  
  2119. =item C<bind_type>
  2120.  
  2121. Same as C<execute> method's C<bind_type> option.
  2122.  
  2123. =item C<type_rule_off> EXPERIMENTAL
  2124.  
  2125. Same as C<execute> method's C<type_rule_off> option.
  2126.  
  2127. =item C<type_rule1_off> EXPERIMENTAL
  2128.  
  2129. type_rule1_off => 1
  2130.  
  2131. Same as C<execute> method's C<type_rule1_off> option.
  2132.  
  2133. =item C<type_rule2_off> EXPERIMENTAL
  2134.  
  2135. type_rule2_off => 1
  2136.  
  2137. Same as C<execute> method's C<type_rule2_off> option.
  2138.  
  2139. =back
  2140.  
  2141. =head2 C<delete_all>
  2142.  
  2143. $dbi->delete_all(table => $table);
  2144.  
  2145. Execute delete statement for all rows.
  2146. Options is same as C<delete>.
  2147.  
  2148. =head2 C<insert>
  2149.  
  2150. $dbi->insert({title => 'Perl', author => 'Ken'}, table => 'book');
  2151.  
  2152. Execute insert statement. First argument is row data. Return value is
  2153. affected row count.
  2154.  
  2155. If you want to set constant value to row data, use scalar reference
  2156. as parameter value.
  2157.  
  2158. {date => \"NOW()"}
  2159.  
  2160. The following opitons are available.
  2161.  
  2162. =over 4
  2163.  
  2164. =item C<append>
  2165.  
  2166. Same as C<select> method's C<append> option.
  2167.  
  2168. =item C<filter>
  2169.  
  2170. Same as C<execute> method's C<filter> option.
  2171.  
  2172. =item C<id>
  2173.  
  2174. id => 4
  2175. id => [4, 5]
  2176.  
  2177. ID corresponding to C<primary_key>.
  2178. You can insert a row by C<id> and C<primary_key>.
  2179.  
  2180. $dbi->insert(
  2181. {title => 'Perl', author => 'Ken'}
  2182. parimary_key => ['id1', 'id2'],
  2183. id => [4, 5],
  2184. table => 'book'
  2185. );
  2186.  
  2187. The above is same as the followin one.
  2188.  
  2189. $dbi->insert(
  2190. {id1 => 4, id2 => 5, title => 'Perl', author => 'Ken'},
  2191. table => 'book'
  2192. );
  2193.  
  2194. =item C<prefix>
  2195.  
  2196. prefix => 'or replace'
  2197.  
  2198. prefix before table name section
  2199.  
  2200. insert or replace into book
  2201.  
  2202. =item C<primary_key>
  2203.  
  2204. primary_key => 'id'
  2205. primary_key => ['id1', 'id2']
  2206.  
  2207. Primary key. This is used by C<id> option.
  2208.  
  2209. =item C<query>
  2210.  
  2211. Same as C<execute> method's C<query> option.
  2212.  
  2213. =item C<table>
  2214.  
  2215. table => 'book'
  2216.  
  2217. Table name.
  2218.  
  2219. =item C<bind_type>
  2220.  
  2221. Same as C<execute> method's C<bind_type> option.
  2222.  
  2223. =item C<type_rule_off> EXPERIMENTAL
  2224.  
  2225. Same as C<execute> method's C<type_rule_off> option.
  2226.  
  2227. =item C<type_rule1_off> EXPERIMENTAL
  2228.  
  2229. type_rule1_off => 1
  2230.  
  2231. Same as C<execute> method's C<type_rule1_off> option.
  2232.  
  2233. =item C<type_rule2_off> EXPERIMENTAL
  2234.  
  2235. type_rule2_off => 1
  2236.  
  2237. Same as C<execute> method's C<type_rule2_off> option.
  2238.  
  2239. =back
  2240.  
  2241. =over 4
  2242.  
  2243. =head2 C<insert_param>
  2244.  
  2245. my $insert_param = $dbi->insert_param({title => 'a', age => 2});
  2246.  
  2247. Create insert parameters.
  2248.  
  2249. (title, author) values (title = :title, age = :age);
  2250.  
  2251. =head2 C<include_model>
  2252.  
  2253. $dbi->include_model('MyModel');
  2254.  
  2255. Include models from specified namespace,
  2256. the following layout is needed to include models.
  2257.  
  2258. lib / MyModel.pm
  2259. / MyModel / book.pm
  2260. / company.pm
  2261.  
  2262. Name space module, extending L<DBIx::Custom::Model>.
  2263.  
  2264. B<MyModel.pm>
  2265.  
  2266. package MyModel;
  2267. use DBIx::Custom::Model -base;
  2268. 1;
  2269.  
  2270. Model modules, extending name space module.
  2271.  
  2272. B<MyModel/book.pm>
  2273.  
  2274. package MyModel::book;
  2275. use MyModel -base;
  2276. 1;
  2277.  
  2278. B<MyModel/company.pm>
  2279.  
  2280. package MyModel::company;
  2281. use MyModel -base;
  2282. 1;
  2283. MyModel::book and MyModel::company is included by C<include_model>.
  2284.  
  2285. You can get model object by C<model>.
  2286.  
  2287. my $book_model = $dbi->model('book');
  2288. my $company_model = $dbi->model('company');
  2289.  
  2290. See L<DBIx::Custom::Model> to know model features.
  2291.  
  2292. =head2 C<map_param> EXPERIMENTAL
  2293.  
  2294. my $map_param = $dbi->map_param(
  2295. {id => 1, authro => 'Ken', price => 1900},
  2296. 'id' => 'book.id',
  2297. 'author' => ['book.author' => sub { '%' . $_[0] . '%' }],
  2298. 'price' => [
  2299. 'book.price', {if => sub { length $_[0] }}
  2300. ]
  2301. );
  2302.  
  2303. Map paramters to other key and value. First argument is original
  2304. parameter. this is hash reference. Rest argument is mapping.
  2305. By default, Mapping is done if the value length is not zero.
  2306.  
  2307. =over 4
  2308.  
  2309. =item Key mapping
  2310.  
  2311. 'id' => 'book.id'
  2312.  
  2313. This is only key mapping. Value is same as original one.
  2314.  
  2315. (id => 1) is mapped to ('book.id' => 1) if value length is not zero.
  2316.  
  2317. =item Key and value mapping
  2318.  
  2319. 'author' => ['book.author' => sub { '%' . $_[0] . '%' }]
  2320.  
  2321. This is key and value mapping. Frist element of array reference
  2322. is mapped key name, second element is code reference to map the value.
  2323.  
  2324. (author => 'Ken') is mapped to ('book.author' => '%Ken%')
  2325. if value length is not zero.
  2326.  
  2327. =item Condition
  2328.  
  2329. 'price' => ['book.price', {if => 'exists'}]
  2330. 'price' => ['book.price', sub { '%' . $_[0] . '%' }, {if => 'exists'}]
  2331. 'price' => ['book.price', {if => sub { defined shift }}]
  2332.  
  2333. If you need condition, you can sepecify it. this is code reference
  2334. or 'exists'. By default, condition is the following one.
  2335.  
  2336. sub { defined $_[0] && length $_[0] }
  2337.  
  2338. =back
  2339.  
  2340. =head2 C<merge_param>
  2341.  
  2342. my $param = $dbi->merge_param({key1 => 1}, {key1 => 1, key2 => 2});
  2343.  
  2344. Merge parameters.
  2345.  
  2346. {key1 => [1, 1], key2 => 2}
  2347.  
  2348. =head2 C<method>
  2349.  
  2350. $dbi->method(
  2351. update_or_insert => sub {
  2352. my $self = shift;
  2353. # Process
  2354. },
  2355. find_or_create => sub {
  2356. my $self = shift;
  2357. # Process
  2358. }
  2359. );
  2360.  
  2361. Register method. These method is called directly from L<DBIx::Custom> object.
  2362.  
  2363. $dbi->update_or_insert;
  2364. $dbi->find_or_create;
  2365.  
  2366. =head2 C<model>
  2367.  
  2368. my $model = $dbi->model('book');
  2369.  
  2370. Get a L<DBIx::Custom::Model> object,
  2371.  
  2372. =head2 C<mycolumn>
  2373.  
  2374. my $column = $self->mycolumn(book => ['author', 'title']);
  2375.  
  2376. Create column clause for myself. The follwoing column clause is created.
  2377.  
  2378. book.author as author,
  2379. book.title as title
  2380.  
  2381. =head2 C<new>
  2382.  
  2383. my $dbi = DBIx::Custom->new(
  2384. dsn => "dbi:mysql:database=dbname",
  2385. user => 'ken',
  2386. password => '!LFKD%$&',
  2387. dbi_option => {mysql_enable_utf8 => 1}
  2388. );
  2389.  
  2390. Create a new L<DBIx::Custom> object.
  2391.  
  2392. =head2 C<not_exists>
  2393.  
  2394. my $not_exists = $dbi->not_exists;
  2395.  
  2396. DBIx::Custom::NotExists object, indicating the column is not exists.
  2397. This is used by C<clause> of L<DBIx::Custom::Where> .
  2398.  
  2399. =head2 C<order> EXPERIMENTAL
  2400.  
  2401. my $order = $dbi->order;
  2402.  
  2403. Create a new L<DBIx::Custom::Order> object.
  2404.  
  2405. =head2 C<register_filter>
  2406.  
  2407. $dbi->register_filter(
  2408. # Time::Piece object to database DATE format
  2409. tp_to_date => sub {
  2410. my $tp = shift;
  2411. return $tp->strftime('%Y-%m-%d');
  2412. },
  2413. # database DATE format to Time::Piece object
  2414. date_to_tp => sub {
  2415. my $date = shift;
  2416. return Time::Piece->strptime($date, '%Y-%m-%d');
  2417. }
  2418. );
  2419. Register filters, used by C<filter> option of many methods.
  2420.  
  2421. =head2 C<type_rule> EXPERIMENTAL
  2422.  
  2423. $dbi->type_rule(
  2424. into1 => {
  2425. date => sub { ... },
  2426. datetime => sub { ... }
  2427. },
  2428. into2 => {
  2429. date => sub { ... },
  2430. datetime => sub { ... }
  2431. },
  2432. from1 => {
  2433. # DATE
  2434. 9 => sub { ... },
  2435. # DATETIME or TIMESTAMP
  2436. 11 => sub { ... },
  2437. }
  2438. from2 => {
  2439. # DATE
  2440. 9 => sub { ... },
  2441. # DATETIME or TIMESTAMP
  2442. 11 => sub { ... },
  2443. }
  2444. );
  2445.  
  2446. Filtering rule when data is send into and get from database.
  2447. This has a little complex problem.
  2448.  
  2449. In C<into1> and C<into2> you can specify
  2450. type name as same as type name defined
  2451. by create table, such as C<DATETIME> or C<DATE>.
  2452.  
  2453. Note that type name and data type don't contain upper case.
  2454. If these contain upper case charactor, you convert it to lower case.
  2455.  
  2456. C<into2> is executed after C<into1>.
  2457.  
  2458. Type rule of C<into1> and C<into2> is enabled on the following
  2459. column name.
  2460.  
  2461. =over 4
  2462.  
  2463. =item 1. column name
  2464.  
  2465. issue_date
  2466. issue_datetime
  2467.  
  2468. This need C<table> option in each method.
  2469.  
  2470. =item 2. table name and column name, separator is dot
  2471.  
  2472. book.issue_date
  2473. book.issue_datetime
  2474.  
  2475. =back
  2476.  
  2477. You get all type name used in database by C<available_type_name>.
  2478.  
  2479. print $dbi->available_type_name;
  2480.  
  2481. In C<from1> and C<from2> you specify data type, not type name.
  2482. C<from2> is executed after C<from1>.
  2483. You get all data type by C<available_data_type>.
  2484.  
  2485. print $dbi->available_data_type;
  2486.  
  2487. You can also specify multiple types at once.
  2488.  
  2489. $dbi->type_rule(
  2490. into1 => [
  2491. [qw/DATE DATETIME/] => sub { ... },
  2492. ],
  2493. );
  2494.  
  2495. =head2 C<select>
  2496.  
  2497. my $result = $dbi->select(
  2498. table => 'book',
  2499. column => ['author', 'title'],
  2500. where => {author => 'Ken'},
  2501. );
  2502. Execute select statement.
  2503.  
  2504. The following opitons are available.
  2505.  
  2506. =over 4
  2507.  
  2508. =item C<append>
  2509.  
  2510. append => 'order by title'
  2511.  
  2512. Append statement to last of SQL.
  2513. =item C<column>
  2514. column => 'author'
  2515. column => ['author', 'title']
  2516.  
  2517. Column clause.
  2518. if C<column> is not specified, '*' is set.
  2519.  
  2520. column => '*'
  2521.  
  2522. You can specify hash of array reference.
  2523.  
  2524. column => [
  2525. {book => [qw/author title/]},
  2526. {person => [qw/name age/]}
  2527. ]
  2528.  
  2529. This is expanded to the following one by using C<colomn> method.
  2530.  
  2531. book.author as "book.author",
  2532. book.title as "book.title",
  2533. person.name as "person.name",
  2534. person.age as "person.age"
  2535.  
  2536. You can specify array of array reference, first argument is
  2537. column name, second argument is alias.
  2538.  
  2539. column => [
  2540. ['date(book.register_datetime)' => 'book.register_date']
  2541. ];
  2542.  
  2543. Alias is quoted properly and joined.
  2544.  
  2545. date(book.register_datetime) as "book.register_date"
  2546.  
  2547. =item C<filter>
  2548.  
  2549. Same as C<execute> method's C<filter> option.
  2550.  
  2551. =item C<id>
  2552.  
  2553. id => 4
  2554. id => [4, 5]
  2555.  
  2556. ID corresponding to C<primary_key>.
  2557. You can select rows by C<id> and C<primary_key>.
  2558.  
  2559. $dbi->select(
  2560. parimary_key => ['id1', 'id2'],
  2561. id => [4, 5],
  2562. table => 'book'
  2563. );
  2564.  
  2565. The above is same as the followin one.
  2566.  
  2567. $dbi->select(
  2568. where => {id1 => 4, id2 => 5},
  2569. table => 'book'
  2570. );
  2571. =item C<param> EXPERIMETNAL
  2572.  
  2573. param => {'table2.key3' => 5}
  2574.  
  2575. Parameter shown before where clause.
  2576. For example, if you want to contain tag in join clause,
  2577. you can pass parameter by C<param> option.
  2578.  
  2579. join => ['inner join (select * from table2 where table2.key3 = :table2.key3)' .
  2580. ' as table2 on table1.key1 = table2.key1']
  2581.  
  2582. =itme C<prefix>
  2583.  
  2584. prefix => 'SQL_CALC_FOUND_ROWS'
  2585.  
  2586. Prefix of column cluase
  2587.  
  2588. select SQL_CALC_FOUND_ROWS title, author from book;
  2589.  
  2590. =item C<join>
  2591.  
  2592. join => [
  2593. 'left outer join company on book.company_id = company_id',
  2594. 'left outer join location on company.location_id = location.id'
  2595. ]
  2596. Join clause. If column cluase or where clause contain table name like "company.name",
  2597. join clausees needed when SQL is created is used automatically.
  2598.  
  2599. $dbi->select(
  2600. table => 'book',
  2601. column => ['company.location_id as location_id'],
  2602. where => {'company.name' => 'Orange'},
  2603. join => [
  2604. 'left outer join company on book.company_id = company.id',
  2605. 'left outer join location on company.location_id = location.id'
  2606. ]
  2607. );
  2608.  
  2609. In above select, column and where clause contain "company" table,
  2610. the following SQL is created
  2611.  
  2612. select company.location_id as location_id
  2613. from book
  2614. left outer join company on book.company_id = company.id
  2615. where company.name = ?;
  2616.  
  2617. You can specify two table by yourself. This is useful when join parser can't parse
  2618. the join clause correctly. This is EXPERIMENTAL.
  2619.  
  2620. $dbi->select(
  2621. table => 'book',
  2622. column => ['company.location_id as location_id'],
  2623. where => {'company.name' => 'Orange'},
  2624. join => [
  2625. {
  2626. clause => 'left outer join location on company.location_id = location.id',
  2627. table => ['company', 'location']
  2628. }
  2629. ]
  2630. );
  2631.  
  2632. =item C<primary_key>
  2633.  
  2634. primary_key => 'id'
  2635. primary_key => ['id1', 'id2']
  2636.  
  2637. Primary key. This is used by C<id> option.
  2638.  
  2639. =item C<query>
  2640.  
  2641. Same as C<execute> method's C<query> option.
  2642.  
  2643. =item C<bind_type>
  2644.  
  2645. Same as C<execute> method's C<bind_type> option.
  2646.  
  2647. =item C<table>
  2648.  
  2649. table => 'book'
  2650.  
  2651. Table name.
  2652.  
  2653. =item C<type_rule_off> EXPERIMENTAL
  2654.  
  2655. Same as C<execute> method's C<type_rule_off> option.
  2656.  
  2657. =item C<type_rule1_off> EXPERIMENTAL
  2658.  
  2659. type_rule1_off => 1
  2660.  
  2661. Same as C<execute> method's C<type_rule1_off> option.
  2662.  
  2663. =item C<type_rule2_off> EXPERIMENTAL
  2664.  
  2665. type_rule2_off => 1
  2666.  
  2667. Same as C<execute> method's C<type_rule2_off> option.
  2668.  
  2669. =item C<where>
  2670. # Hash refrence
  2671. where => {author => 'Ken', 'title' => 'Perl'}
  2672. # DBIx::Custom::Where object
  2673. where => $dbi->where(
  2674. clause => ['and', 'author = :author', 'title like :title'],
  2675. param => {author => 'Ken', title => '%Perl%'}
  2676. );
  2677. # Array reference 1 (array reference, hash referenc). same as above
  2678. where => [
  2679. ['and', 'author = :author', 'title like :title'],
  2680. {author => 'Ken', title => '%Perl%'}
  2681. ];
  2682. # Array reference 2 (String, hash reference)
  2683. where => [
  2684. 'title like :title',
  2685. {title => '%Perl%'}
  2686. ]
  2687. # String
  2688. where => 'title is null'
  2689.  
  2690. Where clause.
  2691. =item C<wrap> EXPERIMENTAL
  2692.  
  2693. Wrap statement. This is array reference.
  2694.  
  2695. $dbi->select(wrap => ['select * from (', ') as t where ROWNUM < 10']);
  2696.  
  2697. This option is for Oracle and SQL Server paging process.
  2698.  
  2699. =back
  2700.  
  2701. =head2 C<update>
  2702.  
  2703. $dbi->update({title => 'Perl'}, table => 'book', where => {id => 4});
  2704.  
  2705. Execute update statement. First argument is update row data.
  2706.  
  2707. If you want to set constant value to row data, use scalar reference
  2708. as parameter value.
  2709.  
  2710. {date => \"NOW()"}
  2711.  
  2712. The following opitons are available.
  2713.  
  2714. =over 4
  2715.  
  2716. =item C<append>
  2717.  
  2718. Same as C<select> method's C<append> option.
  2719.  
  2720. =item C<filter>
  2721.  
  2722. Same as C<execute> method's C<filter> option.
  2723.  
  2724. =item C<id>
  2725.  
  2726. id => 4
  2727. id => [4, 5]
  2728.  
  2729. ID corresponding to C<primary_key>.
  2730. You can update rows by C<id> and C<primary_key>.
  2731.  
  2732. $dbi->update(
  2733. {title => 'Perl', author => 'Ken'}
  2734. parimary_key => ['id1', 'id2'],
  2735. id => [4, 5],
  2736. table => 'book'
  2737. );
  2738.  
  2739. The above is same as the followin one.
  2740.  
  2741. $dbi->update(
  2742. {title => 'Perl', author => 'Ken'}
  2743. where => {id1 => 4, id2 => 5},
  2744. table => 'book'
  2745. );
  2746.  
  2747. =item C<prefix>
  2748.  
  2749. prefix => 'or replace'
  2750.  
  2751. prefix before table name section
  2752.  
  2753. update or replace book
  2754.  
  2755. =item C<primary_key>
  2756.  
  2757. primary_key => 'id'
  2758. primary_key => ['id1', 'id2']
  2759.  
  2760. Primary key. This is used by C<id> option.
  2761.  
  2762. =item C<query>
  2763.  
  2764. Same as C<execute> method's C<query> option.
  2765.  
  2766. =item C<table>
  2767.  
  2768. table => 'book'
  2769.  
  2770. Table name.
  2771.  
  2772. =item C<where>
  2773.  
  2774. Same as C<select> method's C<where> option.
  2775.  
  2776. =item C<bind_type>
  2777.  
  2778. Same as C<execute> method's C<bind_type> option.
  2779.  
  2780. =item C<type_rule_off> EXPERIMENTAL
  2781.  
  2782. Same as C<execute> method's C<type_rule_off> option.
  2783.  
  2784. =item C<type_rule1_off> EXPERIMENTAL
  2785.  
  2786. type_rule1_off => 1
  2787.  
  2788. Same as C<execute> method's C<type_rule1_off> option.
  2789.  
  2790. =item C<type_rule2_off> EXPERIMENTAL
  2791.  
  2792. type_rule2_off => 1
  2793.  
  2794. Same as C<execute> method's C<type_rule2_off> option.
  2795.  
  2796. =back
  2797.  
  2798. =head2 C<update_all>
  2799.  
  2800. $dbi->update_all({title => 'Perl'}, table => 'book', );
  2801.  
  2802. Execute update statement for all rows.
  2803. Options is same as C<update> method.
  2804.  
  2805. =head2 C<update_param>
  2806.  
  2807. my $update_param = $dbi->update_param({title => 'a', age => 2});
  2808.  
  2809. Create update parameter tag.
  2810.  
  2811. set title = :title, author = :author
  2812.  
  2813. =head2 C<where>
  2814.  
  2815. my $where = $dbi->where(
  2816. clause => ['and', 'title = :title', 'author = :author'],
  2817. param => {title => 'Perl', author => 'Ken'}
  2818. );
  2819.  
  2820. Create a new L<DBIx::Custom::Where> object.
  2821.  
  2822. =head2 C<setup_model>
  2823.  
  2824. $dbi->setup_model;
  2825.  
  2826. Setup all model objects.
  2827. C<columns> of model object is automatically set, parsing database information.
  2828.  
  2829. =head1 ENVIRONMENT VARIABLE
  2830.  
  2831. =head2 C<DBIX_CUSTOM_DEBUG>
  2832.  
  2833. If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
  2834. executed SQL and bind values are printed to STDERR.
  2835.  
  2836. =head2 C<DBIX_CUSTOM_DEBUG_ENCODING>
  2837.  
  2838. DEBUG output encoding. Default to UTF-8.
  2839.  
  2840. =head1 DEPRECATED FUNCTIONALITIES
  2841.  
  2842. L<DBIx::Custom>
  2843.  
  2844. # Attribute methods
  2845. data_source # will be removed at 2017/1/1
  2846. dbi_options # will be removed at 2017/1/1
  2847. filter_check # will be removed at 2017/1/1
  2848. reserved_word_quote # will be removed at 2017/1/1
  2849. cache_method # will be removed at 2017/1/1
  2850. # Methods
  2851. create_query # will be removed at 2017/1/1
  2852. apply_filter # will be removed at 2017/1/1
  2853. select_at # will be removed at 2017/1/1
  2854. delete_at # will be removed at 2017/1/1
  2855. update_at # will be removed at 2017/1/1
  2856. insert_at # will be removed at 2017/1/1
  2857. register_tag # will be removed at 2017/1/1
  2858. default_bind_filter # will be removed at 2017/1/1
  2859. default_fetch_filter # will be removed at 2017/1/1
  2860. insert_param_tag # will be removed at 2017/1/1
  2861. register_tag_processor # will be removed at 2017/1/1
  2862. update_param_tag # will be removed at 2017/1/1
  2863. # Options
  2864. select method relation option # will be removed at 2017/1/1
  2865. select method param option # will be removed at 2017/1/1
  2866. select method column option [COLUMN, as => ALIAS] format
  2867. # will be removed at 2017/1/1
  2868. # Others
  2869. execute("select * from {= title}"); # execute method's
  2870. # tag parsing functionality
  2871. # will be removed at 2017/1/1
  2872. Query caching # will be removed at 2017/1/1
  2873.  
  2874. L<DBIx::Custom::Model>
  2875.  
  2876. # Attribute methods
  2877. filter # will be removed at 2017/1/1
  2878. name # will be removed at 2017/1/1
  2879. type # will be removed at 2017/1/1
  2880.  
  2881. L<DBIx::Custom::Query>
  2882. # Attribute methods
  2883. default_filter # will be removed at 2017/1/1
  2884. table # will be removed at 2017/1/1
  2885. filters # will be removed at 2017/1/1
  2886. # Methods
  2887. filter # will be removed at 2017/1/1
  2888.  
  2889. L<DBIx::Custom::QueryBuilder>
  2890. # Attribute methods
  2891. tags # will be removed at 2017/1/1
  2892. tag_processors # will be removed at 2017/1/1
  2893. # Methods
  2894. register_tag # will be removed at 2017/1/1
  2895. register_tag_processor # will be removed at 2017/1/1
  2896. # Others
  2897. build_query("select * from {= title}"); # tag parsing functionality
  2898. # will be removed at 2017/1/1
  2899.  
  2900. L<DBIx::Custom::Result>
  2901. # Attribute methods
  2902. filter_check # will be removed at 2017/1/1
  2903. # Methods
  2904. end_filter # will be removed at 2017/1/1
  2905. remove_end_filter # will be removed at 2017/1/1
  2906. remove_filter # will be removed at 2017/1/1
  2907. default_filter # will be removed at 2017/1/1
  2908.  
  2909. L<DBIx::Custom::Tag>
  2910.  
  2911. This module is DEPRECATED! # will be removed at 2017/1/1
  2912.  
  2913. =head1 BACKWORD COMPATIBLE POLICY
  2914.  
  2915. If a functionality is DEPRECATED, you can know it by DEPRECATED warnings
  2916. except for attribute method.
  2917. You can check all DEPRECATED functionalities by document.
  2918. DEPRECATED functionality is removed after five years,
  2919. but if at least one person use the functionality and tell me that thing
  2920. I extend one year each time he tell me it.
  2921.  
  2922. EXPERIMENTAL functionality will be changed without warnings.
  2923.  
  2924. This policy was changed at 2011/6/28
  2925.  
  2926. =head1 BUGS
  2927.  
  2928. Please tell me bugs if found.
  2929.  
  2930. C<< <kimoto.yuki at gmail.com> >>
  2931.  
  2932. L<http://github.com/yuki-kimoto/DBIx-Custom>
  2933.  
  2934. =head1 AUTHOR
  2935.  
  2936. Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
  2937.  
  2938. =head1 COPYRIGHT & LICENSE
  2939.  
  2940. Copyright 2009-2011 Yuki Kimoto, all rights reserved.
  2941.  
  2942. This program is free software; you can redistribute it and/or modify it
  2943. under the same terms as Perl itself.
  2944.  
  2945. =cut