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

   1 package Newslash::Model::Base;
   2
   3 use strict;
   4 use warnings;
   5 use utf8;
   6 use feature ':5.10';
   7
   8 use DBI;
   9 use Redis;
  10
  11
  12 use Data::Dumper;
  13
  14 sub import {
  15     my $class = shift;
  16     return unless my $flag = shift;
  17
  18     if ($flag eq '-base') {
  19         $flag = $class;
  20     } elsif ($flag eq '-strict') {
  21         $flag = undef;
  22     }
  23
  24     if ($flag) {
  25         my $caller = caller;
  26         no strict 'refs';
  27         push @{"${caller}::ISA"}, $flag;
  28     }
  29
  30     $_->import for qw(strict warings utf8);
  31     feature->import(':5.10');
  32 }
  33
  34 sub on_start_up {
  35     return 1;
  36 }
  37
  38 sub table_exists {
  39     my ($self, $table) = @_;
  40
  41     my $dbh = $self->connect_db;
  42     my $DB_NAME = $self->{options}->{Database}->{name};
  43
  44     my $sql = <<"EOSQL";
  45 SELECT * FROM information_schema.TABLES
  46   WHERE TABLE_SCHEMA = ?
  47     AND TABLE_NAME = ?
  48 EOSQL
  49     my $sth = $dbh->prepare($sql);
  50     $sth->execute($DB_NAME, $table);
  51     my $rs = $sth->fetchall_arrayref({});
  52     $dbh->disconnect;
  53     if (@$rs == 0) {
  54         return;
  55     }
  56     return 1;
  57 }
  58
  59 sub new {
  60   my ($class, $options) = @_;
  61   bless {options => $options, _error => undef}, $class;
  62 }
  63
  64 sub set_error {
  65     my ($self, $error, $errorno) =@_;
  66     $self->{_error} = $error;
  67     $self->{_errorno} = $errorno if $errorno;
  68 }
  69 sub set_errorno {
  70     my ($self, $errorno) =@_;
  71     $self->{_errorno} = $errorno;
  72 }
  73
  74 sub last_error {
  75     my $self = shift;
  76     return $self->{_error};
  77 }
  78
  79 sub last_errorno {
  80     my $self = shift;
  81     return $self->{_errorno};
  82 }
  83
  84 sub connect_db {
  85     my $self = shift;
  86     my $options = shift || {};
  87
  88     my $DB_HOST = $self->{options}->{Database}->{host};
  89     my $DB_NAME = $self->{options}->{Database}->{name};
  90     my $DB_USER = $self->{options}->{Database}->{user};
  91     my $DB_PASSWORD = $self->{options}->{Database}->{password};
  92
  93     my $settings = 'mysql_read_default_group=libmysqlclient;mysql_read_default_file=/etc/mysql/my.cnf';
  94     my $attr = {
  95                 mysql_enable_utf8 => 1,
  96                 ShowErrorStatement => 1,
  97                 Callbacks => { # hack to use utf8mb4. see http://d.hatena.ne.jp/hirose31/20141028/1414496347
  98                               connected => sub {
  99                                   shift->do('SET NAMES utf8mb4');
 100                                   return;
 101                               }
 102                              },
 103                 %$options,
 104                };
 105
 106     my $dbh = DBI->connect("DBI:mysql:$DB_NAME:$DB_HOST;$settings", $DB_USER, $DB_PASSWORD, $attr);
 107     return $dbh;
 108
 109 }
 110
 111 sub new_instance_of {
 112     my ($self, $class) = @_;
 113     return $class->new($self->{options});
 114 }
 115
 116 sub connect_kvs {
 117     my $self = shift;
 118     my $r = Redis->new(server => $self->{options}->{KeyValueStore}->{host});
 119     $r->connect;
 120     return $r;
 121 }
 122
 123 sub logger {
 124     my $self = shift;
 125
 126     if ($self->{options}->{Logger}) {
 127         return $self->{options}->{Logger};
 128     }
 129     # return dummy object
 130     return {
 131             append => sub {},
 132             debug => sub {},
 133             error => sub {},
 134             fatal => sub {},
 135             info => sub {},
 136             is_level => sub {},
 137             warn => sub {},
 138            };
 139 }
 140
 141 sub warn {
 142     my $self = shift;
 143     my $val = shift;
 144     $self->logger->warn($val);
 145 }
 146
 147 1;