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