Pg.pm

# $Id$

package Data::ObjectDriver::Driver::DBD::Pg;
use strict;
use warnings;

use base qw( Data::ObjectDriver::Driver::DBD );

# No postgresql doesn't allow MySQL's REPLACE INTO syntax 
sub can_replace { 0 }


sub init_dbh {
    my $dbd = shift;
    my($dbh) = @_;
    $dbh->do("set timezone to 'UTC'");
    $dbh;
}

sub bind_param_attributes {
    my ($dbd, $data_type) = @_;
    if ($data_type && $data_type eq 'blob') {
        return { pg_type => DBD::Pg::PG_BYTEA() };
    }
    return;
}

sub sequence_name {
    my $dbd = shift;
    my($class, $driver) = @_;

    my $datasource = $class ->datasource;
    my $prefix     = $driver->prefix;
    $datasource    = join('', $prefix, $datasource) if $prefix;
    join '_', $datasource,
        $dbd->db_column_name($class->datasource, $class->properties->{primary_key}),
        'seq';
}

sub fetch_id {
    my $dbd = shift;
    my($class, $dbh, $sth, $driver) = @_;
    $dbh->last_insert_id(undef, undef, undef, undef,
        { sequence => $dbd->sequence_name($class, $driver) });
}

sub bulk_insert {
    my $dbd = shift;
    my $dbh = shift;
    my $table = shift;

    my $cols = shift;
    my $rows_ref = shift;
    my $attrs = shift || {};

    if (%$attrs) {
        my $sql = "INSERT INTO $table ("  . join(',', @{$cols}) . ") VALUES\n";

        my $one_data_row = "(" . (join ',', (('?') x @$cols)) . ")";
        my $ph = join ",", (($one_data_row) x @$rows_ref);
        $sql .= $ph;

        my $sth = $dbh->prepare($sql);
        my $i = 1;
        for my $row (@$rows_ref) {
            for (my $j = 0; $j < @$cols; $j++) {
                $sth->bind_param($i++, $row->[$j], $attrs->{$cols->[$j]});
            }
        }
        $sth->execute;
    } else {
        my $sql = "COPY $table (" . join(',', @{$cols}) . ') from stdin';

        $dbh->do($sql);
        foreach my $row (@{$rows_ref}) {
            my $line = join("\t", map {$_ || '\N'} @{$row});
            $dbh->pg_putline("$line\n");
        }
        return $dbh->pg_endcopy();
    }
}

sub map_error_code {
    my $dbd = shift;
    my($code, $msg) = @_;

    if ($msg && $msg =~ /(?:violates unique constraint)/) {
        return Data::ObjectDriver::Errors->UNIQUE_CONSTRAINT;
    } else {
        return;
    }
}

1;