File Coverage

blib/lib/LittleORM/Db.pm

Criterion	Covered	Total	%
statement	6	66	9.0
branch	0	26	0.0
condition	0	3	0.0
subroutine	2	14	14.2
pod	0	11	0.0
total	8	120	6.6

use strict;

package LittleORM::Db;

my $cached_read_dbh = [];
my $cached_write_dbh = [];

use Carp::Assert 'assert';

sub dbh_is_ok
{
	my $dbh = shift;

	my $rv = $dbh;

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

	return $rv;
}

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

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

	if( ref( $dbh ) eq 'HASH' )
	{
		my ( $rdbh, $wdbh ) = @{ $dbh }{ 'read', 'write' };
		assert( $rdbh and $wdbh );

		$cached_read_dbh = ( ref( $rdbh ) eq 'ARRAY' ? $rdbh : [ $rdbh ] );
		$cached_write_dbh = ( ref( $wdbh ) eq 'ARRAY' ? $wdbh : [ $wdbh ] );

	} else
	{
		# $cached_dbh = $dbh;
		# old way

		$cached_read_dbh = [ $dbh ];
		$cached_write_dbh = [ $dbh ];
	}
}

sub __get_rand_array_el
{
	my $arr = shift;
# 	return $arr -> [ 0 ]; # not very random


# sub rand_el
# {
# 	my $arr = shift;

	return $arr -> [ rand @{ $arr } ];

#}


# this method is tested to work:


# use strict;


# my @arr = ( 1 .. 10 );

# my %stats = ();

# foreach ( 1 .. 10000 )
# {
# 	$stats{ &rand_el( \@arr ) } ++;
# }

# while( my ( $k, $v ) = each %stats )
# {
# 	print $k, " => ", $v, "\n";
# }


# sub rand_el
# {
# 	my $arr = shift;

# 	return $arr -> [ rand @{ $arr } ];

# }

# 6 => 1023
# 3 => 1000
# 7 => 961
# 9 => 945
# 2 => 998
# 8 => 1040
# 1 => 1071
# 4 => 974
# 10 => 997
# 5 => 991
# eugenek@carbon:~$ perl /tmp/test.pl
# 6 => 995
# 3 => 979
# 7 => 984
# 9 => 1026
# 2 => 983
# 8 => 984
# 4 => 1008
# 1 => 1048
# 10 => 1021
# 5 => 972


}

sub get_dbh
{
	my $for_what = shift;

	my $rv = undef;

	if( $for_what eq 'write' )
	{
		$rv = &get_write_dbh();
	} else
	{
		$rv = &get_read_dbh();
	}
	return $rv;

}

sub get_read_dbh
{
	return &__get_rand_array_el( $cached_read_dbh );
}

sub get_write_dbh
{
	return &__get_rand_array_el( $cached_write_dbh );
}

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

	unless( $dbh )
	{
		$dbh = &get_read_dbh();
	}

	my $rv = undef;

	eval {
		$rv = $dbh -> quote( $v );
	};

	if( my $err = $@ )
	{
		assert( 0, $err );
	}

	return $rv;
}

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

	unless( $dbh )
	{
		warn( "(getrow) no DBH passed, failing back to write DBH" );
		$dbh = &get_write_dbh();
		# assert( 0, 'cant safely fall back to read dbh here' );
	}


	return $dbh -> selectrow_hashref( $sql );

}

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

	unless( $dbh )
	{
		warn( "(prep) no DBH passed, failing back to write DBH" );
		$dbh = &get_write_dbh();
		# assert( 0, 'cant safely fall back to read dbh here' );
	}

	return $dbh -> prepare( $sql );

}

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

	unless( $dbh )
	{
		warn( "(doit) no DBH passed, failing back to write DBH" );
		$dbh = &get_write_dbh();
		#assert( 0, 'cant safely fall back to read dbh here too' );
	}

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

sub errstr
{
	my $dbh = shift;

	return $dbh -> errstr();
}

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

	unless( $dbh )
	{
		$dbh = &get_write_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;