TUWF

 view release on metacpan or  search on metacpan

lib/TUWF/DB.pm  view on Meta::CPAN


package TUWF::DB;

use strict;
use warnings;
use Carp 'croak';
use Exporter 'import';
use Time::HiRes 'time';

our $VERSION = '1.6';
our @EXPORT = qw|
  dbInit dbh dbCheck dbDisconnect dbCommit dbRollBack
  dbExec dbVal dbRow dbAll dbPage
|;
our @EXPORT_OK = ('sqlprint');


sub dbInit {
  my $self = shift;
  require DBI;
  my $login = $self->{_TUWF}{db_login};
  my $sql;
  if(ref($login) eq 'CODE') {
    $sql = $login->($self);
    croak 'db_login subroutine did not return a DBI instance.' if !ref($sql) || !$sql->isa('DBI::db');
  } elsif(ref($login) eq 'ARRAY' && @$login == 3) {
    $sql = DBI->connect(@$login, {
      PrintError => 0, RaiseError => 1, AutoCommit => 0,
      mysql_enable_utf8 => 1, # DBD::mysql
      pg_enable_utf8    => 1, # DBD::Pg
      sqlite_unicode    => 1, # DBD::SQLite
    });
  } else {
    croak 'Invalid value for the db_login setting.';
  }
  $sql->{private_tuwf} = 1;
  inject_logging();

  $self->{_TUWF}{DB} = {
    sql => $sql,
    queries => [],
  };

  $_->() for @{$self->{_TUWF}{hooks}{db_connect}};
}


sub dbh {
  my($self) = @_;
  $self->dbInit if !$self->{_TUWF}{DB}{sql};
  $self->{_TUWF}{DB}{sql};
}


sub dbCheck {
  my $self = shift;
  my $info = $self->{_TUWF}{DB};
  return $self->dbInit if !$info || !$info->{sql};

  my $start = time;
  $info->{queries} = [];

  if(!$info->{sql}->ping) {
    $self->dbInit;
    warn "Ping failed, reconnected to database";
  }
  $self->dbRollBack;
  push(@{$info->{queries}}, [ 'ping/rollback', {}, time-$start ]);
}


sub dbDisconnect {
  (shift->{_TUWF}{DB}{sql} // return)->disconnect();
}


sub dbCommit {
  my $self = shift;
  my $start = [Time::HiRes::gettimeofday()] if $self->debug || $self->{_TUWF}{log_slow_pages};
  ($self->{_TUWF}{DB}{sql} // return)->commit();
  push(@{$self->{_TUWF}{DB}{queries}}, [ 'commit', {}, Time::HiRes::tv_interval($start) ])
    if $self->debug || $self->{_TUWF}{log_slow_pages};
}


sub dbRollBack {
  (shift->{_TUWF}{DB}{sql} // return)->rollback();
}



( run in 2.241 seconds using v1.01-cache-2.11-cpan-f0ff5d10edf )