src/newslash_web/lib/Newslash/Model/Cowrapper.pm

   1 package Newslash::Model::Cowrapper;
   2 # Cowrapper - Connection Wrapper for MySQL
   3
   4 use strict;
   5 use warnings;
   6 use utf8;
   7 use feature ':5.10';
   8
   9 use Carp qw(croak);
  10 use FileHandle;
  11
  12 use List::Util qw(any);
  13 use DBI;
  14 use Data::Dumper;
  15 use DateTime;
  16 use DateTime::Format::MySQL;
  17 use JSON;
  18
  19 sub import {
  20     my $class = shift;
  21     return unless my $flag = shift;
  22
  23     if ($flag eq '-base') {
  24         $flag = $class;
  25     } elsif ($flag eq '-strict') {
  26         $flag = undef;
  27     }
  28
  29     if ($flag) {
  30         my $caller = caller;
  31         no strict 'refs';
  32         push @{"${caller}::ISA"}, $flag;
  33     }
  34
  35     $_->import for qw(strict warings utf8);
  36     feature->import(':5.10');
  37 }
  38
  39 sub options {
  40     my ($self, @rest) = @_;
  41     return $self->{options} if @rest == 0;
  42
  43     my $hash = $self->{options} || {};
  44     my $node;
  45     for $node (@rest) {
  46         $node = $hash->{$node};
  47         return if !$node;
  48     }
  49     return $node;
  50 }
  51
  52 sub new {
  53     my $class = shift;
  54     my $options = shift || {};
  55     my $params = {@_};
  56
  57     bless {options => {%$options, @_},
  58            _error => "",
  59            _errorno => 0,
  60            _last_sql => "",
  61            _last_attr => [],
  62           }, $class;
  63 }
  64
  65 sub _last_sql {
  66     my ($self, $value) = @_;
  67     if (defined $value) {
  68         $self->{_last_sql} = $value;
  69     }
  70     return $self->{_last_sql};
  71 }
  72
  73 sub _last_attr {
  74     my ($self, $value) = @_;
  75     if (defined $value) {
  76         $self->{_last_attr} = $value;
  77     }
  78     return $self->{_last_attr};
  79 }
  80
  81 sub _last_query {
  82     my ($self, $sql, $attr) = @_;
  83     if (defined $sql) {
  84         $self->{_last_sql} = $sql;
  85         $self->{_last_attr} = $attr;
  86     }
  87     return ($self->{_last_sql}, $self->{_last_attr});
  88 }
  89
  90 sub _dumper {
  91     my $self = shift;
  92     return Dumper @_;
  93 }
  94
  95 sub _dump_last_query {
  96     my $self = shift;
  97     my $cls = ref($self);
  98     return "+---------\n>> LAST QUERY of $cls: \n" .
  99       $self->_last_sql . Dumper($self->_last_attr) .
 100       "+---------\n";
 101 }
 102
 103 ######### connect/disconnect functions
 104
 105 sub connect_db {
 106     my $self = shift;
 107     my $options = shift || {};
 108
 109     if ($self->transaction_mode) {
 110         return $self->{_tr_dbh};
 111     }
 112
 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};
 117
 118     my $settings = 'mysql_read_default_group=libmysqlclient;mysql_read_default_file=/etc/mysql/my.cnf';
 119     my $attr = {
 120                 mysql_enable_utf8 => 1,
 121                 ShowErrorStatement => 1,
 122                 Callbacks => { # hack to use utf8mb4. see http://d.hatena.ne.jp/hirose31/20141028/1414496347
 123                               connected => sub {
 124                                   shift->do('SET NAMES utf8mb4');
 125                                   return;
 126                               }
 127                              },
 128                 %$options,
 129                };
 130
 131     my $dbh = DBI->connect("DBI:mysql:$DB_NAME:$DB_HOST;$settings", $DB_USER, $DB_PASSWORD, $attr);
 132
 133     $self->{_tr_dbh} = $dbh;
 134     return $dbh;
 135
 136 }
 137
 138 sub disconnect_db {
 139     my $self = shift;
 140     return if $self->transaction_mode;
 141     return if !$self->{_tr_dbh};
 142
 143     return $self->{_tr_dbh}->disconnect;
 144 }
 145
 146
 147 ########## Transaction related functions
 148
 149 sub transaction_mode {
 150     my $self = shift;
 151     return 0 if !defined $self->{_transactions};
 152     return ($self->{_transactions} > 0);
 153 }
 154
 155 sub start_transaction {
 156     my $self = shift;
 157     my $options = shift || {};
 158
 159     if (!defined $self->{_transactions}) {
 160         $self->{_transactions} = 0;
 161     }
 162
 163     # already transaction mode
 164     if ($self->transaction_mode) {
 165         $self->{_transactions} += 1;
 166         return $self->{_tr_dbh};
 167     }
 168
 169     # start new transaction
 170     $options->{AutoCommit} = 0;
 171     $self->connect_db($options);
 172     $self->{_transactions} = 1;
 173
 174
 175     return $self->{_tr_dbh};
 176 }
 177
 178 # use external defined dbh
 179 sub use_transaction {
 180     my $self = shift;
 181     my $dbh = shift;
 182
 183     if ($self->transaction_mode) {
 184         die "already transaction started";
 185     }
 186
 187     if ($dbh) {
 188         #$self->{_transactions} = 2;
 189         $self->{_tr_dbh} = $dbh;
 190         return $dbh;
 191     }
 192     return;
 193 }
 194
 195 sub commit {
 196     my $self = shift;
 197     return if !$self->transaction_mode;
 198
 199     if ($self->{_transactions} == 1) {
 200         $self->{_tr_dbh}->commit;
 201         $self->{_tr_dbh}->disconnect;
 202
 203         delete $self->{_tr_dbh};
 204     }
 205     $self->{_transactions} -= 1;
 206 }
 207
 208 sub rollback {
 209     my $self = shift;
 210     return if !$self->transaction_mode;
 211
 212     #$self->set_error($self->{_tr_dbh}->errstr);
 213
 214     $self->{_tr_dbh}->rollback;
 215     $self->{_tr_dbh}->disconnect;
 216     delete $self->{_tr_dbh};
 217     $self->{_transactions} = 0;
 218 }
 219
 220 ########## Utility functions
 221
 222 sub table_exists {
 223     my ($self, $table) = @_;
 224
 225     my $dbh = $self->connect_db;
 226     my $DB_NAME = $self->{options}->{Database}->{name};
 227
 228     my $sql = <<"EOSQL";
 229 SELECT * FROM information_schema.TABLES
 230   WHERE TABLE_SCHEMA = ?
 231     AND TABLE_NAME = ?
 232 EOSQL
 233
 234     my $sth = $dbh->prepare($sql);
 235     $sth->execute($DB_NAME, $table);
 236     my $rs = $sth->fetchall_arrayref({});
 237     $self->disconnect_db;
 238     if (@$rs == 0) {
 239         return;
 240     }
 241     return 1;
 242 }
 243
 244 sub check_readonly {
 245     my $self = shift;
 246     if ($self->options->{readonly}) {
 247         $self->set_error("readonly mode");
 248         return 1;
 249     }
 250     return;
 251 }
 252
 253 ########## error handling
 254 sub clear_error {
 255     my $self = shift;
 256     $self->{_error} = undef;
 257     $self->{_errorno} = undef;
 258 }
 259
 260 sub set_error {
 261     my ($self, $error, $errorno) = @_;
 262     $self->{_error} = $error;
 263     $self->{_errorno} = $errorno if $errorno;
 264 }
 265 sub set_errorno {
 266     my ($self, $errorno) = @_;
 267     $self->{_errorno} = $errorno;
 268 }
 269
 270 sub last_error {
 271     my ($self, $err) = @_;
 272     $self->{_error} = $err if defined $err;
 273     return $self->{_error};
 274 }
 275
 276 sub last_errorno {
 277     my ($self, $errno) = @_;
 278     $self->{_errorno} = $errno if defined $errno;
 279     return $self->{_errorno};
 280 }
 281
 282 ########## Utility functions
 283 sub calculate_time_range {
 284     my ($self, $params) = @_;
 285
 286     my $date = $params->{date};
 287     my $year = $params->{year};
 288     my $month = $params->{month};
 289     my $day = $params->{day};
 290
 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};
 297
 298     my $until = $params->{until};
 299     my $since = $params->{since};
 300
 301     my $offset_sec = $params->{offset_sec};
 302     my ($dt_since, $dt_until);
 303
 304     my $range_mode = ($years || $months || $days || $weeks || $hours || $minutes);
 305
 306     # check parameters
 307     if ($since) {
 308         if (ref($since) eq 'HASH') {
 309             $dt_since = $since;
 310         }
 311         elsif ($since =~ m/^\d{4}-\d{2}-\d{2}$/) {
 312             $dt_since = DateTime::Format::MySQL->parse_date($since);
 313         }
 314         else {
 315             $dt_since = DateTime::Format::MySQL->parse_datetime($since);
 316         }
 317     }
 318     if ($until) {
 319         if (ref($until) eq 'HASH') {
 320             $dt_until = $until;
 321         }
 322         elsif ($until =~ m/^\d{4}-\d{2}-\d{2}$/) {
 323             $dt_until = DateTime::Format::MySQL->parse_date($until);
 324         }
 325         else {
 326             $dt_until = DateTime::Format::MySQL->parse_datetime($until);
 327         }
 328     }
 329     if ($year) {
 330         $dt_since = DateTime->new(year => $year,
 331                                  month => $month || 1,
 332                                  day => $day || 1);
 333     }
 334     if ($date) {
 335         if ($date eq 'today') {
 336             $dt_since = DateTime->today;
 337         }
 338         else {
 339             $dt_since = DateTime::Format::MySQL->parse_date($date);
 340         }
 341         if (!$range_mode) {
 342             $days = 1;
 343             $range_mode = 1;
 344         }
 345     }
 346
 347     # check time range
 348     if ($range_mode) {
 349         if ($dt_since) {
 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;
 357         }
 358         else {
 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;
 367         }
 368     }
 369     elsif ($year) {
 370         my $term = "year";
 371         $term = "month" if $month;
 372         $term = "day" if $day;
 373
 374         $dt_until = $dt_since->clone;
 375         $dt_until->add("${term}s" => 1);
 376     }
 377
 378     if ($offset_sec) {
 379         $dt_since->add(seconds => -$offset_sec) if $dt_since;
 380         $dt_until->add(seconds => -$offset_sec) if $dt_until;
 381     }
 382
 383     my ($from, $to);
 384     $from = DateTime::Format::MySQL->format_datetime($dt_since) if $dt_since;
 385     $to = DateTime::Format::MySQL->format_datetime($dt_until) if $dt_until;
 386
 387     return ($from, $to);
 388 }
 389
 390
 391 =head2 build_where_clause(unique_keys => $unique_keys,
 392                           keys => $keys,
 393                           timestamps => $timestamps,
 394                           where => $where_params,
 395                           params => \%params,)
 396
 397 build SQL WHERE clause.
 398
 399 =over 4
 400
 401 =item Parameters
 402
 403 =over 4
 404
 405 =item $unique_keys
 406
 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, ... }.
 411
 412 'unique key' is a column name defined with 'UNIQUE' or 'PRIMARY'.
 413
 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.
 416
 417 =back
 418
 419 =item $keys
 420
 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, ... }.
 425
 426 =back
 427
 428 =item \%params
 429
 430 HASHREF to query parameters
 431
 432 =item Return value
 433
 434 when list context, returns ($clause, \@values, $unique).
 435 when scalar context, return hashref like:
 436  { clause => $clause, values => \@values, unique => $unique };
 437
 438 =back
 439
 440 =cut
 441
 442 sub build_where_clause {
 443     my $self = shift;
 444     my $args = {@_};
 445
 446     my $uniques = {};
 447     my $keys = {};
 448     if ($args->{keys} || $args->{unique_keys}) {
 449         $uniques = $args->{unique_keys};
 450         $keys = $args->{keys};
 451     }
 452     else {
 453         $uniques = $self->unique_keys;
 454         $keys = $self->get_keys("non-unique");
 455     }
 456     my $timestamp = $args->{timestamp} || $self->{timestamp};
 457
 458     my $params = $args->{params};
 459     my $where = $args->{where} || $params;
 460
 461     my @clauses;
 462     my @values;
 463
 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");
 468
 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);
 471         if ($or_clause) {
 472             push @clauses, "( $or_clause )";
 473             push @values, @$sub_values;
 474         }
 475     }
 476
 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;
 480
 481     my $clause = "";
 482     if (@clauses != 0) {
 483         $clause = "WHERE " . join(" AND ", @clauses);
 484     }
 485
 486     return wantarray ? ($clause, \@values, $unique)
 487       : { clause => $clause,
 488           values => \@values,
 489           unique => $unique, };
 490 }
 491
 492
 493 ## subfunctions
 494 sub _parse_where_clause {
 495     my ($self, $uniques, $keys, $timestamp, $params) = @_;
 496
 497     my @clauses;
 498     my @values;
 499     my $unique = 0;
 500
 501     # subfunctions
 502     my $decode_param = sub {
 503         my ($k, $v) = @_;
 504
 505         # simply equal clause
 506         if (!ref($v)) {
 507             return ("$k = ?", $v);
 508         }
 509
 510         # multiple items
 511         if (ref($v) eq 'ARRAY') {
 512             my $placeholder = join(", ", map { "?" } @$v);
 513             return ("$k IN ($placeholder)", $v);
 514         }
 515
 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};
 523         }
 524
 525         die "invalid query parameter: $k, $v";
 526     };
 527
 528     # define closure
 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;
 533         if (defined $v) {
 534             if (ref($v) eq 'ARRAY') {
 535                 push @values, @$v;
 536             }
 537             else {
 538                 push @values, $v;
 539                 $unique = 1 if $is_unique;
 540             }
 541         }
 542     };
 543
 544
 545     # reqularize keys to hashref
 546     my $ky = $self->_keys_to_hash($keys);
 547     if ($ky) {
 548         for my $k (keys(%$ky)) {
 549             if (defined $params->{$k}) {
 550                 $decode_and_set_params->($ky->{$k}, $params->{$k});
 551             }
 552         }
 553     }
 554     # reqularize uniques to hashref
 555     my $u = $self->_keys_to_hash($uniques);
 556     if ($u) {
 557         for my $k (keys(%$u)) {
 558             if (defined $params->{$k}) {
 559                 $decode_and_set_params->($u->{$k}, $params->{$k}, 1);
 560             }
 561         }
 562     }
 563
 564     # year, month, day, years, months, days, date
 565     if ($timestamp) {
 566         my ($begin, $end) = $self->calculate_time_range($params);
 567         if ($begin) {
 568             push @clauses, "$timestamp >= ?";
 569             push @values, $begin;
 570         }
 571         if ($end) {
 572             push @clauses, "$timestamp < ?";
 573             push @values, $end;
 574         }
 575     }
 576
 577     return (\@clauses, \@values, $unique);
 578 }
 579
 580 # reqularize keys to hashref
 581 sub _keys_to_hash {
 582     my ($self, $keys) = @_;
 583     return if !defined $keys;
 584
 585     my $ky;
 586     if(ref($keys) eq 'HASH') {
 587         $ky = $keys;
 588     }
 589     elsif (ref($keys) eq 'ARRAY') {
 590         $ky = {};
 591         for my $k (@$keys) {
 592             $ky->{$k} = $k;
 593         }
 594     }
 595     elsif (!ref($keys)) {
 596         $ky = { $keys => $keys };
 597     }
 598     return $ky;
 599 }
 600
 601 =head2 build_limit_clause(params => \@params)
 602
 603 build SQL's LIMIT clause.
 604
 605 =over 4
 606
 607 =item Parameters
 608
 609 =over 4
 610
 611 =item \@params
 612
 613 HASHREF to query parameters
 614
 615 =item Return value
 616
 617 when list context, returns ($clause, \@values).
 618 when scalar context, return hashref like:
 619  { clause => $clause, values => \@values };
 620
 621 =back
 622
 623 =cut
 624
 625 sub build_limit_clause {
 626     my $self = shift;
 627     my $args = {@_};
 628
 629     my $params = $args->{params};
 630     my $limit = $args->{default};
 631     my $offset = $args->{default_offset};
 632
 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};
 636
 637     my @clauses;
 638     my @values;
 639     if (defined $limit) {
 640         push @clauses, "LIMIT ?";
 641         push @values, $limit;
 642     }
 643     if (defined $offset) {
 644         push @clauses, "OFFSET ?";
 645         push @values, $offset;
 646     }
 647
 648     my $clause = join(" ", @clauses);
 649
 650     return wantarray ? ($clause, \@values)
 651       : { clause => $clause, values => \@values };
 652 }
 653
 654 =head2 build_order_by_clause(keys => $keys, params => \@params)
 655
 656 build SQL ORDER BY clause.
 657
 658 =over 4
 659
 660 =item Parameters
 661
 662 =over 4
 663
 664 =item $keys
 665
 666 ARRAYREF or HASHREF.
 667 If ARRAREF, @$keys contains selectSable columns.
 668 If HASHREF, %$keys is { key1 => alias1, key2 => alias2, ... }.
 669
 670 =item \@params
 671
 672 HASHREF to query parameters
 673
 674 =item Return value
 675
 676 when list context, returns ($clause, \@values).
 677 when scalar context, return hashref like:
 678  { clause => $clause, values => \@values };
 679
 680 =back
 681
 682 =cut
 683
 684 sub build_order_by_clause {
 685     my $self = shift;
 686     my $args = {@_};
 687
 688     my $unique_keys = $args->{unique_keys} || $self->unique_keys;
 689     my $keys = $args->{keys} || $self->get_keys("all");
 690
 691     my $params = $args->{params};
 692     my $order_by = $params->{order_by};
 693
 694     if (!$keys || !$params || !$order_by) {
 695         return wantarray ? ("", [])
 696           : { clause => "", values => [] };
 697     }
 698
 699     my @clauses;
 700     my @values;
 701
 702     my $k_names;
 703     my $use_alias = 0;
 704     # convert $keys to hash style
 705     if (ref($keys) eq 'HASH') {
 706         $k_names = [keys %$keys];
 707         $use_alias = 1;
 708     }
 709     if (ref($keys) eq 'ARRAY') {
 710         $k_names = $keys;
 711     }
 712     elsif (!ref($keys)) {
 713         $k_names = [$keys];
 714     }
 715
 716     # "ORDER BY" clause has order, so
 717     # use list
 718
 719     # if hash style, convert to array
 720     my $orders = [];
 721     my $cols = [];
 722     if (ref($order_by) eq "HASH") {
 723         for my $k (keys %$order_by) {
 724             push @$cols, $k;
 725             push @$orders, $order_by->{$k};
 726         }
 727     }
 728     elsif (!ref($order_by) && defined($order_by)) {
 729             push @$cols, $order_by;
 730             push @$orders, "ASC";
 731     }
 732     elsif (ref($order_by) eq "ARRAY") {
 733         my $is_key = 1;
 734         # check hashed parameter
 735         for my $item (@$order_by) {
 736             if (ref($item) eq "HASH") {
 737                 for my $k (keys %$item) {
 738                     push @$cols, $k;
 739                     push @$orders, $item->{$k};
 740                 }
 741             }
 742             else {
 743                 if ($is_key) {
 744                     push @$cols, $item;
 745                     $is_key = 0;
 746                 }
 747                 else {
 748                     push @$orders, $item;
 749                     $is_key = 1;
 750                 }
 751             }
 752         }
 753         # fallback for compatibility
 754         if ($is_key == 0) {
 755             push @$orders, "ASC";
 756         }
 757     }
 758
 759     # when $order_by is not ARRAY or SCALAR or HASH,
 760     # this block is passed.
 761     if (@$cols) {
 762         for my $k (@$cols) {
 763             next if !any {$_ eq $k} @$k_names;
 764
 765             my $order = shift @$orders;
 766             if ($use_alias && $keys->{$k}) {
 767                 $k = $keys->{$k};
 768             }
 769             push @clauses, "$k $order" if $k;
 770         }
 771     }
 772
 773     my $clause = "";
 774     if (@clauses) {
 775         $clause = "ORDER BY " . join(", ", @clauses);
 776     }
 777
 778     return wantarray ? ($clause, \@values)
 779       : { clause => $clause, values => \@values };
 780 }
 781
 782 ########## Insert method
 783
 784 sub generic_insert {
 785     my $self = shift;
 786     return if $self->check_readonly;
 787     my $args = {@_};
 788
 789     my $table = $args->{table} || $self->primary_table;
 790     if (!$table) {
 791         $self->set_error("table not given", -1);
 792         return;
 793     }
 794
 795     my $keys;
 796     if ($args->{keys}) {
 797         $keys = $self->_build_keys($args->{keys});
 798     }
 799     else {
 800         $keys = $self->get_keys("all");
 801     }
 802
 803     my $params = $args->{params};
 804     if (!$params) {
 805         $self->set_error("params not given", -1);
 806         return;
 807     };
 808
 809     my @cols;
 810     my @values;
 811     my @placeholders;
 812
 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, "?";
 820         }
 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};
 826                 }
 827             }
 828         }
 829     }
 830
 831     if (!@cols || !@values) {
 832         $self->set_error("no valid values", -1);
 833         return;
 834     }
 835
 836     my $cols_clause = join(", ", @cols);
 837     my $values_clause = join(", ", @placeholders);
 838
 839
 840     my $sql = "INSERT INTO $table ($cols_clause) VALUES ($values_clause)";
 841     $self->_last_query($sql, \@values);
 842
 843     #warn $sql;
 844     #warn Dumper @values;
 845
 846     my $dbh = $self->connect_db;
 847     my $rs = $dbh->do($sql, undef, @values);
 848     if ($rs) {
 849         $rs = $dbh->last_insert_id(undef, undef, undef, undef);
 850     }
 851     $self->disconnect_db;
 852     return $rs;
 853
 854 }
 855
 856
 857 ########## Select method
 858
 859 =head2 generic_select(table => $table, uniques => $uniques, keys => $keys, params => $params)
 860
 861 build SQL's ORDER BY clause.
 862
 863 =over 4
 864
 865 =item Parameters
 866
 867 =over 4
 868
 869 =item $table
 870
 871 table name
 872
 873 =item $uniques
 874
 875 ARRAYREF to unique keys. 'unique key' is a column name
 876 defined with 'UNIQUE' or 'PRIMARY'.
 877
 878 =back
 879
 880 =item $keys
 881
 882 ARRAYREF to acceptable keys (column names)
 883
 884 =back
 885
 886 =item $params
 887
 888 HASHREF to query parameters
 889
 890 =item Return value
 891
 892 when list context, returns ($clause, \@values).
 893 when scalar context, return hashref like:
 894  { clause => $clause, values => \@values };
 895
 896 =back
 897
 898 =cut
 899
 900 sub generic_select {
 901     my $self = shift;
 902     my $args = {@_};
 903     my $table = $args->{table} || $self->primary_table;
 904     if (!$table) {
 905         $self->set_error("table no given");
 906         return;
 907     }
 908     my $params = $args->{params} || {};
 909
 910     if ($args->{uniques}) {
 911         warn "Cowrapper::generic_select(): 'uniques' parameter is deprecated. use 'unique_keys'.";
 912         $args->{unique_keys} ||= $args->{uniques};
 913     }
 914     my $uniques = $args->{unique_keys};
 915     my $keys = $args->{keys};
 916     my $timestamp = $args->{timestamp};
 917
 918     my @arguments;
 919     my ($values, $orderby, $limit, $where, $unique_query);
 920
 921     ($where, $values, $unique_query) = $self->build_where_clause(unique_keys => $uniques,
 922                                                                  keys => $keys,
 923                                                                  timestamp => $timestamp,
 924                                                                  params => $params);
 925     push @arguments, @$values if @$values;
 926
 927     ($orderby, $values) = $self->build_order_by_clause(keys => $keys, params => $params);
 928     push @arguments, @$values if @$values;
 929
 930     ($limit, $values) = $self->build_limit_clause(params => $params);
 931     push @arguments, @$values if @$values;
 932
 933     my $dbh = $self->connect_db;
 934     my $generic_sql = <<"EOSQL";
 935 SELECT * FROM $table
 936   $where
 937   $orderby
 938   $limit
 939 EOSQL
 940
 941     my $sql = $args->{sql} || $generic_sql;
 942     $self->_last_query($sql, \@arguments);
 943
 944     my $sth = $dbh->prepare($sql);
 945     $sth->execute(@arguments);
 946     my $rs = $sth->fetchall_arrayref(+{});
 947     if (!defined $rs) {
 948         $self->set_error("select failed", $dbh->errstr, $dbh->err);
 949         $self->disconnect_db;
 950         return;
 951     }
 952     $self->disconnect_db;
 953
 954     if ($unique_query) {
 955         $self->clear_error;
 956         return $rs->[0] if @$rs;
 957         return;
 958     }
 959     return $rs;
 960 }
 961
 962 ########## Count method
 963
 964 =head2 generic_count(
 965  table => $table,
 966  target => $target_column,
 967  timestamp => $timestamp_column,
 968  year => $year,
 969  month => $month,
 970  day => $day,
 971  offset_sec => $offset_sec,
 972  join => $join_clause,
 973  where => $where_clause)
 974
 975 count items
 976
 977 =over 4
 978
 979 =item Parameters
 980
 981 =over 4
 982
 983 =item $table
 984
 985 table name
 986
 987 =item $target_column
 988
 989 count target column
 990
 991 =item $timestamp_column
 992
 993 timestamp column
 994
 995 =item $year
 996
 997 target year
 998
 999 =item $month
1000
1001 target month (omissible)
1002
1003 =item $day
1004
1005 target day (omissible)
1006
1007 =item $whare_clause
1008
1009 additional WHERE clause (must not include 'WHERE' !; omissible)
1010
1011 =item $join_clause
1012
1013 additional JOIN clause (must include 'JOIN' !; omissible)
1014
1015 =item Return value
1016
1017 count of items
1018
1019 =back
1020
1021 =cut
1022
1023 sub generic_count {
1024     my $self = shift;
1025     my $params = {@_};
1026
1027     my $table = $params->{table} || $self->primary_table;
1028     my $target = $params->{target};
1029     my $timestamp = $params->{timestamp} || $self->timestamp;
1030
1031     return if (!$table || !$target || !$timestamp || !$params->{year});
1032
1033     my $term = "day";
1034     $term = "month" if !$params->{day};
1035     $term = "year" if !$params->{month};
1036
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])$/);
1041
1042     my $offset = $params->{offset_sec} || 0;
1043     $offset = 0 if $offset !~ m/^[+-]?[0-9]+$/;
1044
1045     my $dt = DateTime->new(year => $year,
1046                            month => $month,
1047                            day => $day);
1048     $dt->add(seconds => -$offset);
1049     my $dt_string = DateTime::Format::MySQL->format_datetime($dt);
1050
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,
1055                                month => $month,
1056                                day => $day);
1057     if ($term eq "month") {
1058         $dt_end->add(months => 1);
1059     }
1060     elsif ($term eq "year") {
1061         $dt_end->add(years => 1);
1062     }
1063     $dt->add(seconds => -$offset);
1064     my $dt_end_string = DateTime::Format::MySQL->format_datetime($dt_end);
1065
1066     # build SQL
1067     my $sql;
1068     my $where_clause = "";
1069     if ($params->{where}) {
1070         $where_clause = "$params->{where} AND \n";
1071     }
1072     my $join_clause = $params->{join} || "";
1073
1074
1075     my @attrs;
1076     if ($term eq "day") {
1077         # `stories` table not contain display/non-display flag,
1078         # so use firehose.
1079         $sql = <<"EOSQL";
1080 SELECT COUNT($table.$target) AS count FROM $table
1081     $join_clause
1082   WHERE $where_clause
1083         $table.$timestamp >= ?
1084     AND $table.$timestamp < DATE_ADD(?, INTERVAL 1 DAY)
1085 EOSQL
1086         push @attrs, $dt_string, $dt_string;
1087     }
1088     elsif ($term eq "month") {
1089         $sql = <<"EOSQL";
1090 SELECT TIMESTAMPDIFF(DAY, ?, $table.$timestamp) AS day,
1091        COUNT($table.$target) AS count
1092   FROM $table
1093     $join_clause
1094   WHERE $where_clause
1095         $table.$timestamp >= ?
1096     AND $table.$timestamp < ?
1097   GROUP BY TIMESTAMPDIFF(DAY, ?, $table.$timestamp)
1098   ORDER BY day ASC
1099 EOSQL
1100         push @attrs, $dt_string, $dt_string, $dt_end_string, $dt_string;
1101     }
1102     elsif ($term eq "year") {
1103         $sql = <<"EOSQL";
1104 SELECT TIMESTAMPDIFF(MONTH, ?, $table.$timestamp) AS month,
1105        COUNT($table.$target) AS count
1106   FROM $table
1107     $join_clause
1108   WHERE $where_clause
1109         $table.$timestamp >= ?
1110     AND $table.$timestamp < ?
1111   GROUP BY TIMESTAMPDIFF(MONTH, ?, $table.$timestamp)
1112   ORDER BY month ASC
1113 EOSQL
1114         push @attrs, $dt_string, $dt_string, $dt_end_string, $dt_string;
1115     }
1116     my $dbh = $self->connect_db;
1117     my $sth = $dbh->prepare($sql);
1118
1119     $self->_last_query($sql, \@attrs);
1120     $sth->execute(@attrs);
1121     my $rs = $sth->fetchall_arrayref({});
1122
1123     if (!$rs) {
1124         $self->disconnect_db;
1125         return;
1126     }
1127     $self->disconnect_db;
1128
1129     my $hash = {};
1130     my $key;
1131     if ($term eq "day") {
1132         return $rs->[0]->{count};
1133     }
1134     elsif ($term eq "month") {
1135         $key = "day";
1136     }
1137     elsif ($term eq "year") {
1138         $key = "month";
1139     }
1140     else {
1141         return;
1142     }
1143
1144     for my $counts (@$rs) {
1145         # day / month is differential from base datetime, so add 1
1146         $hash->{$counts->{$key} + 1} = $counts->{count};
1147     }
1148     return $hash;
1149 }
1150
1151 sub generic_count2 {
1152     my $self = shift;
1153     my $args = {@_};
1154     my $table = $args->{table} || $self->primary_table;
1155     if (!$table) {
1156         $self->set_error("table no given");
1157         return;
1158     }
1159     my $params = $args->{params} || {};
1160
1161     if ($args->{uniques}) {
1162         warn "Cowrapper::generic_select(): 'uniques' parameter is deprecated. use 'unique_keys'.";
1163         $args->{unique_keys} ||= $args->{uniques};
1164     }
1165     my $uniques = $args->{unique_keys};
1166     my $keys = $args->{keys};
1167     my $timestamp = $args->{timestamp};
1168
1169     my @arguments;
1170     my ($values, $orderby, $limit, $where, $unique_query);
1171
1172     ($where, $values, $unique_query) = $self->build_where_clause(unique_keys => $uniques,
1173                                                                  keys => $keys,
1174                                                                  timestamp => $timestamp,
1175                                                                  params => $params);
1176     push @arguments, @$values if @$values;
1177
1178     my $target_key = $self->primary_key || "";
1179     if ($target_key) {
1180         $target_key = "*.$target_key";
1181     }
1182     else {
1183         $target_key = "*";
1184     }
1185
1186     my $dbh = $self->connect_db;
1187     my $generic_sql = <<"EOSQL";
1188 SELECT COUNT($target_key) AS count FROM $table
1189   $where
1190 EOSQL
1191
1192     my $sql = $args->{sql} || $generic_sql;
1193     $self->_last_query($sql, \@arguments);
1194
1195     my $sth = $dbh->prepare($sql);
1196     $sth->execute(@arguments);
1197     my $rs = $sth->fetchall_arrayref(+{});
1198     if (!defined $rs) {
1199         $self->set_error("select failed", $dbh->errstr, $dbh->err);
1200         $self->disconnect_db;
1201         return;
1202     }
1203     $self->disconnect_db;
1204
1205     if ($unique_query) {
1206         $self->clear_error;
1207         return $rs->[0] if @$rs;
1208         return;
1209     }
1210     return $rs;
1211 }
1212
1213
1214
1215 ########## Update method
1216
1217 =head2 generic_update(table => $table,
1218                       updatable_keys => $updatables,
1219                       addable_keys => $addables,
1220                       condition_keys => $conditions,
1221                       params => $params)
1222
1223 execute UPDATE SQL command.
1224
1225 =over 4
1226
1227 =item Parameters
1228
1229 =over 4
1230
1231 =item $table
1232
1233 table name
1234
1235 =item $updatables
1236
1237 ARRAYREF or HASHREF to updatable keys. 'updatable key' is a updatable column name.
1238
1239 =item $addables
1240
1241 ARRAYREF or HASHREF to addable keys. 'addable key' is a addable column name.
1242
1243 =item $conditions
1244
1245 ARRAYREF or HASHREF to conditional keys. 'conditional key' is a column name which can use in WHERE clause.
1246
1247 =item $params
1248
1249 HASHREF to query parameters
1250
1251 =item Return value
1252
1253 when list context, returns ($clause, \@values).
1254 when scalar context, return hashref like:
1255  { clause => $clause, values => \@values };
1256
1257 =back
1258
1259 =cut
1260
1261 sub generic_update {
1262     my $self = shift;
1263     return if $self->check_readonly;
1264     my $args = {@_};
1265     return if !%$args;
1266
1267     my $table = $args->{table} || $self->primary_table;
1268     if (!$table) {
1269         $self->set_error("table given", -1);
1270         return;
1271     }
1272
1273     my $updatables = $args->{updatable_keys} || $self->get_keys("updatable");
1274     my $addables = $args->{addable_keys} || $self->get_keys("addable");
1275
1276     my $conditions = $args->{condition_keys};
1277     my $params = $args->{params} || {};
1278     my $where = $args->{where} || $params->{where};
1279
1280     if ($where) {
1281         $conditions = $args->{condition_keys} || $self->get_keys("all");
1282     }
1283     else {
1284         $conditions = $args->{condition_keys} || $self->get_keys("primary");
1285     }
1286
1287     if (!$conditions || !%$conditions) {
1288         $self->set_error("no_condition_keys", -1);
1289         return;
1290     }
1291     my $u_hash = $self->_keys_to_hash($updatables);
1292     #my $a_hash = $self->_keys_to_hash($addables);
1293
1294     # first, create WHERE clause
1295     my ($where_clause, $where_values) = $self->build_where_clause(keys => $conditions,
1296                                                                   params => $params,
1297                                                                   where => $where);
1298     if (!$where_clause) {
1299         $self->set_error("no_where_clauses", -1);
1300         return;
1301     }
1302
1303     # build SET clause
1304     my @set_clauses;
1305     my @values;
1306
1307     for my $col (keys %$u_hash) {
1308         next if !defined $params->{$col};
1309         my $c = $u_hash->{$col};
1310
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 = ?";
1315         }
1316         # if $params->{$col} is HASH, do given operation
1317         elsif (ref($params->{$col}) eq 'HASH') {
1318             # key to lc
1319             my $p = {};
1320             for my $k (keys %{$params->{$col}}) {
1321                 $p->{lc($k)} = $params->{$col}->{$k};
1322             }
1323             if ($p->{add}) {
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 + ?))";
1329                 }
1330                 elsif (defined $p->{max}) {
1331                     push @values, $p->{min};
1332                     push @values, $p->{add};
1333                     push @set_clauses, "$c = GREATEST(?, $c + ?)";
1334                 }
1335                 elsif (defined $p->{min}) {
1336                     push @values, $p->{min};
1337                     push @values, $p->{add};
1338                     push @set_clauses, "$c = LEAST(?, $c + ?)";
1339                 }
1340                 else {
1341                     push @values, $p->{add};
1342                     push @set_clauses, "$c = $c + ?";
1343                 }
1344             }
1345             if ($p->{function}) {
1346                 push @set_clauses, "$c = ($p->{function})";
1347             }
1348         }
1349     }
1350
1351     return 0 if !@set_clauses;
1352     my $set_clause = join(", ", @set_clauses);
1353
1354     my $sql = "UPDATE $table SET $set_clause $where_clause";
1355     push @values, @$where_values;
1356     $self->_last_query($sql, \@values);
1357
1358     #warn $sql;
1359     #warn Dumper @values;
1360
1361     my $dbh = $self->connect_db;
1362     my $rs = $dbh->do($sql, undef, @values);
1363     $self->disconnect_db;
1364     return $rs;
1365
1366 }
1367
1368 ########## count helper
1369
1370 sub build_interval_times {
1371     my $self = shift;
1372     my $attr = {@_};
1373     my $params = $attr->{params} || {};
1374
1375     my $target = "day";
1376     return if !$params->{year};
1377     $target = "month" if !$params->{day};
1378     $target = "year" if !$params->{month};
1379
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])$/);
1384
1385     my $offset = $params->{offset_sec} || 0;
1386     $offset = 0 if $offset !~ m/^[+-]?[0-9]+$/;
1387
1388     my $dt = DateTime->new(year => $year,
1389                              month => $month,
1390                              day => $day);
1391     $dt->add(seconds => -$offset);
1392     my $dt_string = DateTime::Format::MySQL->format_datetime($dt);
1393
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,
1397                                month => $month,
1398                                day => $day);
1399     if ($target eq "month") {
1400         $dt_end->add(months => 1);
1401     }
1402     elsif ($target eq "year") {
1403         $dt_end->add(years => 1);
1404     }
1405     $dt->add(seconds => -$offset);
1406     my $dt_end_string = DateTime::Format::MySQL->format_datetime($dt_end);
1407
1408     return wantarray ? ($target, $dt_string, $dt_end_string)
1409       : { target => $target,
1410           start => $dt_string,
1411           end => $dt_end_string };
1412 }
1413
1414
1415 ########## Delete method
1416
1417 =head2 generic_delete(table => $table, uniques => $uniques, keys => $keys, params => $params)
1418
1419 DELETE item from table
1420
1421 =over 4
1422
1423 =item Parameters
1424
1425 =over 4
1426
1427 =item $table
1428
1429 table name
1430
1431 =item $uniques
1432
1433 ARRAYREF to unique keys. 'unique key' is a column name
1434 defined with 'UNIQUE' or 'PRIMARY'.
1435
1436 =back
1437
1438 =item $keys
1439
1440 ARRAYREF to acceptable keys (column names)
1441
1442 =back
1443
1444 =item $params
1445
1446 HASHREF to query parameters
1447
1448 =item Return value
1449
1450 when list context, returns ($clause, \@values).
1451 when scalar context, return hashref like:
1452  { clause => $clause, values => \@values };
1453
1454 =back
1455
1456 =cut
1457
1458 sub generic_delete {
1459     my $self = shift;
1460     my $args = {@_};
1461     my $table = $args->{table} || $self->primary_table;
1462     if (!$table) {
1463         $self->set_error("table no given");
1464         return;
1465     }
1466     my $params = $args->{params} || {};
1467
1468     if ($args->{uniques}) {
1469         warn "Cowrapper::generic_select(): 'uniques' parameter is deprecated. use 'unique_keys'.";
1470         $args->{unique_keys} ||= $args->{uniques};
1471     }
1472     my $uniques = $args->{unique_keys};
1473     my $keys = $args->{keys};
1474     my $timestamp = $args->{timestamp};
1475
1476     my @arguments;
1477     my ($values, $orderby, $limit, $where, $unique_query);
1478
1479     ($where, $values, $unique_query) = $self->build_where_clause(unique_keys => $uniques,
1480                                                                  keys => $keys,
1481                                                                  timestamp => $timestamp,
1482                                                                  params => $params);
1483     push @arguments, @$values if @$values;
1484
1485     my $dbh = $self->connect_db;
1486     my $generic_sql = <<"EOSQL";
1487 DELETE FROM $table
1488   $where
1489 EOSQL
1490
1491     my $sql = $args->{sql} || $generic_sql;
1492     $self->_last_query($sql, \@arguments);
1493
1494     my $rs = $dbh->do($sql, undef, @arguments);
1495     if (!defined $rs) {
1496         $self->set_error("delete_failed", $dbh->errstr, $dbh->err);
1497         $self->disconnect_db;
1498         return;
1499     }
1500     $self->disconnect_db;
1501
1502     return $rs;
1503 }
1504
1505 ######### data export / import functions
1506
1507 =head2 export_json()
1508
1509 export as json data.
1510
1511 $obj->export_json(file => "foobar.json",
1512                   table => "foo",
1513                   exclude => [qw(foo bar)],
1514                   sort_key => [qw(hoge moge)],
1515                  );
1516
1517 =over 4
1518
1519 =item Parameters
1520
1521 =over 4
1522
1523 =back
1524
1525 =back
1526
1527 =cut
1528
1529 sub export_json {
1530     my $self = shift;
1531     my $params = {@_};
1532
1533     my $table = $params->{table};
1534     return if !$table;
1535
1536     my $keys = $params->{sort_key} || [];
1537     if (!ref($keys)) {
1538         $keys = [$keys];
1539     }
1540
1541     my $query_params = {};
1542     if ($params->{sort_key}) {
1543         $query_params->{order_by} = $keys;
1544     }
1545
1546     my $datas = $self->generic_select(table => $table, keys => $keys, params => $query_params);
1547     return if !$datas;
1548
1549     my $exclude = $params->{exclude} || [];
1550     if (!ref($exclude)) {
1551         $exclude = [$exclude];
1552     }
1553
1554     for my $data (@$datas) {
1555         for my $k (@$exclude) {
1556             delete $data->{$k};
1557         }
1558     }
1559
1560     #warn Dumper($datas);
1561
1562     my $j = JSON->new;
1563     $j->indent(1);
1564     $j->space_after(1);
1565     $j->canonical(1);
1566     if ($params->{file}) {
1567         my $bin_data = $j->utf8->encode($datas);
1568         my $fh = FileHandle->new($params->{file}, "w");
1569         if (!defined $fh) {
1570             $self->set_error($!);
1571             return;
1572         }
1573         $fh->print($bin_data);
1574         $fh->close;
1575         return 1;
1576     }
1577     return JSON::to_json($datas);
1578 }
1579
1580 =head2 import_json()
1581
1582 export as json data.
1583
1584 $obj->export_json(file => "foobar.json",
1585                   table => "foo",
1586                   exclude => [qw(foo bar)],
1587                   unique_key => "id",
1588                  );
1589
1590 $obj->export_json(json => '{ "foo": "bar", "hoge": 1 }',
1591                   table => "foo",
1592                   exclude => [qw(foo bar)],
1593                   unique_key => "id",
1594                  );
1595
1596 =over 4
1597
1598 =item Parameters
1599
1600 =over 4
1601
1602 =back
1603
1604 =back
1605
1606 =cut
1607
1608 sub import_json {
1609     my $self = shift;
1610     my $params = {@_};
1611
1612     my $table = $params->{table};
1613     return if !$table;
1614
1615     if ($params->{json} && $params->{file}) {
1616         return;
1617     }
1618
1619     my $datas;
1620     if ($params->{file}) {
1621         my $fh = FileHandle->new($params->{file}, "r");
1622         if (!defined $fh) {
1623             $self->set_error($!);
1624             return;
1625         }
1626         my $json = do { local $/; <$fh> };
1627         $fh->close;
1628         $datas = JSON::decode_json($json);
1629     }
1630     if ($params->{json}) {
1631         $datas = JSON::from_json($params->{json});
1632     }
1633
1634     return if !$datas;
1635     return if ref($datas) ne "ARRAY";
1636
1637     my $primary_key = $params->{unique_key};
1638     my $exclude = $params->{exclude} || [];
1639     if (!ref($exclude)) {
1640         $exclude = [$exclude];
1641     }
1642     # insert data
1643     my $dbh = $self->start_transaction;
1644     my $updated = 0;
1645     for my $data (@$datas) {
1646         for my $k (@$exclude) {
1647             delete $data->{$k};
1648         }
1649         my @cols;
1650         my @plhs;
1651         my @vals;
1652         my @updates;
1653         my @update_vals;
1654         for my $k (keys(%$data)) {
1655             #my $quoted_k = '`' . $k . '`';
1656             my $quoted_k = $dbh->quote_identifier($k);
1657             push @cols, $quoted_k;
1658             push @plhs, '?';
1659             push @vals, $data->{$k};
1660             if ($k ne $primary_key) {
1661                 push @updates, "$quoted_k = ?";
1662                 push @update_vals, $data->{$k};
1663             }
1664         }
1665         my $cols_clause = join(", ", @cols);
1666         my $placeholders = join(", ", @plhs);
1667         my $update_clauses = join(", ", @updates);
1668
1669         my $sql = <<"EOSQL";
1670 INSERT INTO $table
1671     ($cols_clause)
1672   VALUES
1673     ($placeholders)
1674   ON DUPLICATE KEY UPDATE
1675     $update_clauses
1676 EOSQL
1677         push @vals, @update_vals;
1678         $self->_last_query($sql, \@vals);
1679         #warn $sql;
1680         my $rs = $dbh->do($sql, undef, @vals);
1681         if (!defined $rs) {
1682             $self->rollback;
1683             return;
1684         }
1685         $updated += $rs;
1686     }
1687     $self->commit;
1688     return $updated;
1689 }
1690
1691 ########## virtual method for O/R mapping function
1692 sub key_definition { return {}; }
1693
1694 sub _build_keys {
1695     my ($self, $target) = @_;
1696     return {} if !$target;
1697     return $target if ref($target) eq "HASH";
1698     if (!ref($target)) {
1699         $target = [$target];
1700     }
1701
1702     my $def = $self->key_definition || {};
1703     my $basename = "";
1704     if ($def->{basename}) {
1705         $basename = "$def->{basename}.";
1706     }
1707     elsif ($def->{table}) {
1708         $basename = "$def->{table}.";
1709     }
1710
1711     my $rs = {};
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+/) {
1717                     $rs->{$k} = "$uk";
1718                 }
1719                 else {
1720                     $rs->{$k} = "$basename$uk";
1721                 }
1722             }
1723         }
1724     }
1725
1726     return $rs;
1727 }
1728
1729 sub primary_table {
1730     my $self = shift;
1731     my $def = $self->key_definition || {};
1732     return $def->{table};
1733 }
1734
1735 sub primary_key {
1736     my $self = shift;
1737     my $def = $self->key_definition || {};
1738     return $self->_build_keys($def->{primary});
1739 }
1740
1741 sub timestamp_key {
1742     my $self = shift;
1743     my $def = $self->key_definition || {};
1744     return $self->_build_keys($def->{timestamp});
1745 }
1746
1747 sub datetime_keys {
1748     my $self = shift;
1749     my $def = $self->key_definition || {};
1750     return $self->_build_keys($def->{datetime});
1751 }
1752
1753 sub other_keys {
1754     my $self = shift;
1755     my $def = $self->key_definition || {};
1756     return $self->_build_keys($def->{other});
1757 }
1758
1759 sub unique_keys {
1760     my $self = shift;
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);
1765 }
1766
1767 sub addable_keys {
1768     my $self = shift;
1769     my $def = $self->key_definition || {};
1770     return $self->_build_keys($def->{addable});
1771 }
1772
1773 sub get_keys {
1774     my $self = shift;
1775     my @keys;
1776     my $def = $self->key_definition || {};
1777     while (@_) {
1778         my $target = shift;
1779         if (defined $def->{$target}) {
1780             push @keys, @{_to_array($def->{$target})};
1781         }
1782         elsif ($target eq "all") {
1783             push @keys, $def->{primary} if $def->{primary};
1784             push @keys,
1785               @{_to_array($def->{unique})},
1786               @{_to_array($def->{datetime})},
1787               @{_to_array($def->{addable})},
1788               @{_to_array($def->{other})};
1789         }
1790         elsif ($target eq "non-unique") {
1791             push @keys,
1792               @{_to_array($def->{datetime})},
1793               @{_to_array($def->{addable})},
1794               @{_to_array($def->{other})};
1795         }
1796         elsif ($target eq "updatable") {
1797             push @keys,
1798               @{_to_array($def->{unique})},
1799               @{_to_array($def->{datetime})},
1800               @{_to_array($def->{addable})},
1801               @{_to_array($def->{other})};
1802         }
1803     }
1804     return $self->_build_keys(\@keys) if @keys;
1805     return;
1806 }
1807
1808 sub _to_array {
1809     my $item = shift;
1810     return [] if !defined $item;
1811     return $item if (ref($item) eq 'ARRAY');
1812     return [$item] if !ref($item);
1813 }
1814
1815 sub _merge_keys {
1816     my $self = shift;
1817     my $rs = {};
1818
1819     while(@_) {
1820         my $keys = shift;
1821         next if !defined $keys;
1822         if (ref($keys) eq 'ARRAY') {
1823             for my $k (@$keys) {
1824                 $rs->{$k} = $k;
1825             }
1826         }
1827         elsif (ref($keys) eq 'HASH') {
1828             for my $k (keys %$keys) {
1829                 $rs->{$k} = $keys->{$k};
1830             }
1831         }
1832         elsif (!ref($keys)) {
1833             $rs->{$keys} = $keys;
1834         }
1835     }
1836
1837     return $rs;
1838 }
1839
1840 ########## END OF FILE
1841 1;