The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;

package LittleORM::Db;

my $cached_dbh = undef;

use Carp::Assert 'assert';

sub dbh_is_ok
{
	my $dbh = shift;

	my $rv = $dbh;

	if( $dbh )
	{

		unless( $dbh -> ping() )
		{
			$rv = undef;
		}
	}

	return $rv;
}

sub __set_default_if_not_set
{
	my ( $self, $dbh ) = @_;

	unless( &dbh_is_ok( $self -> get_dbh() ) )
	{
		# small racecond :)
		$self -> init( $dbh );
	}
}

sub init
{
	my ( $self, $dbh ) = @_;

	unless( $dbh )
	{
		# non-object call ?
		$dbh = $self;
	}

	$cached_dbh = $dbh;

}

sub get_dbh
{
	return $cached_dbh;
}

sub dbq
{
	my ( $v, $dbh ) = @_;


	unless( $dbh )
	{
		$dbh = $cached_dbh;
	}

	assert( &dbh_is_ok( $dbh ) );

	return $dbh -> quote( $v );

}

sub getrow
{
	my ( $sql, $dbh ) = @_;

	unless( $dbh )
	{
		$dbh = $cached_dbh;
	}

	assert( &dbh_is_ok( $dbh ) );

	return $dbh -> selectrow_hashref( $sql );

}

sub prep
{
	my ( $sql, $dbh ) = @_;

	unless( $dbh )
	{
		$dbh = $cached_dbh;
	}

	assert( &dbh_is_ok( $dbh ) );

	return $dbh -> prepare( $sql );
	
}

sub doit
{
	my ( $sql, $dbh ) = @_;

	unless( $dbh )
	{
		$dbh = $cached_dbh;
	}

	assert( &dbh_is_ok( $dbh ) );


	return $dbh -> do( $sql );
}

sub errstr
{
	my $dbh = shift;

	unless( $dbh )
	{
		$dbh = $cached_dbh;
	}
	assert( &dbh_is_ok( $dbh ) );
	
	return $dbh -> errstr();
}

sub nextval
{
	my ( $sn, $dbh ) = @_;

	unless( $dbh )
	{
		$dbh = $cached_dbh;
	}

	my $sql = sprintf( "SELECT nextval(%s) AS newval", &dbq( $sn, $dbh ) );

	assert( my $rec = &getrow( $sql, $dbh ),
		sprintf( 'could not get new value from sequence %s: %s',
			 $sn,
			 &errstr( $dbh ) ) );

	return $rec -> { 'newval' };
}

42;