1 package Newslash::Model::Cowrapper;
2 # Cowrapper - Connection Wrapper for MySQL
12 use List::Util qw(any);
16 use DateTime::Format::MySQL;
21 return unless my $flag = shift;
23 if ($flag eq '-base') {
25 } elsif ($flag eq '-strict') {
32 push @{"${caller}::ISA"}, $flag;
35 $_->import for qw(strict warings utf8);
36 feature->import(':5.10');
40 my ($self, @rest) = @_;
41 return $self->{options} if @rest == 0;
43 my $hash = $self->{options} || {};
46 $node = $hash->{$node};
54 my $options = shift || {};
57 bless {options => {%$options, @_},
66 my ($self, $value) = @_;
68 $self->{_last_sql} = $value;
70 return $self->{_last_sql};
74 my ($self, $value) = @_;
76 $self->{_last_attr} = $value;
78 return $self->{_last_attr};
82 my ($self, $sql, $attr) = @_;
84 $self->{_last_sql} = $sql;
85 $self->{_last_attr} = $attr;
87 return ($self->{_last_sql}, $self->{_last_attr});
95 sub _dump_last_query {
98 return "+---------\n>> LAST QUERY of $cls: \n" .
99 $self->_last_sql . Dumper($self->_last_attr) .
103 ######### connect/disconnect functions
107 my $options = shift || {};
109 if ($self->transaction_mode) {
110 return $self->{_tr_dbh};
113 my $DB_HOST = $self->{options}->{Database}->{host};
114 my $DB_NAME = $self->{options}->{Database}->{name};
115 my $DB_USER = $self->{options}->{Database}->{user};
116 my $DB_PASSWORD = $self->{options}->{Database}->{password};
118 my $settings = 'mysql_read_default_group=libmysqlclient;mysql_read_default_file=/etc/mysql/my.cnf';
120 mysql_enable_utf8 => 1,
121 ShowErrorStatement => 1,
122 Callbacks => { # hack to use utf8mb4. see http://d.hatena.ne.jp/hirose31/20141028/1414496347
124 shift->do('SET NAMES utf8mb4');
131 my $dbh = DBI->connect("DBI:mysql:$DB_NAME:$DB_HOST;$settings", $DB_USER, $DB_PASSWORD, $attr);
133 $self->{_tr_dbh} = $dbh;
140 return if $self->transaction_mode;
141 return if !$self->{_tr_dbh};
143 return $self->{_tr_dbh}->disconnect;
147 ########## Transaction related functions
149 sub transaction_mode {
151 return 0 if !defined $self->{_transactions};
152 return ($self->{_transactions} > 0);
155 sub start_transaction {
157 my $options = shift || {};
159 if (!defined $self->{_transactions}) {
160 $self->{_transactions} = 0;
163 # already transaction mode
164 if ($self->transaction_mode) {
165 $self->{_transactions} += 1;
166 return $self->{_tr_dbh};
169 # start new transaction
170 $options->{AutoCommit} = 0;
171 $self->connect_db($options);
172 $self->{_transactions} = 1;
175 return $self->{_tr_dbh};
178 # use external defined dbh
179 sub use_transaction {
183 if ($self->transaction_mode) {
184 die "already transaction started";
188 #$self->{_transactions} = 2;
189 $self->{_tr_dbh} = $dbh;
197 return if !$self->transaction_mode;
199 if ($self->{_transactions} == 1) {
200 $self->{_tr_dbh}->commit;
201 $self->{_tr_dbh}->disconnect;
203 delete $self->{_tr_dbh};
205 $self->{_transactions} -= 1;
210 return if !$self->transaction_mode;
212 #$self->set_error($self->{_tr_dbh}->errstr);
214 $self->{_tr_dbh}->rollback;
215 $self->{_tr_dbh}->disconnect;
216 delete $self->{_tr_dbh};
217 $self->{_transactions} = 0;
220 ########## Utility functions
223 my ($self, $table) = @_;
225 my $dbh = $self->connect_db;
226 my $DB_NAME = $self->{options}->{Database}->{name};
229 SELECT * FROM information_schema.TABLES
230 WHERE TABLE_SCHEMA = ?
234 my $sth = $dbh->prepare($sql);
235 $sth->execute($DB_NAME, $table);
236 my $rs = $sth->fetchall_arrayref({});
237 $self->disconnect_db;
246 if ($self->options->{readonly}) {
247 $self->set_error("readonly mode");
253 ########## error handling
256 $self->{_error} = undef;
257 $self->{_errorno} = undef;
261 my ($self, $error, $errorno) = @_;
262 $self->{_error} = $error;
263 $self->{_errorno} = $errorno if $errorno;
266 my ($self, $errorno) = @_;
267 $self->{_errorno} = $errorno;
271 my ($self, $err) = @_;
272 $self->{_error} = $err if defined $err;
273 return $self->{_error};
277 my ($self, $errno) = @_;
278 $self->{_errorno} = $errno if defined $errno;
279 return $self->{_errorno};
282 ########## Utility functions
283 sub calculate_time_range {
284 my ($self, $params) = @_;
286 my $date = $params->{date};
287 my $year = $params->{year};
288 my $month = $params->{month};
289 my $day = $params->{day};
291 my $years = $params->{years};
292 my $months = $params->{months};
293 my $days = $params->{days};
294 my $weeks = $params->{weeks};
295 my $hours = $params->{hours};
296 my $minutes = $params->{minutes};
298 my $until = $params->{until};
299 my $since = $params->{since};
301 my $offset_sec = $params->{offset_sec};
302 my ($dt_since, $dt_until);
304 my $range_mode = ($years || $months || $days || $weeks || $hours || $minutes);
308 if (ref($since) eq 'HASH') {
311 elsif ($since =~ m/^\d{4}-\d{2}-\d{2}$/) {
312 $dt_since = DateTime::Format::MySQL->parse_date($since);
315 $dt_since = DateTime::Format::MySQL->parse_datetime($since);
319 if (ref($until) eq 'HASH') {
322 elsif ($until =~ m/^\d{4}-\d{2}-\d{2}$/) {
323 $dt_until = DateTime::Format::MySQL->parse_date($until);
326 $dt_until = DateTime::Format::MySQL->parse_datetime($until);
330 $dt_since = DateTime->new(year => $year,
331 month => $month || 1,
335 if ($date eq 'today') {
336 $dt_since = DateTime->today;
339 $dt_since = DateTime::Format::MySQL->parse_date($date);
350 $dt_until = $dt_since->clone;
351 $dt_until->add("years" => $years) if $years;
352 $dt_until->add("months" => $months) if $months;
353 $dt_until->add("days" => $days) if $days;
354 $dt_until->add("weeks" => $weeks) if $weeks;
355 $dt_until->add("hours" => $hours) if $hours;
356 $dt_until->add("minutes" => $minutes) if $minutes;
359 $dt_until = DateTime->now;
360 $dt_since = $dt_until->clone;
361 $dt_since->add("years" => -$years) if $years;
362 $dt_since->add("months" => -$months) if $months;
363 $dt_since->add("days" => -$days) if $days;
364 $dt_since->add("weeks" => -$weeks) if $weeks;
365 $dt_since->add("hours" => -$hours) if $hours;
366 $dt_since->add("minutes" => -$minutes) if $minutes;
371 $term = "month" if $month;
372 $term = "day" if $day;
374 $dt_until = $dt_since->clone;
375 $dt_until->add("${term}s" => 1);
379 $dt_since->add(seconds => -$offset_sec) if $dt_since;
380 $dt_until->add(seconds => -$offset_sec) if $dt_until;
384 $from = DateTime::Format::MySQL->format_datetime($dt_since) if $dt_since;
385 $to = DateTime::Format::MySQL->format_datetime($dt_until) if $dt_until;
391 =head2 build_where_clause(unique_keys => $unique_keys,
393 timestamps => $timestamps,
394 where => $where_params,
397 build SQL WHERE clause.
407 STRING or ARRAYREF or HASHREF.
408 If STRING, $keys contains unique keys.
409 If ARRAREF, @$keys contains unique keys.
410 If HASHREF, %$keys is { key1 => alias1, key2 => alias2, ... }.
412 'unique key' is a column name defined with 'UNIQUE' or 'PRIMARY'.
414 If you want to use key which is not correspod to table's column,
415 use alias. When aliases given, the aliases are replaced to keys in SQL.
421 STRING or ARRAYREF or HASHREF.
422 If STRING, $keys contains non-unique keys.
423 If ARRAREF, @$keys contains non-unique keys.
424 If HASHREF, %$keys is { key1 => alias1, key2 => alias2, ... }.
430 HASHREF to query parameters
434 when list context, returns ($clause, \@values, $unique).
435 when scalar context, return hashref like:
436 { clause => $clause, values => \@values, unique => $unique };
442 sub build_where_clause {
448 if ($args->{keys} || $args->{unique_keys}) {
449 $uniques = $args->{unique_keys};
450 $keys = $args->{keys};
453 $uniques = $self->unique_keys;
454 $keys = $self->get_keys("non-unique");
456 my $timestamp = $args->{timestamp} || $self->{timestamp};
458 my $params = $args->{params};
459 my $where = $args->{where} || $params;
464 # check and process "OR" parameter
465 if (defined $where->{OR}) {
466 my $sub_params = $where->{OR};
467 croak "invalid OR parameter" if (ref($sub_params) ne "HASH");
469 my ($sub_clause, $sub_values, $sub_unique) = $self->_parse_where_clause($uniques, $keys, $timestamp, $sub_params);
470 my $or_clause = join(" OR ", @$sub_clause);
472 push @clauses, "( $or_clause )";
473 push @values, @$sub_values;
477 my ($sub_clauses, $sub_values, $unique) = $self->_parse_where_clause($uniques, $keys, $timestamp, $where);
478 push @clauses, @$sub_clauses;
479 push @values, @$sub_values;
483 $clause = "WHERE " . join(" AND ", @clauses);
486 return wantarray ? ($clause, \@values, $unique)
487 : { clause => $clause,
489 unique => $unique, };
494 sub _parse_where_clause {
495 my ($self, $uniques, $keys, $timestamp, $params) = @_;
502 my $decode_param = sub {
505 # simply equal clause
507 return ("$k = ?", $v);
511 if (ref($v) eq 'ARRAY') {
512 my $placeholder = join(", ", map { "?" } @$v);
513 return ("$k IN ($placeholder)", $v);
516 # gt/lt/ge/le (>, <, >=, <=)
517 if (ref($v) eq 'HASH') {
518 return ("$k > ?", $v->{gt}) if defined $v->{gt};
519 return ("$k < ?", $v->{lt}) if defined $v->{lt};
520 return ("$k >= ?", $v->{ge}) if defined $v->{ge};
521 return ("$k <= ?", $v->{le}) if defined $v->{le};
522 return ("$k != ?", $v->{ne}) if defined $v->{ne};
525 die "invalid query parameter: $k, $v";
529 my $decode_and_set_params = sub {
530 my ($k, $p, $is_unique) = @_;
531 my ($c, $v) = $decode_param->($k, $p);
532 push @clauses, $c if $c;
534 if (ref($v) eq 'ARRAY') {
539 $unique = 1 if $is_unique;
545 # reqularize keys to hashref
546 my $ky = $self->_keys_to_hash($keys);
548 for my $k (keys(%$ky)) {
549 if (defined $params->{$k}) {
550 $decode_and_set_params->($ky->{$k}, $params->{$k});
554 # reqularize uniques to hashref
555 my $u = $self->_keys_to_hash($uniques);
557 for my $k (keys(%$u)) {
558 if (defined $params->{$k}) {
559 $decode_and_set_params->($u->{$k}, $params->{$k}, 1);
564 # year, month, day, years, months, days, date
566 my ($begin, $end) = $self->calculate_time_range($params);
568 push @clauses, "$timestamp >= ?";
569 push @values, $begin;
572 push @clauses, "$timestamp < ?";
577 return (\@clauses, \@values, $unique);
580 # reqularize keys to hashref
582 my ($self, $keys) = @_;
583 return if !defined $keys;
586 if(ref($keys) eq 'HASH') {
589 elsif (ref($keys) eq 'ARRAY') {
595 elsif (!ref($keys)) {
596 $ky = { $keys => $keys };
601 =head2 build_limit_clause(params => \@params)
603 build SQL's LIMIT clause.
613 HASHREF to query parameters
617 when list context, returns ($clause, \@values).
618 when scalar context, return hashref like:
619 { clause => $clause, values => \@values };
625 sub build_limit_clause {
629 my $params = $args->{params};
630 my $limit = $args->{default};
631 my $offset = $args->{default_offset};
633 $limit = $args->{default_limit} if defined $args->{default_limit};
634 $limit = $params->{limit} if defined $params->{limit};
635 $offset = $params->{offset} if defined $params->{offset};
639 if (defined $limit) {
640 push @clauses, "LIMIT ?";
641 push @values, $limit;
643 if (defined $offset) {
644 push @clauses, "OFFSET ?";
645 push @values, $offset;
648 my $clause = join(" ", @clauses);
650 return wantarray ? ($clause, \@values)
651 : { clause => $clause, values => \@values };
654 =head2 build_order_by_clause(keys => $keys, params => \@params)
656 build SQL ORDER BY clause.
667 If ARRAREF, @$keys contains selectSable columns.
668 If HASHREF, %$keys is { key1 => alias1, key2 => alias2, ... }.
672 HASHREF to query parameters
676 when list context, returns ($clause, \@values).
677 when scalar context, return hashref like:
678 { clause => $clause, values => \@values };
684 sub build_order_by_clause {
688 my $unique_keys = $args->{unique_keys} || $self->unique_keys;
689 my $keys = $args->{keys} || $self->get_keys("all");
691 my $params = $args->{params};
692 my $order_by = $params->{order_by};
694 if (!$keys || !$params || !$order_by) {
695 return wantarray ? ("", [])
696 : { clause => "", values => [] };
704 # convert $keys to hash style
705 if (ref($keys) eq 'HASH') {
706 $k_names = [keys %$keys];
709 if (ref($keys) eq 'ARRAY') {
712 elsif (!ref($keys)) {
716 # "ORDER BY" clause has order, so
719 # if hash style, convert to array
722 if (ref($order_by) eq "HASH") {
723 for my $k (keys %$order_by) {
725 push @$orders, $order_by->{$k};
728 elsif (!ref($order_by) && defined($order_by)) {
729 push @$cols, $order_by;
730 push @$orders, "ASC";
732 elsif (ref($order_by) eq "ARRAY") {
734 # check hashed parameter
735 for my $item (@$order_by) {
736 if (ref($item) eq "HASH") {
737 for my $k (keys %$item) {
739 push @$orders, $item->{$k};
748 push @$orders, $item;
753 # fallback for compatibility
755 push @$orders, "ASC";
759 # when $order_by is not ARRAY or SCALAR or HASH,
760 # this block is passed.
763 next if !any {$_ eq $k} @$k_names;
765 my $order = shift @$orders;
766 if ($use_alias && $keys->{$k}) {
769 push @clauses, "$k $order" if $k;
775 $clause = "ORDER BY " . join(", ", @clauses);
778 return wantarray ? ($clause, \@values)
779 : { clause => $clause, values => \@values };
782 ########## Insert method
786 return if $self->check_readonly;
789 my $table = $args->{table} || $self->primary_table;
791 $self->set_error("table not given", -1);
797 $keys = $self->_build_keys($args->{keys});
800 $keys = $self->get_keys("all");
803 my $params = $args->{params};
805 $self->set_error("params not given", -1);
813 # extract key and values
814 for my $k (keys %$keys) {
815 next if !defined $params->{$k};
816 if (!ref($params->{$k})) {
817 push @cols, $keys->{$k};
818 push @values, $params->{$k};
819 push @placeholders, "?";
821 elsif(ref($params->{$k}) eq "HASH") {
822 for my $subkey (keys %{$params->{$k}}) {
823 if (lc($subkey) eq "function") {
824 push @cols, $keys->{$k};
825 push @placeholders, $params->{$k}->{$subkey};
831 if (!@cols || !@values) {
832 $self->set_error("no valid values", -1);
836 my $cols_clause = join(", ", @cols);
837 my $values_clause = join(", ", @placeholders);
840 my $sql = "INSERT INTO $table ($cols_clause) VALUES ($values_clause)";
841 $self->_last_query($sql, \@values);
844 #warn Dumper @values;
846 my $dbh = $self->connect_db;
847 my $rs = $dbh->do($sql, undef, @values);
849 $rs = $dbh->last_insert_id(undef, undef, undef, undef);
851 $self->disconnect_db;
857 ########## Select method
859 =head2 generic_select(table => $table, uniques => $uniques, keys => $keys, params => $params)
861 build SQL's ORDER BY clause.
875 ARRAYREF to unique keys. 'unique key' is a column name
876 defined with 'UNIQUE' or 'PRIMARY'.
882 ARRAYREF to acceptable keys (column names)
888 HASHREF to query parameters
892 when list context, returns ($clause, \@values).
893 when scalar context, return hashref like:
894 { clause => $clause, values => \@values };
903 my $table = $args->{table} || $self->primary_table;
905 $self->set_error("table no given");
908 my $params = $args->{params} || {};
910 if ($args->{uniques}) {
911 warn "Cowrapper::generic_select(): 'uniques' parameter is deprecated. use 'unique_keys'.";
912 $args->{unique_keys} ||= $args->{uniques};
914 my $uniques = $args->{unique_keys};
915 my $keys = $args->{keys};
916 my $timestamp = $args->{timestamp};
919 my ($values, $orderby, $limit, $where, $unique_query);
921 ($where, $values, $unique_query) = $self->build_where_clause(unique_keys => $uniques,
923 timestamp => $timestamp,
925 push @arguments, @$values if @$values;
927 ($orderby, $values) = $self->build_order_by_clause(keys => $keys, params => $params);
928 push @arguments, @$values if @$values;
930 ($limit, $values) = $self->build_limit_clause(params => $params);
931 push @arguments, @$values if @$values;
933 my $dbh = $self->connect_db;
934 my $generic_sql = <<"EOSQL";
941 my $sql = $args->{sql} || $generic_sql;
942 $self->_last_query($sql, \@arguments);
944 my $sth = $dbh->prepare($sql);
945 $sth->execute(@arguments);
946 my $rs = $sth->fetchall_arrayref(+{});
948 $self->set_error("select failed", $dbh->errstr, $dbh->err);
949 $self->disconnect_db;
952 $self->disconnect_db;
956 return $rs->[0] if @$rs;
962 ########## Count method
964 =head2 generic_count(
966 target => $target_column,
967 timestamp => $timestamp_column,
971 offset_sec => $offset_sec,
972 join => $join_clause,
973 where => $where_clause)
991 =item $timestamp_column
1001 target month (omissible)
1005 target day (omissible)
1009 additional WHERE clause (must not include 'WHERE' !; omissible)
1013 additional JOIN clause (must include 'JOIN' !; omissible)
1027 my $table = $params->{table} || $self->primary_table;
1028 my $target = $params->{target};
1029 my $timestamp = $params->{timestamp} || $self->timestamp;
1031 return if (!$table || !$target || !$timestamp || !$params->{year});
1034 $term = "month" if !$params->{day};
1035 $term = "year" if !$params->{month};
1037 my ($year, $month, $day) = ($params->{year}, $params->{month}, $params->{day});
1038 $year = 1 if (!$year || $year !~ m/^[0-9]{4}$/);
1039 $month = 1 if (!$month || $month !~ m/^(1[0-2]|0?[0-9])$/);
1040 $day = 1 if (!$day || $day !~ m/^(3[0-1]|[1-2][0-9]|0?[0-9])$/);
1042 my $offset = $params->{offset_sec} || 0;
1043 $offset = 0 if $offset !~ m/^[+-]?[0-9]+$/;
1045 my $dt = DateTime->new(year => $year,
1048 $dt->add(seconds => -$offset);
1049 my $dt_string = DateTime::Format::MySQL->format_datetime($dt);
1051 # create end of term datetime
1052 # we must consider timezone offset, so use relative day/month.
1053 # why use "DATE_ADD(?, INTERVAL 1 MONTH)" ? bacause, DATE_ADD function add simply 30 days...
1054 my $dt_end = DateTime->new(year => $year,
1057 if ($term eq "month") {
1058 $dt_end->add(months => 1);
1060 elsif ($term eq "year") {
1061 $dt_end->add(years => 1);
1063 $dt->add(seconds => -$offset);
1064 my $dt_end_string = DateTime::Format::MySQL->format_datetime($dt_end);
1068 my $where_clause = "";
1069 if ($params->{where}) {
1070 $where_clause = "$params->{where} AND \n";
1072 my $join_clause = $params->{join} || "";
1076 if ($term eq "day") {
1077 # `stories` table not contain display/non-display flag,
1080 SELECT COUNT($table.$target) AS count FROM $table
1083 $table.$timestamp >= ?
1084 AND $table.$timestamp < DATE_ADD(?, INTERVAL 1 DAY)
1086 push @attrs, $dt_string, $dt_string;
1088 elsif ($term eq "month") {
1090 SELECT TIMESTAMPDIFF(DAY, ?, $table.$timestamp) AS day,
1091 COUNT($table.$target) AS count
1095 $table.$timestamp >= ?
1096 AND $table.$timestamp < ?
1097 GROUP BY TIMESTAMPDIFF(DAY, ?, $table.$timestamp)
1100 push @attrs, $dt_string, $dt_string, $dt_end_string, $dt_string;
1102 elsif ($term eq "year") {
1104 SELECT TIMESTAMPDIFF(MONTH, ?, $table.$timestamp) AS month,
1105 COUNT($table.$target) AS count
1109 $table.$timestamp >= ?
1110 AND $table.$timestamp < ?
1111 GROUP BY TIMESTAMPDIFF(MONTH, ?, $table.$timestamp)
1114 push @attrs, $dt_string, $dt_string, $dt_end_string, $dt_string;
1116 my $dbh = $self->connect_db;
1117 my $sth = $dbh->prepare($sql);
1119 $self->_last_query($sql, \@attrs);
1120 $sth->execute(@attrs);
1121 my $rs = $sth->fetchall_arrayref({});
1124 $self->disconnect_db;
1127 $self->disconnect_db;
1131 if ($term eq "day") {
1132 return $rs->[0]->{count};
1134 elsif ($term eq "month") {
1137 elsif ($term eq "year") {
1144 for my $counts (@$rs) {
1145 # day / month is differential from base datetime, so add 1
1146 $hash->{$counts->{$key} + 1} = $counts->{count};
1151 sub generic_count2 {
1154 my $table = $args->{table} || $self->primary_table;
1156 $self->set_error("table no given");
1159 my $params = $args->{params} || {};
1161 if ($args->{uniques}) {
1162 warn "Cowrapper::generic_select(): 'uniques' parameter is deprecated. use 'unique_keys'.";
1163 $args->{unique_keys} ||= $args->{uniques};
1165 my $uniques = $args->{unique_keys};
1166 my $keys = $args->{keys};
1167 my $timestamp = $args->{timestamp};
1170 my ($values, $orderby, $limit, $where, $unique_query);
1172 ($where, $values, $unique_query) = $self->build_where_clause(unique_keys => $uniques,
1174 timestamp => $timestamp,
1176 push @arguments, @$values if @$values;
1178 my $target_key = $self->primary_key || "";
1180 $target_key = "*.$target_key";
1186 my $dbh = $self->connect_db;
1187 my $generic_sql = <<"EOSQL";
1188 SELECT COUNT($target_key) AS count FROM $table
1192 my $sql = $args->{sql} || $generic_sql;
1193 $self->_last_query($sql, \@arguments);
1195 my $sth = $dbh->prepare($sql);
1196 $sth->execute(@arguments);
1197 my $rs = $sth->fetchall_arrayref(+{});
1199 $self->set_error("select failed", $dbh->errstr, $dbh->err);
1200 $self->disconnect_db;
1203 $self->disconnect_db;
1205 if ($unique_query) {
1207 return $rs->[0] if @$rs;
1215 ########## Update method
1217 =head2 generic_update(table => $table,
1218 updatable_keys => $updatables,
1219 addable_keys => $addables,
1220 condition_keys => $conditions,
1223 execute UPDATE SQL command.
1237 ARRAYREF or HASHREF to updatable keys. 'updatable key' is a updatable column name.
1241 ARRAYREF or HASHREF to addable keys. 'addable key' is a addable column name.
1245 ARRAYREF or HASHREF to conditional keys. 'conditional key' is a column name which can use in WHERE clause.
1249 HASHREF to query parameters
1253 when list context, returns ($clause, \@values).
1254 when scalar context, return hashref like:
1255 { clause => $clause, values => \@values };
1261 sub generic_update {
1263 return if $self->check_readonly;
1267 my $table = $args->{table} || $self->primary_table;
1269 $self->set_error("table given", -1);
1273 my $updatables = $args->{updatable_keys} || $self->get_keys("updatable");
1274 my $addables = $args->{addable_keys} || $self->get_keys("addable");
1276 my $conditions = $args->{condition_keys};
1277 my $params = $args->{params} || {};
1278 my $where = $args->{where} || $params->{where};
1281 $conditions = $args->{condition_keys} || $self->get_keys("all");
1284 $conditions = $args->{condition_keys} || $self->get_keys("primary");
1287 if (!$conditions || !%$conditions) {
1288 $self->set_error("no_condition_keys", -1);
1291 my $u_hash = $self->_keys_to_hash($updatables);
1292 #my $a_hash = $self->_keys_to_hash($addables);
1294 # first, create WHERE clause
1295 my ($where_clause, $where_values) = $self->build_where_clause(keys => $conditions,
1298 if (!$where_clause) {
1299 $self->set_error("no_where_clauses", -1);
1307 for my $col (keys %$u_hash) {
1308 next if !defined $params->{$col};
1309 my $c = $u_hash->{$col};
1311 # if $params->{$col} is SCALAR, set to the value
1312 if (!ref($params->{$col})) {
1313 push @values, $params->{$col};
1314 push @set_clauses, "$c = ?";
1316 # if $params->{$col} is HASH, do given operation
1317 elsif (ref($params->{$col}) eq 'HASH') {
1320 for my $k (keys %{$params->{$col}}) {
1321 $p->{lc($k)} = $params->{$col}->{$k};
1324 if (defined $p->{max} && defined $p->{min}) {
1325 push @values, $p->{min};
1326 push @values, $p->{max};
1327 push @values, $p->{add};
1328 push @set_clauses, "$c = GREATEST(?, LEAST(?, $c + ?))";
1330 elsif (defined $p->{max}) {
1331 push @values, $p->{min};
1332 push @values, $p->{add};
1333 push @set_clauses, "$c = GREATEST(?, $c + ?)";
1335 elsif (defined $p->{min}) {
1336 push @values, $p->{min};
1337 push @values, $p->{add};
1338 push @set_clauses, "$c = LEAST(?, $c + ?)";
1341 push @values, $p->{add};
1342 push @set_clauses, "$c = $c + ?";
1345 if ($p->{function}) {
1346 push @set_clauses, "$c = ($p->{function})";
1351 return 0 if !@set_clauses;
1352 my $set_clause = join(", ", @set_clauses);
1354 my $sql = "UPDATE $table SET $set_clause $where_clause";
1355 push @values, @$where_values;
1356 $self->_last_query($sql, \@values);
1359 #warn Dumper @values;
1361 my $dbh = $self->connect_db;
1362 my $rs = $dbh->do($sql, undef, @values);
1363 $self->disconnect_db;
1368 ########## count helper
1370 sub build_interval_times {
1373 my $params = $attr->{params} || {};
1376 return if !$params->{year};
1377 $target = "month" if !$params->{day};
1378 $target = "year" if !$params->{month};
1380 my ($year, $month, $day) = ($params->{year}, $params->{month}, $params->{day});
1381 $year = 1 if (!$year || $year !~ m/^[0-9]{4}$/);
1382 $month = 1 if (!$month || $month !~ m/^(1[0-2]|0?[0-9])$/);
1383 $day = 1 if (!$day || $day !~ m/^(3[0-1]|[1-2][0-9]|0?[0-9])$/);
1385 my $offset = $params->{offset_sec} || 0;
1386 $offset = 0 if $offset !~ m/^[+-]?[0-9]+$/;
1388 my $dt = DateTime->new(year => $year,
1391 $dt->add(seconds => -$offset);
1392 my $dt_string = DateTime::Format::MySQL->format_datetime($dt);
1394 # create end of term datetime
1395 # why use "DATE_ADD(?, INTERVAL 1 MONTH)" ? bacause, this function add simply 30 days...
1396 my $dt_end = DateTime->new(year => $year,
1399 if ($target eq "month") {
1400 $dt_end->add(months => 1);
1402 elsif ($target eq "year") {
1403 $dt_end->add(years => 1);
1405 $dt->add(seconds => -$offset);
1406 my $dt_end_string = DateTime::Format::MySQL->format_datetime($dt_end);
1408 return wantarray ? ($target, $dt_string, $dt_end_string)
1409 : { target => $target,
1410 start => $dt_string,
1411 end => $dt_end_string };
1415 ########## Delete method
1417 =head2 generic_delete(table => $table, uniques => $uniques, keys => $keys, params => $params)
1419 DELETE item from table
1433 ARRAYREF to unique keys. 'unique key' is a column name
1434 defined with 'UNIQUE' or 'PRIMARY'.
1440 ARRAYREF to acceptable keys (column names)
1446 HASHREF to query parameters
1450 when list context, returns ($clause, \@values).
1451 when scalar context, return hashref like:
1452 { clause => $clause, values => \@values };
1458 sub generic_delete {
1461 my $table = $args->{table} || $self->primary_table;
1463 $self->set_error("table no given");
1466 my $params = $args->{params} || {};
1468 if ($args->{uniques}) {
1469 warn "Cowrapper::generic_select(): 'uniques' parameter is deprecated. use 'unique_keys'.";
1470 $args->{unique_keys} ||= $args->{uniques};
1472 my $uniques = $args->{unique_keys};
1473 my $keys = $args->{keys};
1474 my $timestamp = $args->{timestamp};
1477 my ($values, $orderby, $limit, $where, $unique_query);
1479 ($where, $values, $unique_query) = $self->build_where_clause(unique_keys => $uniques,
1481 timestamp => $timestamp,
1483 push @arguments, @$values if @$values;
1485 my $dbh = $self->connect_db;
1486 my $generic_sql = <<"EOSQL";
1491 my $sql = $args->{sql} || $generic_sql;
1492 $self->_last_query($sql, \@arguments);
1494 my $rs = $dbh->do($sql, undef, @arguments);
1496 $self->set_error("delete_failed", $dbh->errstr, $dbh->err);
1497 $self->disconnect_db;
1500 $self->disconnect_db;
1505 ######### data export / import functions
1507 =head2 export_json()
1509 export as json data.
1511 $obj->export_json(file => "foobar.json",
1513 exclude => [qw(foo bar)],
1514 sort_key => [qw(hoge moge)],
1533 my $table = $params->{table};
1536 my $keys = $params->{sort_key} || [];
1541 my $query_params = {};
1542 if ($params->{sort_key}) {
1543 $query_params->{order_by} = $keys;
1546 my $datas = $self->generic_select(table => $table, keys => $keys, params => $query_params);
1549 my $exclude = $params->{exclude} || [];
1550 if (!ref($exclude)) {
1551 $exclude = [$exclude];
1554 for my $data (@$datas) {
1555 for my $k (@$exclude) {
1560 #warn Dumper($datas);
1566 if ($params->{file}) {
1567 my $bin_data = $j->utf8->encode($datas);
1568 my $fh = FileHandle->new($params->{file}, "w");
1570 $self->set_error($!);
1573 $fh->print($bin_data);
1577 return JSON::to_json($datas);
1580 =head2 import_json()
1582 export as json data.
1584 $obj->export_json(file => "foobar.json",
1586 exclude => [qw(foo bar)],
1590 $obj->export_json(json => '{ "foo": "bar", "hoge": 1 }',
1592 exclude => [qw(foo bar)],
1612 my $table = $params->{table};
1615 if ($params->{json} && $params->{file}) {
1620 if ($params->{file}) {
1621 my $fh = FileHandle->new($params->{file}, "r");
1623 $self->set_error($!);
1626 my $json = do { local $/; <$fh> };
1628 $datas = JSON::decode_json($json);
1630 if ($params->{json}) {
1631 $datas = JSON::from_json($params->{json});
1635 return if ref($datas) ne "ARRAY";
1637 my $primary_key = $params->{unique_key};
1638 my $exclude = $params->{exclude} || [];
1639 if (!ref($exclude)) {
1640 $exclude = [$exclude];
1643 my $dbh = $self->start_transaction;
1645 for my $data (@$datas) {
1646 for my $k (@$exclude) {
1654 for my $k (keys(%$data)) {
1655 #my $quoted_k = '`' . $k . '`';
1656 my $quoted_k = $dbh->quote_identifier($k);
1657 push @cols, $quoted_k;
1659 push @vals, $data->{$k};
1660 if ($k ne $primary_key) {
1661 push @updates, "$quoted_k = ?";
1662 push @update_vals, $data->{$k};
1665 my $cols_clause = join(", ", @cols);
1666 my $placeholders = join(", ", @plhs);
1667 my $update_clauses = join(", ", @updates);
1669 my $sql = <<"EOSQL";
1674 ON DUPLICATE KEY UPDATE
1677 push @vals, @update_vals;
1678 $self->_last_query($sql, \@vals);
1680 my $rs = $dbh->do($sql, undef, @vals);
1691 ########## virtual method for O/R mapping function
1692 sub key_definition { return {}; }
1695 my ($self, $target) = @_;
1696 return {} if !$target;
1697 return $target if ref($target) eq "HASH";
1698 if (!ref($target)) {
1699 $target = [$target];
1702 my $def = $self->key_definition || {};
1704 if ($def->{basename}) {
1705 $basename = "$def->{basename}.";
1707 elsif ($def->{table}) {
1708 $basename = "$def->{table}.";
1712 for my $uk (@$target) {
1713 $rs->{$uk} = "$basename$uk";
1714 for my $k (keys %{$def->{aliases}}) {
1715 if ($uk eq $def->{aliases}->{$k}) {
1716 if ($uk =~ m/\S+\.\S+/) {
1720 $rs->{$k} = "$basename$uk";
1731 my $def = $self->key_definition || {};
1732 return $def->{table};
1737 my $def = $self->key_definition || {};
1738 return $self->_build_keys($def->{primary});
1743 my $def = $self->key_definition || {};
1744 return $self->_build_keys($def->{timestamp});
1749 my $def = $self->key_definition || {};
1750 return $self->_build_keys($def->{datetime});
1755 my $def = $self->key_definition || {};
1756 return $self->_build_keys($def->{other});
1761 my $def = $self->key_definition || {};
1762 my $uniq = $self->_build_keys($def->{unique});
1763 my $primary = $self->_build_keys($def->{primary});
1764 return $self->_merge_keys($uniq, $primary);
1769 my $def = $self->key_definition || {};
1770 return $self->_build_keys($def->{addable});
1776 my $def = $self->key_definition || {};
1779 if (defined $def->{$target}) {
1780 push @keys, @{_to_array($def->{$target})};
1782 elsif ($target eq "all") {
1783 push @keys, $def->{primary} if $def->{primary};
1785 @{_to_array($def->{unique})},
1786 @{_to_array($def->{datetime})},
1787 @{_to_array($def->{addable})},
1788 @{_to_array($def->{other})};
1790 elsif ($target eq "non-unique") {
1792 @{_to_array($def->{datetime})},
1793 @{_to_array($def->{addable})},
1794 @{_to_array($def->{other})};
1796 elsif ($target eq "updatable") {
1798 @{_to_array($def->{unique})},
1799 @{_to_array($def->{datetime})},
1800 @{_to_array($def->{addable})},
1801 @{_to_array($def->{other})};
1804 return $self->_build_keys(\@keys) if @keys;
1810 return [] if !defined $item;
1811 return $item if (ref($item) eq 'ARRAY');
1812 return [$item] if !ref($item);
1821 next if !defined $keys;
1822 if (ref($keys) eq 'ARRAY') {
1823 for my $k (@$keys) {
1827 elsif (ref($keys) eq 'HASH') {
1828 for my $k (keys %$keys) {
1829 $rs->{$k} = $keys->{$k};
1832 elsif (!ref($keys)) {
1833 $rs->{$keys} = $keys;
1840 ########## END OF FILE