view release on metacpan or  search on metacpan

lib/EB/Tools/SQLEngine.pm  view on Meta::CPAN

#! perl

# SQLEngine.pm -- Execute SQL commands
# Author          : Johan Vromans
# Created On      : Wed Sep 28 20:45:55 2005
# Last Modified By: Johan Vromans
# Last Modified On: Sat Jun 19 00:47:09 2010
# Update Count    : 72
# Status          : Unknown, Use with caution!

package EB::Tools::SQLEngine;

use strict;
use warnings;

use EB;

sub new {
    my ($class, @args) = @_;
    $class = ref($class) || $class;
    bless { _cb => {}, @args } => $class;
}

sub callback($%) {
    my ($self, %vec) = @_;
    return unless %vec;
    while ( my($k,$v) = each(%vec) ) {
	$self->{_cb}->{$k} = $v;
    }
}

# Basic SQL processor. Not very advanced, but does the job.
# Note that COPY status will not work across different \i providers.
# COPY status need to be terminated on the same level it was started.

sub process {
    my ($self, $cmd, $copy) = (@_, 0);
    my $sql = "";
    my $dbh = $self->{dbh} || $::dbh;

    # If we have PostgreSQL and it is of a suitable version, we can use
    # fast loading.
    my $pgcopy = $dbh->feature("pgcopy");

    # Filter SQL, if needed.
    my $filter = $dbh->feature("filter");

    # Remember type
    my $type = $dbh->driverdb;

    # Use raw handle from here.
    $dbh = $dbh->dbh;

    my $skipthis;
    foreach my $line ( split(/\n/, $cmd) ) {

	# Detect \i provider (include).
	if ( $line =~ /^\\i\s+(.*).sql/ ) {
	    my $call = $self->{_cb}->{$1};
	    die("?".__x("SQLEngine: No callback for {cb}",
			cb => $1)."\n") unless $call;
	    $self->process($call->(), $copy);
	    next;
	}

	# Handle COPY status.
	if ( $copy ) {
	    if ( $line eq "\\." ) {
		# End COPY.
		$dbh->pg_endcopy if $pgcopy;
		$copy = 0;
	    }
	    elsif ( $pgcopy ) {
		# Use PostgreSQL fast load.
		$dbh->pg_putline($line."\n");
	    }
	    else {
		# Use portable INSERT.
		my @args = map { $_ eq 't' ? 1 :
				   $_ eq 'f' ? 0 :
				     $_ eq '\\N' ? undef :