view release on metacpan or  search on metacpan

lib/Egg/Mod/EasyDBI.pm  view on Meta::CPAN

	my $class= __PACKAGE__."::$dbname";
	no strict 'refs';  ## no critic
	no warnings 'redefine';
	@{"${class}::ISA"}= 'Egg::Mod::EasyDBI::table';
	*{__PACKAGE__."::$dbname"}= sub {
		my($proto)= @_;
		$proto->[1]{$dbname} ||= $class->new($proto->[0], $dbname);
	  };
	$self->$dbname;
}
sub DESTROY {}

package Egg::Mod::EasyDBI::table;
use strict;
use warnings;
use Carp qw/croak/;

my $argc= 'Egg::Mod::EasyDBI::args';

sub new {
	my($class, $es, $dbname)= @_;
	if (my $alias= $es->alias->{$dbname}) { $dbname= $alias }
	bless { es=> $es, dbname=> $dbname }, $class;
}
sub hashref {
	my $self= shift;
	my $a= $argc->_hashref(@_);
	$self->{es}->hashref
	("SELECT $a->{cols} FROM $self->{dbname} $a->{st}", $a->{ex});
}
sub arrayref {
	my $self= shift;
	my $a= $argc->_arrayref(@_);
	$self->{es}->arrayref
	("SELECT $a->{cols} FROM $self->{dbname} $a->{st}", $a->{ex}, $a->{cd});
}
*list= \&arrayref;
sub scalarref {
	my $self= shift;
	my $col = shift || croak q{ I want column. };
	   $col = $$col if ref($col) eq 'SCALAR';
	my $a= $argc->_scalarref(@_);
	$self->{es}->scalarref
	("SELECT $col FROM $self->{dbname} $a->{st}", $a->{ex});
}
sub scalar {
	my $result= shift->scalarref(@_) || return (undef);
	$$result;
}
sub insert {
	my $self= shift;
	my $a= $argc->_insert(@_);
	my $sql= qq{INSERT INTO $self->{dbname}}
	       . qq{ (}. join(', ', keys %$a). q{) VALUES}
	       . qq{ (}. join(', ', map{"?"}keys %$a). q{)};
	$self->{es}->debug($sql);
	$self->{es}->dbh->do($sql, undef, values %$a)
	> 0 ? 1: 0;
}
*in= \&insert;
sub update {
	my $self= shift;
	my $a= $argc->_update(@_);
	my $sql= qq{UPDATE $self->{dbname} SET }
	       . join(', ', keys %{$a->{up}}). qq{ WHERE $a->{st}};
	$self->{es}->debug($sql);
	$self->{es}->dbh->do($sql, undef, (values %{$a->{up}}), @{$a->{ex}})
	> 0 ? 1: 0;
}
*up= \&update;
sub update_insert {
	my $self= shift;
	return "0E0" if $self->update(@_);
	if (my $error= $self->{es}->dbh->errstr) { die $error }
	$self->insert(@_);
}
sub find_insert {
	my $self= shift;
	my $col = shift || croak q{ I want column name. };
	@_ || croak q{ I want argument. };
	my $hash= ref($_[0]) eq 'HASH'
	   ? $_[0] : CORE::do { (scalar(@_)% 2)== 0 ? {@_}: {$col, @_} };
	return "0E0" if $self->scalarref($col, "$col = ?",
	  (ref($hash->{$col}) eq 'ARRAY' ? $hash->{$col}->[0]: $hash->{$col}));
	$self->insert($hash);
}
sub for_update {
	my $self= shift;
	my $st  = shift || croak q{ I want column. };
	   $st  = $$st if ref($st) eq 'SCALAR';
	my $val = shift || croak q{ I want value. };
	my $sql = "SELECT * FROM $self->{dbname} WHERE $st = ? FOR UPDATE";
	$self->{es}->debug($sql);
	$self->{es}->dbh->do($sql, undef, $val) > 0 ? 1: 0;
}
sub delete {
	my $self= shift;
	my $st  = shift || die q{ I want argument. };
	   $st  = $$st if ref($st) eq 'SCALAR';
	my $ex  = ref($_[0]) eq 'ARRAY' ? $_[0]: [@_];
	my $sql = qq{DELETE FROM $self->{dbname} WHERE $st };
	$self->{es}->debug($sql);
	$self->{es}->dbh->do($sql, undef, @$ex) > 0 ? 1: 0;
}
sub upgrade {
	my $self= shift;
	$self->{es}->upgrade_ok
	|| croak q{ There is effectively no 'upgrade_ok'. };
	my $a= $argc->_upgrade(@_);
	my $sql= qq{UPDATE $self->{dbname} SET }. join(', ', keys %{$a->{up}});
	$self->{es}->debug($sql);
	$self->{es}->dbh->do($sql, undef, (values %{$a->{up}}))
	> 0 ? 1: 0;
}
sub clear {
	my $self= shift;
	$self->{es}->clear_ok
	|| croak q{ There is effectively no 'clear_ok'. };
	my $sql= qq{DELETE FROM $self->{dbname}};
	$self->{es}->debug($sql);
	$self->{es}->dbh->do($sql, undef) > 0 ? 1: 0;
}
sub abs_hashref {
	my $self= shift;
	$self->{es}->hashref
	  ($self->{es}->sql_abstract->select($self->{dbname}, @_));
}
sub abs_arrayref {
	my $self= shift;
	my $code= ref($_[$#{@_}]) eq 'CODE' ? pop(@_): undef;
	my($stmt, @bind)= $self->{es}->sql_abstract->select($self->{dbname}, @_);