File Coverage

blib/lib/DBIx/Fast.pm

Criterion	Covered	Total	%
statement	264	292	90.4
branch	77	112	68.7
condition	25	33	75.7
subroutine	34	36	94.4
pod	20	20	100.0
total	420	493	85.1

package DBIx::Fast;

use strict;
use warnings;

our $VERSION = '0.15';

use Carp;
use Moo;

use DBI;
use DBIx::Connector;
use SQL::Abstract;

has args    => ( is => 'rwp' );
has db      => ( is => 'rw'  );
has dbd     => ( is => 'rwp' );
has dsn     => ( is => 'rwp' ); # DSN String
has errors  => ( is => 'rwp' ); # Array errors
has results => ( is => 'rw'  ); # Last return
has sql     => ( is => 'rw'  ); # SQL Actual
has p       => ( is => 'rw'  );
has Q       => ( is => 'rw'  ); # SQL::Abstract
has Tables  => ( is => 'rwp' );

has last_id    => ( is => 'rw'  );
has last_error => ( is => 'rwp' );
has last_sql   => ( is => 'rw'  );

sub now {
  my $self = shift;
  my ($sec, $min, $hour, $mday, $mon , $year) = localtime;

  ## MySQL / MariaDB
  return sprintf("%04d-%02d-%02d %02d:%02d:%02d",$year + 1900, $mon + 1, $mday, $hour, $min, $sec);
}

sub set_error {
  my $self  = shift;

  my $error = {
	       id    => shift,
	       error => shift,
	       time  => time()
	      };

  my $Errors = $self->errors;
  push @{$Errors} ,$error;

  $self->_set_last_error(qq{$error->{time} - [$error->{id}] - $error->{error}});
  $self->_set_errors($Errors);
}

sub BUILD {
  my ($self,$args) = @_;

  # Force all
  if ( $args->{Error} ) {
      $args->{RaiseError} = 1;
      $args->{PrintError} = 0;
  }

  # SQLite
  if ( $args->{SQLite} ) {
      $self->Exception("No DB Found : ".$args->{SQLite}) unless -e $args->{SQLite};
      $args->{db} = $args->{SQLite};
      $args->{driver} = 'SQLite'
  }

  my $DConf = {
      DBI => {
	  RaiseError => $args->{RaiseError} // 1,
	  PrintError => $args->{PrintError} // 0,
	  AutoCommit => $args->{AutoCommit} // 1
      },
      Auth => {
	  user     => $args->{user}     // '',
	  password => $args->{password} // '',
	  host     => $args->{host}     // ''
      },
      tn     => $args->{tn} // 1,
      db     => $args->{db}  // '',
      dsn    => $args->{dsn} // '',
      driver => $args->{driver} // '',
      quote  => $args->{quote}  // '',
      trace  => $args->{trace}  // '',
      profile => $args->{profile} // '',
      abstract => $args->{abstract} // 1
  };

  $DConf->{DBI}->{mysql_enable_utf8} = 1 if $args->{mysql_enable_utf8};

  $self->_set_args($DConf);

  $self->Q( SQL::Abstract->new ) if $self->args->{abstract};

  # No DSN or Host
  unless ( $self->args->{dsn} || $self->args->{db} ) {
      $self->Exception("Need a DSN or Host");
  }

  $self->_set_dsn($self->args->{dsn} ? $self->_check_dsn($self->args->{dsn}) : $self->_make_dsn($self->args));

  $self->db( DBIx::Connector->new( $self->dsn,
				   $self->args->{Auth}->{user}, $self->args->{Auth}->{password},
				   $self->args->{DBI} ) );

  $self->db->mode('ping');

  $self->db->dbh->quote($self->args->{quote}) if $self->args->{quote};

  $self->db->dbh->{HandleError} = sub {
    $self->set_error($DBI::err,$DBI::errstr);
  };

  $self->db->dbh->trace($self->args->{trace},'dbix-fast-trace') if $self->args->{trace};

  $self->_profile($self->args->{profile}) if $self->args->{profile};

  ## Set TablesName
  #$self->_TablesName() if $self->args->{tn};
}

sub _TablesName {
    my $self = shift;

    return $self->all('tables'); #SHOW TABLES()');
}

sub _Driver_dbd {
  my $self = shift;
  my $dbd  = shift;

  $self->Exception("Error DBD Driver") unless $dbd;

  map { $self->_set_dbd($_) if lc($dbd) eq lc($_) } qw(SQLite Pg MariaDB mysql);

  $self->Exception("Error DBD Driver : $dbd") unless $self->dbd;
}

sub _dsn_dbi {
  my $self = shift;
  my $dsn  = shift;

  my ($dbi,$driver,$db,$host) = split ':', $dsn;

  $self->Exception("DSN DBI: $dbi") unless $dbi eq 'dbi';

#    if ( $driver eq 'SQLite' ) {
#        $db =~ s/^(dbname|database)\=(.*)$/$2/;
#    } elsif ( $driver eq 'Pg' ) {
#    } else {
#        $self->Exception("DSN Host") unless $host;
#    }

  $self->Exception("DSN DataBase: $db") unless $db;

  $self->_Driver_dbd($driver);

  return $dsn;
}


sub _check_dsn {
  my $self = shift;
  my $dsn  = shift;

  ## DSN DBI = ^dbi
  return $self->_dsn_dbi($dsn) if $dsn =~ /^dbi/;

  ## DSN to DBI
  return $self->_dsn_to_dbi($dsn);
}

sub _make_dsn {
  my $self = shift;
  my $args = shift;

  $self->Exception("DSN Driver: Not defined") unless $args->{driver};

  $self->_Driver_dbd($args->{driver});

  return 'dbi:SQLite:dbname='.$args->{db} if $args->{driver} eq 'SQLite';

  $self->Exception("DSN Host: Not defined") unless $args->{host};
  $self->Exception("DSN DB: Not defined")   unless $args->{db};

  return 'dbi:'.$self->dbd.':database='.$args->{db}.':'.$args->{host};
}

sub _dsn_to_dbi {
  my $self = shift;
  my $dsn  = shift;
  my $URI;

  #SQLite
  if ( $dsn =~ /^sqlite:\/\/\/(.*)$/ ) {
    $self->_set_dbd('SQLite');
    return 'dbi:SQLite:dbname='.$1; # , schema => 'sqlite' , db => $1 };
  }

  ($URI->{schema},$URI->{UI},$URI->{connect},$URI->{db}) = ( $dsn =~ /^(.*):\/\/(.*)\@(.*)\/(.*)$/g );

  $self->Exception("_dsn_to_dbi : schema")  unless $URI->{schema};

  $self->_Driver_dbd($URI->{schema});

  $self->Exception("_dsn_to_dbi : connect") unless $URI->{connect};

  $URI->{connect} =~ /:/ ? ($URI->{host},$URI->{port}) = split ':',$URI->{connect} : $URI->{host} = $URI->{connect};

  # UserInfo
  if ( $URI->{UI} =~ /:/ ) {
      ($URI->{user},$URI->{password}) = split ':',$URI->{UI};
      my $SetArgs = $self->args;
      $SetArgs->{Auth}->{user} = $URI->{user};
      $SetArgs->{Auth}->{password} = $URI->{password};
      $self->_set_args($SetArgs);
  } else {
      $URI->{user} = $URI->{UI}
  }

  $self->Exception('_dsn_to_dbi : No DB value') unless $URI->{db};

  ## Loop Attrs + Value
  if ( $URI->{db} =~ s/^(.*)\?(.*)$/$1/ ) {
    ($URI->{attribute},$URI->{value}) = split '=',$2;
  }

  if ( $dsn =~ /^(postgres|postgresql):/ ) {
    $self->_set_dbd('Pg');
    $URI->{DSN} = 'dbi:Pg:dbname='.$URI->{db}.';host='.$URI->{host}.';port='.$URI->{port};
  } elsif ( $dsn =~ /^(mariadb):/ ) {
    $self->_set_dbd('MariaDB');
    $URI->{DSN} = 'dbi:MariaDB:dbname='.$URI->{db}.';host='.$URI->{host}.';port='.$URI->{port};
  } elsif ( $dsn =~ /^(mysql|mysqlx):/ ) {
    $self->_set_dbd('mysql');
    $URI->{DSN} = 'dbi:mysql:dbname='.$URI->{db}.';host='.$URI->{host}.';port='.$URI->{port};
  } else {
    $self->Exception("_dsn_to_dbi : $dsn");
  }

  return $URI->{DSN};
}

sub _profile {
  my $self = shift;
  my $stat = shift."/DBI::ProfileDumper/";

  $stat .= qq{File:dbix-fast-$$.log};

  $self->db->dbh->{Profile} = $stat;
}

sub all {
  my $self = shift;

  $self->q(@_);

  my $res = $self->db->dbh->selectall_arrayref($self->sql,
					       { Slice => {} },@{$self->p});

  $self->Exception("ERROR all()") if $DBI::err;

  $self->results($res);
}

sub flat {
  my $self = shift;

  $self->q(@_);

  my $sth = $self->db->dbh->prepare($self->sql);

  $sth->execute(@{$self->p});

  my @Flat;

  while(my $row = $sth->fetchrow_array) {
    push @Flat,$row;
  }

  $self->results(\@Flat);

  return @Flat;
}

sub hash {
  my $self = shift;

  $self->q(@_);

  my $sth = $self->db->dbh->prepare($self->sql);

  $sth->execute(@{$self->p});

  my $res = $sth->fetchrow_hashref;

  $self->Exception("hash()") if $DBI::err;

  $self->results($res);
}

sub val {
  my $self = shift;

  $self->q(@_);

  my $ret = $self->db->dbh->selectrow_array($self->sql, undef, @{$self->p});

  $self->Exception("val()") if $DBI::err;

  return $ret;
}

sub array {
  my $self = shift;

  $self->q(@_);

  my $sth = $self->db->dbh->prepare($self->sql);

  $sth->execute(@{$self->p});

  $self->Exception("array()") if $DBI::err;

  my @rows = @{ $self->db->dbh->selectcol_arrayref( $self->sql, undef, @{ $self->p } ) };

  $self->results(\@rows);
}

sub count {
  my $self  = shift;
  my $table = $self->TableName(shift);
  my $skeel = shift;

  $self->sql("SELECT COUNT(*) FROM $table");

  return $self->db->dbh->selectrow_array($self->sql)
    unless $skeel;

  $self->_make_where($skeel);

  return $self->db->dbh->selectrow_array($self->sql, undef, @{$self->p});
}

sub _make_where {
  my $self  = shift;
  my $skeel = shift;
  my @p;

  my $sql = " WHERE ";

  for my $K ( keys %{$skeel} ) {
    my $key;

    if ( ref $skeel->{$K} eq 'HASH' ) {
      $key = (keys %{$skeel->{$K}})[0];
      push @p,$skeel->{$K}->{$key};
    } else {
      $key = '=';
      push @p,$skeel->{$K};
    }

    $sql .= qq{$K $key ? };
  }

  $sql =~ s/,$//;

  $self->sql($self->sql.$sql);
  $self->p(\@p);
}

sub execute {
  my $self = shift;
  my $sql  = shift;
  my $extra = shift;
  my $type  = shift // 'arrayref';
  my $res;

  $self->sql($sql);

  ## Extra Arguments
  $self->make_sen($extra) if $extra;

  if ( $type eq 'hash' ) {
    my $sth = $self->db->dbh->prepare($self->sql);
    if ( $self->p ) {
      $sth->execute(@{$self->p});
    } else {
      $sth->execute;
    }
    $res = $sth->fetchrow_hashref;
  } else {
    if ($self->p ) {
      $res = $self->db->dbh->selectall_arrayref($self->sql,
						{ Slice => {} },@{$self->p});
    } else {
      $res = $self->db->dbh->selectall_arrayref($self->sql,
						{ Slice => {} } );
    }
  }

  $self->Exception("execute()") if $DBI::err;

  $self->results($res);
}

sub up {
  my ($self,$table,$data,$where,$time) = @_;

  if ( $time ) {
    $self->update( $self->TableName($table) , { sen => $data , where => $where } , time => $time );
  } else {
    $self->update( $self->TableName($table) , { sen => $data , where => $where } );
  }
}

sub update {
  my $self  = shift;
  my $table = $self->TableName(shift);
  my $skeel = shift;

  $skeel->{sen} = $self->extra_args($skeel->{sen},@_) if scalar @_ > 0;

  my @p;
  my $sql = "UPDATE $table SET ";

  for ( keys %{$skeel->{sen}} ) {
    push @p,$skeel->{sen}->{$_};
    $sql .= $_.' = ? ,';
  }

  $sql =~ s/,$//;
  $sql .= 'WHERE ';

  for my $K ( keys %{$skeel->{where}} ) {
    push @p,$skeel->{where}->{$K};
    $sql .= $K.' = ? AND ';
  }

  $sql =~ s/AND $//;

  $self->sql($sql);
  $self->execute_prepare(@p);
}

sub insert {
  my $self  = shift;
  my $table = $self->TableName(shift);
  my $skeel = shift;

  $skeel = $self->extra_args($skeel,@_) if scalar @_ > 0;

  my @p;
  my $sql= "INSERT INTO $table ( ";

  for ( keys %{$skeel} ) {
    push @p,$skeel->{$_};
    $sql .= $_.',';
  }

  $sql =~ s/,$/ )/;
  $sql .= ' VALUES ( '.join(',', ('?') x @p).' )';

  $self->sql($sql);
  $self->execute_prepare(@p);

  if ( $self->dbd eq 'MariaDB' ) {
    $self->last_id($self->db->dbh->{mariadb_insertid});
  } elsif ( $self->dbd eq 'mysql' ) {
    $self->last_id($self->db->dbh->{mysql_insertid});
  } elsif ( $self->dbd eq 'SQLite' ) {
    $self->last_id($self->db->dbh->sqlite_last_insert_rowid());
  } elsif ( $self->dbd eq 'Pg' ) {
    $self->last_id($self->db->dbh->last_insert_id(undef,undef,$table,undef));
  }
}

sub delete {
  my $self  = shift;
  my $table = $self->TableName(shift);
  my $skeel = shift;

  $self->sql("DELETE FROM $table");

  #unless ( $skeel ) {
  #    return $self->db->dbh->selectrow_array($self->sql);
  #}

  $self->_make_where($skeel);

  my $sth = $self->db->dbh->prepare($self->sql);

  $sth->execute(@{$self->p});
}

sub extra_args {
  my $self  = shift;
  my $skeel = shift;
  my %args  = @_;

  $skeel->{$args{time}} = $self->now() if $args{time};

  return $skeel;
}

sub make_sen {
  my $self  = shift;
  my $skeel = shift;
  my $sql   = $self->sql();
  my @p;

  ## Ha de encontrar resultados por el orden de entrada parsear debidamente
  for ( keys %{$skeel} ) {
    my $arg = ':'.$_;
    push @p,$skeel->{$_};
    $sql =~ s/$arg/\?/;
  }

  $sql =~ s/,$//;

  $self->sql($sql);
  $self->p(\@p);
}

sub q {
  my $self = shift;
  my $sql  = shift;
  my @p;

  map { push @p,$_ } @_;

  $self->sql($sql);
  $self->p(\@p);
}

sub execute_prepare {
  my $self = shift;
  my @p    = @_;

  my $sth = $self->db->dbh->prepare($self->sql);

  $sth->execute(@p);

  $self->Exception("execute_prepare()") if $DBI::err;

  $self->last_sql($self->sql);
}

sub TableName {
  my $self  = shift;
  my $table = shift;

  $self->Exception("TableName not defined") unless $table;

  if ( $self->args->{TableName} ) {

  }

  return $table unless $table =~ /\W/;

  $self->Exception("TableName not valid: $table");
}

sub Exception {
  my $self = shift;
  my $msg  = shift;

  unless ( $self->args->{DBI}->{RaiseError} ) {
      die unless $self->args->{DBI}->{PrintError};
  }

  my $out  = "Exception: $msg";

  $out .= " - Last error: ".$self->last_error if $self->last_error;

  croak $out;
}

1;

__END__