# SnowPg.pm - Copyright Andrew Snow 2001,2002,2003 - andrew@modulus.org

package SnowPg;

# use strict;
use vars qw($VERSION);

use Pg;
use Carp;
$VERSION = '1.15';

%conns = ();
%transact = ();

sub new {
	my $class = shift;
	my %args = (@_);
	my $self = {};
	bless $self, $class;


	$self->{db} = $args{connect_string};
	if(defined $args{persist}) {
		$self->{persist} = ($args{persist}) ? 1 : 0;
	} else {
		$self->{persist} = 0;
	}
	if(defined $args{debug}) {
		$self->{debug} = ($args{debug}) ? 1 : 0;
	} else {
		$self->{debug} = 0;
	}
	$self->{debugfile} = $args{debugfile};
	$self->{dbname} = $args{connect_string};
	$self->{dbname} =~ s/^.*dbname=([^\s]+).*$/$1/;

	if((!$args{persist}) || (!defined($conns{$self->{db}})) || $conns{$self->{db}}->status ne PGRES_CONNECTION_OK) {
                $conns{$self->{db}} = Pg::connectdb($self->{db});
		$self->logwrite('Opening connection to database (' . $args{connect_string} . ')');
		if($conns{$self->{db}}->status ne PGRES_CONNECTION_OK) {
			my $errmsg = $conns{$self->{db}}->errorMessage;
			$self->logwrite('Error opening new PostgreSQL database connection: ' . $errmsg, error=>1);
			return undef;
		}
        }
	else {
		$self->logwrite('Using existing connection to database');
	}
	if($transact{$self->{db}}) {
	        rollback();
	}
	$transact{$self->{db}} = 0;

	return $self;
}

sub query {
	my ($self, $query, @parms) = @_;
	
	my $starttime = time;
	my $p = 0;
	my @str = split /(%.)/, $query;
	$query = shift @str;
	foreach my $s (@str) {
		if($s eq '%q') {
			my $p = shift @parms;
			$s = (defined $p) ? ('\'' . escape($p) . '\'') : 'NULL';
			$p++;
		} elsif($s eq '%l') {
			my $p = shift @parms;
			if(ref($p)) {
				$s = join ',', (map { (defined $_) ? ('\'' . escape($_) . '\'') : 'NULL' } @{$p});
			} else {
				$s = (defined $p) ? ('\'' . escape($p) . '\'') : 'NULL';
			}
			$p++;
		} elsif($s eq '%x') {
			my $p = shift @parms;
			$s = (defined $p) ? ('\'' . $self->tobytea($p) . '\'') : 'NULL';
		} elsif($s eq '%u') {
			my $p = shift @parms;
			$s = (defined $p) ? $p : 'NULL';
			$p++;
		} elsif($s eq '%b') {
			my $p = shift @parms;
			$s = (defined $p) ? ($p ? '\'t\'' : '\'f\'') : 'NULL';
		} elsif($s eq '%n') {
			$s = (shift @parms) ? 'NOT NULL' : 'NULL';
		} elsif($s eq '%%') {
			$s = '%';
		}
		$query .= $s;
	}
	$prnquery = $query;
	$prnquery =~ s/\t+/\t/gs;
	$prnquery =~ s/\n\t*/\n\t/gs;
	

	if(! defined($conns{$self->{db}})) {
		$self->logwrite("Executing query: \n\t$prnquery");
		$self->logwrite('SnowPg: Error executing query: Database context vanished', error=>1);
	}

	my $r = $conns{$self->{db}}->exec($query);
	$self->{query} = $r;
        
        if($r->resultStatus ne PGRES_TUPLES_OK && $r->resultStatus ne PGRES_COMMAND_OK) {
		my $errmsg = $conns{$self->{db}}->errorMessage;
		$self->logwrite("Error executing query:\n\t$errmsg\n\t$prnquery\n", error=>1);
		return undef;
	}

	if($query =~ /^SELECT/i) {
		$self->{numtuples} = $r->ntuples;
		my $nfields = $r->nfields;
		$self->{fields} = [];
		my $n;
		foreach my $n (0..$nfields-1) {
			push @{$self->{fields}}, $r->fname($n);
		}
	} else {
		$self->{numtuples} = $r->cmdTuples;
	}
	my $endtime = time;
	my $totaltime = $endtime - $starttime;

	$self->logwrite("Executed query: (" . $self->{numtuples} . " rows) (" . $totaltime . " secs)\n\t$prnquery");

	return $r;
}

sub ntuples { 
	my $self = shift;
	return $self->{numtuples};
}

sub begin {
	my $self = shift;
	my $r = $self->query('BEGIN');
	$transact{$self->{db}} = 1 if($r);
	return $r;
}

sub commit {
	my $self = shift;
	my $r = $self->query('COMMIT');
	$transact{$self->{db}} = 0;
	return $r;
}

sub rollback {
	my $self = shift;
	my $r = $self->query('ROLLBACK');
	$transact{$self->{db}} = 0;
	return $r;
}

sub fetchrow {
	my ($self,$r) = @_;
	$r = $self->{query} if(!$r);
	my @row = $r->fetchrow();
	my %h = ();
	if(@row) {
		my $n = 0;
		foreach (@{$self->{fields}}) {
			$h{$_} = $row[$n++];
		}
	}
	return %h;
}

sub fetchval {
	my ($self, $r) = @_;
	$r = $self->{query} if(!$r);
	return ($r->fetchrow())[0];
}

sub fetchlist {
	my ($self, $fname, $r) = @_;
	$r = $self->{query} if(!$r);
	my %rw;
	my @res;
	while(%rw = $self->fetchrow()) {
		if(defined($fname)) {
			push @res, $rw{$fname};
		} else {
			push @res, { %rw };
		}
	}
	return @res;
}

sub fetchhash {
	my $self = shift;
	my %rw;
	my %res = ();
	if(scalar(@_) > 1) {
		my %args = (@_);
		my $fname = (keys %args)[0];
		my $fname2 = $args{$fname};
		while(%rw = $self->fetchrow()) {
			$res{$rw{$fname}} = $rw{$fname2};
		}
	}
	else {
		my $arg = shift;
		while(%rw = $self->fetchrow()) {
			my $key = delete $rw{$arg};
			$res{$key} = { %rw } ;
		}
	}
	return %res;
}

sub DESTROY {
	my $self = shift;
	$self->logwrite('Destroying connection.');
	if($transact{$self->{db}}) {
		$self->rollback();
	}
	if(! $self->{persist}) {
		delete $conns{$self->{db}};
		delete $transact{$self->{db}};
	}
};


sub escape {
	my $res = shift;
#	my @chars = split //, shift;
#	my $res = "";
#	foreach my $c (@chars) {
#		my $o = ord $c;
#		if($o<32 || $o>127) {
#			$res .= sprintf "\\%03o", (ord $c);
#		} else {
#			$c =~ s/(['\\])/\\$1/g;
#			$res .= $c;
#		}
#	}
	$res =~ s/(['\\\x00-\x1f\x7f-\xff])/sprintf '\%03o', ord($1)/ge;
	return $res;
}

sub tobytea {
	my $self = shift;
	my $string = shift;
	$string =~ s/([\x00-\x1F\x27\x5C\x7F-\xFF])/sprintf '\\\\%03o', ord($1)/ge;
	return $string;
}

sub unbytea {
	my $class = shift;
	my $string = shift;
	$string =~ s/\\(\d\d\d)/chr(oct($1))/ge;
	$string =~ s/\\\\/\\/g;	
	return $string;	
}

sub socket {
	my $self = shift;
	my $fd = $conns{$self->{db}}->socket;
	return $fd;
}

sub notifies {
	my $self = shift;
	my @notes = $conns{$self->{db}}->notifies;
	return @notes;
}

sub consume {
	my $self = shift;
	$conns{$self->{db}}->consumeInput;
}

sub logwrite {
	my $self = shift;
        my $msg = shift;
	my %args = (@_);
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
	my $stamp = sprintf '[%u/%02u/%02u %02u:%02u:%02u %6u]', $year+1900, $mon+1, $mday, $hour, $min, $sec, $$;
	my $stamp2 = sprintf '[%-15s] SnowPg(%s): ', defined($ENV{REMOTE_ADDR})?$ENV{REMOTE_ADDR}:'local', $self->{dbname};
	if($self->{debugfile} ne '') {
	        if(open LOGFILE, '>>'.$self->{debugfile}) {
			print LOGFILE "$stamp $stamp2 $msg\n";
			close LOGFILE;
		}
        }
	if($args{error}) {
		croak "$stamp2 $msg";
	}
	elsif($self->{debug}) {
		print STDERR "$stamp $stamp2 $msg \n";
	}
}

1;


=head1 NAME

SnowPg - A simple wrapper class for Pg.

=head1 SYNOPSIS

use SnowPg;

=head2 Connecting to the database

# Connect to the database and don't kill the connection even when $db goes
# out of scope. If a connection is already found open matching supplied
# connection string, it will be used (with a rollback if necessary)

	$db = SnowPg->new(connect_string => 'dbname=abc user=123',
		persist => 0,		# don't re-use connections 
		debug => 1,		# send debug info to STDERR
		debugfile => '/var/log/db.log',		# append debug info to db.log
	);

=head2 Performing queries

	$db->query( q[SELECT %q AS Quoted], 'quoted escaped string' );
	
	# %q	=> quoted and escaped
	#	eg. bl'ah -> 'bl\'ah'
	#	    undef -> NULL

	# %l    => quoted list of strings
	#       eg. [ 'one', 'two' ]  -> 'one','two'
	#           [ @list ] ->  'abc','def'
	#		etc..

	# %u	=> unquoted and unescaped (e.g. for numerical)
	#	eg. 12345 -> 12345
	#	    undef -> NULL

	# %n	=> boolean evaluated to NULL or NOT NULL
	#	eg. 0 or empty set or undef -> NULL
	#	    1 -> NOT NULL

	# %b	=> boolean evaluated to 't' or 'f'
	#	eg. 1 -> 't'
	#	    0 -> 'f'
	#           undef -> NULL

	# %x	=> bytea escaping (see below)

=head2 Fetching query results 

# Number of result rows

	$n = $db->ntuples();

# Get a single row of results

	if (%result = $db->fetchrow) {
		$quoted = $result{quoted};
	}

# Get multiple rows of results

	# Spelling it out
		while (%res = $db->fetchrow()) {
			foreach $k (keys %res) {
				print "$k = $res{$k}\n";
			}
		}

	# Getting a single column of rows into a list
	
		@values = $db->fetchlist('fieldname');

	# Getting all rows into a list of hashes
	
		@rows = $db->fetchlist();
		# access example:
		print "Result is " . $rows[5]->{columnname};

	# Getting two columns into a hash

		%values = $db->fetchhash('fieldname1' => 'fieldname2');

	# Getting multiple columns into a hash using any field as a key

		%values = $db->fetchhash('fieldname1');
		# access example:
		foreach $key (keys %values) {
			$field2 = $values{$key}->{fieldname2};
			$field3 = $values{$key}->{fieldname3};
			print "Row: $key has field2=$field2 and field3=$field3\n";
		}
		# NOTE: specifying a non-unique field will cause older rows
		# to be replaced with new rows in the order they are
		# received from the server!

=head2 Transactions

	$db->begin();

	$db->commit();
	
	$db->rollback();
	# Rollback gets called automatically if object is destroyed. 
	# (Connection may be persistent)

=head2 Byte array handling (BYTEA)

	Simply send SnowPG the byte array as if it was a normal variable using
	query() and %q, eg:

	$db->query( q[INSERT INTO blobtable (blobcol) VALUES (%x)], $bytes );

	To decode postgres reponse, use:

	$bytes = SnowPg->unbytea( $postgres_output );

=head2 PostgreSQL signalling 

	# (see Pg for more information)
	# To get the socket fd:

		$sock = $db->socket();
	
	# To get notifications:

		@notes = $db->notifies();

	# To consume input

		$db->consume();


=head1 CONTACT DETAILS

Author: Andrew Snow, andrew@modulus.org

=cut