DBIx-DR
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/DBIx/DR.pm view on Meta::CPAN
return (
$self,
\@sql,
\%args,
$item,
$iterator,
);
}
sub _user_sql($@) {
my ($sql, @bv) = @_;
$sql =~ s/\?/'$_'/ for @bv;
return $sql;
}
sub select {
my ($self, $sql, $args, $item, $iterator) = &_dr_extract_args_ep;
my $req = $self->{"private_DBIx::DR_template"}->sql_transform(
@$sql,
%$args
);
carp _user_sql($req->sql, $req->bind_values) if $args->{'-warn'};
croak _user_sql($req->sql, $req->bind_values) if $args->{'-die'};
my $res;
local $SIG{__DIE__} = sub { croak $self->_dr_decode_err(@_) };
if (exists $args->{-hash}) {
$res = $self->selectall_hashref(
$req->sql,
$args->{-hash},
$args->{-dbi},
$req->bind_values
);
} else {
my $dbi = $args->{-dbi} // {};
croak "argument '-dbi' must be HASHREF or undef"
unless 'HASH' eq ref $dbi;
$res = $self->selectall_arrayref(
$req->sql,
{ %$dbi, Slice => {} },
$req->bind_values
);
}
return $res unless $iterator;
my ($class, $method) = camelize $iterator;
return $class->$method(
$res, -item => $item, -noitem_iter => $args->{-noitem_iter}) if $method;
return bless $res => $class;
}
sub single {
my ($self, $sql, $args, $item) = &_dr_extract_args_ep;
my $req = $self->{"private_DBIx::DR_template"}->sql_transform(
@$sql,
%$args
);
carp _user_sql($req->sql, $req->bind_values) if $args->{'-warn'};
croak _user_sql($req->sql, $req->bind_values) if $args->{'-die'};
local $SIG{__DIE__} = sub { croak $self->_dr_decode_err(@_) };
my $res = $self->selectrow_hashref(
$req->sql,
$args->{-dbi},
$req->bind_values
);
return unless $res;
my ($class, $method) = camelize $item;
return $class->$method($res) if $method;
return bless $res => $class;
}
sub perform {
my ($self, $sql, $args) = &_dr_extract_args_ep;
my $req = $self->{"private_DBIx::DR_template"}->sql_transform(
@$sql,
%$args
);
carp _user_sql($req->sql, $req->bind_values) if $args->{'-warn'};
croak _user_sql($req->sql, $req->bind_values) if $args->{'-die'};
local $SIG{__DIE__} = sub { croak $self->_dr_decode_err(@_) };
my $res = $self->do(
$req->sql,
$args->{-dbi},
$req->bind_values
);
return $res;
}
sub _dr_decode_err {
my ($self, @arg) = @_;
if ($self->{"private_DBIx::DR_dr_decode_errors"}) {
for (@arg) {
$_ = eval { decode utf8 => $_ } || $_ unless utf8::is_utf8 $_;
}
}
return @arg if wantarray;
return join ' ' => @arg;
}
1;
__END__
=head1 NAME
DBIx::DR - easy DBI helper (perl inside SQL and blessed results)
=head1 SYNOPSIS
my $dbh = DBIx::DR->connect($dsn, $login, $passed);
$dbh->perform(
'UPDATE tbl SET a = 1 WHERE id = <%= $id %>',
id => 123
);
my $rowset = $dbh->select(
'SELECT * FROM tbl WHERE id IN (<% list @$ids %>)',
ids => [ 123, 456 ]
);
my $rowset = $dbh->select(-f => 'sqlfile.sql.ep', ids => [ 123, 456 ]);
while(my $row = $rowset->next) {
print "id: %d, value: %s\n", $row->id, $row->value;
}
view all matches for this distributionview release on metacpan - search on metacpan
( run in 1.134 second using v1.00-cache-2.02-grep-82fe00e-cpan-3b7f77b76a6c )