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