view release on metacpan or  search on metacpan

lib/DBIx/Perlish.pm  view on Meta::CPAN

	return $sql;
}

sub fetch
{
	my ($moi, $sub) = @_;
	my $me = ref $moi ? $moi : {};

	my $nret;
	my $dbh = $me->{dbh};
	my %flags;

	($me->{sql}, $me->{bind_values}, $nret, %flags) = $me->gen_sql_select($sub);
	$SQL = $me->{sql}; @BIND_VALUES = @{$me->{bind_values}};

	if ($flags{key_fields}) {
		my @kf = @{ $flags{key_fields} // [] };
		my $kf = @kf == 1 ? $kf[0] : [@kf];
		my $r = $dbh->selectall_hashref($me->{sql}, $kf, {}, @{$me->{bind_values}}) || {};
		my $postprocess;
		if ($nret - @kf == 1) {
			# Only one field returned apart from the key field,
			# change hash reference to simple values.
			$postprocess = sub {
				my ($h, $level) = @_;
				if ($level <= 1) {
					delete @$_{@kf} for values %$h;
					$_ = (values %$_)[0] for values %$h;
				} else {
					for my $nh (values %$h) {
						$postprocess->($nh, $level-1);
					}
				}
			};
		} else {
			$postprocess = sub {
				my ($h, $level) = @_;
				if ($level <= 1) {
					delete @$_{@kf} for values %$h;
				} else {
					for my $nh (values %$h) {
						$postprocess->($nh, $level-1);
					}
				}
			};
		}
		$postprocess->($r, scalar @kf);
		return wantarray ? %$r : $r;
	} else {
		if ($nret > 1) {
			my $r = $dbh->selectall_arrayref($me->{sql}, {Slice=>{}}, @{$me->{bind_values}}) || [];
			return wantarray ? @$r : $r->[0];
		} else {
			my $r = $dbh->selectcol_arrayref($me->{sql}, {}, @{$me->{bind_values}}) || [];
			return wantarray ? @$r : $r->[0];
		}
	}
}

# XXX refactor update/delete into a single implemention if possible?
sub update
{
	my ($moi, $sub) = @_;
	my $me = ref $moi ? $moi : {};

	my $dbh = $me->{dbh};
	($me->{sql}, $me->{bind_values}) = gen_sql($sub, "update",
		flavor => _get_flavor($dbh),
		dbh    => $dbh,
		quirks => $me->{quirks} || $non_object_quirks,
	);
	$SQL = $me->{sql}; @BIND_VALUES = @{$me->{bind_values}};
	$dbh->do($me->{sql}, {}, @{$me->{bind_values}});
}

sub delete
{
	my ($moi, $sub) = @_;
	my $me = ref $moi ? $moi : {};

	my $dbh = $me->{dbh};
	($me->{sql}, $me->{bind_values}) = gen_sql($sub, "delete",
		flavor => _get_flavor($dbh),
		dbh    => $dbh,
		quirks => $me->{quirks} || $non_object_quirks,
	);
	$SQL = $me->{sql}; @BIND_VALUES = @{$me->{bind_values}};
	$dbh->do($me->{sql}, {}, @{$me->{bind_values}});
}

sub insert
{
	my ($moi, $table, @rows) = @_;
	my $me = ref $moi ? $moi : {};

	my $dbh = $me->{dbh};
	my %sth;
	for my $row (@rows) {
		my @keys = sort keys %$row;
		my $sql = "insert into $table (";
		$sql .= join ",", @keys;
		$sql .= ") values (";
		my (@v, @b);
		my $skip_prepare;
		for my $v (@$row{@keys}) {
			if (ref $v eq 'CODE') {
				push @v, scalar $v->();
				$skip_prepare = 1;
			} else {
				push @v, "?";
				push @b, $v;
			}
		}
		$sql .= join ",", @v;
		$sql .= ")";
		if ($skip_prepare) {
			return undef unless defined $dbh->do($sql, {}, @b);
		} else {
			my $k = join ";", @keys;
			$sth{$k} ||= $dbh->prepare($sql);
			return undef unless defined $sth{$k}->execute(@b);