Commit 66da8744d5dccec2f9e1293b737165fb24c3d5e6 - libexception-class-dbi-perl

+2

-0

Changes less more

2	2	0.95
3	3	- Fixed test failure for localized error messages. Reported by Jens
4	4	Maier with a fix from Daniel Brook.
	5	- Updated tests to use is($foo, $bar) instead of ok( $foo == $bar)
	6	Spotted by Andy Lester.
5	7
6	8	0.94 2006-06-30T00:04:32
7	9	- The handler() method now always returns the same code referernce

+7

-3

META.yml less more

0	0	---
1	1	name: Exception-Class-DBI
2		version: 0.94
	2	version: !!perl/hash:Module::Build::Version
	3	original: 0.95
	4	version:
	5	- 0
	6	- 950
3	7	author:
4	8	- 'David Wheeler <david@kineticode.com>'
5	9	abstract: DBI Exception objects

15	19	provides:
16	20	Exception::Class::DBI:
17	21	file: lib/Exception/Class/DBI.pm
18		version: 0.94
	22	version: 0.95
19	23	Exception::Class::DBI::DBH:
20	24	file: lib/Exception/Class/DBI.pm
21	25	Exception::Class::DBI::H:
22	26	file: lib/Exception/Class/DBI.pm
23	27	Exception::Class::DBI::STH:
24	28	file: lib/Exception/Class/DBI.pm
25		generated_by: Module::Build version 0.2801
	29	generated_by: Module::Build version 0.2804
26	30	meta-spec:
27	31	url: http://module-build.sourceforge.net/META-spec-v1.2.html
28	32	version: 1.2

+13

-12

t/dbh.t less more

0	0	#!/usr/bin/perl -w
1	1
2		# $Id: dbh.t,v 1.5 2002/09/17 03:32:47 david Exp $
	2	# $Id$
3	3
4	4	use strict;
5		use Test::More (tests => 27);
6		BEGIN { use_ok('Exception::Class::DBI') }
	5	use Test::More tests => 28;
	6	BEGIN { use_ok('Exception::Class::DBI') or die }
7	7	use DBI;
8	8
9		ok( my $dbh = DBI->connect('dbi:ExampleP:dummy', '', '',
	9	ok( my $dbh = DBI->connect(
	10	'dbi:ExampleP:dummy', '', '',
10	11	{ PrintError => 0,
11	12	RaiseError => 0,
12	13	HandleError => Exception::Class::DBI->handler

30	31	isa_ok( $err, 'Exception::Class::DBI::DBH' );
31	32
32	33	# Check the accessor values.
33		ok( $err->err == 1, "Check err" );
	34	is( $err->err, 1, "Check err" );
34	35	is( $err->errstr, 'Unknown field names: foo', "Check errstr" );
35	36	is( $err->error, 'DBD::ExampleP::db do failed: Unknown field names: foo',
36	37	"Check error" );
37	38	is( $err->state, 'S1000', "Check state" );
38	39	ok( ! defined $err->retval, "Check retval" );
39		ok( $err->warn == 1, "Check warn" );
40		ok( $err->active == 1, "Check active" );
	40	is( $err->warn, 1, "Check warn" );
	41	is( $err->active, 1, "Check active" );
41	42	# For some reason, under perl < 5.8.0, $dbh->{Kids} returns a different value
42	43	# inside the HandleError scope than it does outside that scope. So we're
43	44	# checking for the perl version here to cover our butts on this test. This may
44	45	# be fixed in the DBI soon. I'm using the old form of the Perl version number
45	46	# as it seems safer with older Perls.
46		#ok( $err->kids == ($^V lt v5.8 ? 1 : 0), "Check kids" );
47		ok( $err->kids == ($] < 5.008 ? 1 : 0), "Check kids" );
48		ok( $err->active_kids == 0, "Check active_kids" );
	47	is( $err->kids, ($^V lt v5.8 ? 1 : 0), "Check kids" );
	48	is( $err->kids, ($] < 5.008 ? 1 : 0), "Check kids" );
	49	is( $err->active_kids, 0, "Check active_kids" );
49	50	ok( ! $err->inactive_destroy, "Check inactive_destroy" );
50		ok( $err->trace_level == 0, "Check trace_level" );
	51	is( $err->trace_level, 0, "Check trace_level" );
51	52	is( $err->fetch_hash_key_name, 'NAME', "Check fetch_hash_key_name" );
52	53	ok( ! $err->chop_blanks, "Check chop_blanks" );
53		ok( $err->long_read_len == 80, "Check long_read_len" );
	54	is( $err->long_read_len, 80, "Check long_read_len" );
54	55	ok( ! $err->long_trunc_ok, "Check long_trunc_ok" );
55	56	ok( ! $err->taint, "Check taint" );
56	57	ok( $err->auto_commit, "Check auto_commit" );

+3

-3

t/dbi.t less more

0	0	#!/usr/bin/perl -w
1	1
2		# $Id: dbi.t,v 1.4 2002/12/12 20:15:48 david Exp $
	2	# $Id$
3	3
4	4	use strict;
5		use Test::More (tests => 14);
6		BEGIN { use_ok('Exception::Class::DBI') }
	5	use Test::More tests => 14;
	6	BEGIN { use_ok('Exception::Class::DBI') or die }
7	7	use DBI;
8	8
9	9	eval {

+9

-9

t/drh.t less more

0	0	#!/usr/bin/perl -w
1	1
2		# $Id: drh.t,v 1.5 2002/12/12 20:15:48 david Exp $
	2	# $Id$
3	3
4	4	use strict;
5		use Test::More (tests => 21);
	5	use Test::More tests => 21;
6	6	BEGIN { use_ok('Exception::Class::DBI') }
7	7	use DBI;
8	8

30	30	isa_ok( $err, 'Exception::Class::DBI' );
31	31	isa_ok( $err, 'Exception::Class::DBI::H' );
32	32	isa_ok( $err, 'Exception::Class::DBI::DRH' );
33		ok( $err->err == 7, "Check err" );
	33	is( $err->err, 7, "Check err" );
34	34	is( $err->error, "DBI connect('dummy','',...) failed: Dammit Jim!",
35	35	'Check error' );
36	36	is( $err->errstr, 'Dammit Jim!', 'Check errstr' );
37	37	is( $err->state, 'ABCDE', 'Check state' );
38	38	ok( ! defined $err->retval, "Check retval" );
39		ok( $err->warn == 1, "Check warn" );
40		ok( $err->active == 1, "Check active" );
41		ok( $err->kids == 0, "Check kids" );
42		ok( $err->active_kids == 0, "Check acitive_kids" );
	39	is( $err->warn, 1, "Check warn" );
	40	is( $err->active, 1, "Check active" );
	41	is( $err->kids, 0, "Check kids" );
	42	is( $err->active_kids, 0, "Check acitive_kids" );
43	43	ok( ! $err->inactive_destroy, "Check inactive_destroy" );
44		ok( $err->trace_level == 0, "Check trace_level" );
	44	is( $err->trace_level, 0, "Check trace_level" );
45	45	is( $err->fetch_hash_key_name, 'NAME', "Check fetch_hash_key_name" );
46	46	ok( ! $err->chop_blanks, "Check chop_blanks" );
47		ok( $err->long_read_len == 80, "Check long_read_len" );
	47	is( $err->long_read_len, 80, "Check long_read_len" );
48	48	ok( ! $err->long_trunc_ok, "Check long_trunc_ok" );
49	49	ok( ! $err->taint, "Check taint" );
50	50	}

+10

-10

t/sth.t less more

2	2	# $Id$
3	3
4	4	use strict;
5		use Test::More (tests => 35);
6		BEGIN { use_ok('Exception::Class::DBI') }
	5	use Test::More tests => 35;
	6	BEGIN { use_ok('Exception::Class::DBI') or die }
7	7	# Use PurePerl to get around CursorName bug.
8	8	BEGIN { $ENV{DBI_PUREPERL} = 2 }
9	9	use DBI;

33	33	isa_ok( $err, 'Exception::Class::DBI::H' );
34	34	isa_ok( $err, 'Exception::Class::DBI::STH' );
35	35
36		ok( $err->err == 2, "Check err" );
	36	is( $err->err, 2, "Check err" );
37	37	is( $err->errstr, "opendir(foo): $bang",
38	38	"Check errstr" );
39	39	like( $err->error,

42	42	is( $err->state, 'S1000', "Check state" );
43	43	ok( ! defined $err->retval, "Check retval" );
44	44
45		ok( $err->warn == 1, 'Check warn' );
	45	is( $err->warn, 1, 'Check warn' );
46	46	ok( !$err->active, 'Check active' );
47		ok( $err->kids == 0, 'Check kids' );
48		ok( $err->active_kids == 0, 'Check active_kids' );
	47	is( $err->kids, 0, 'Check kids' );
	48	is( $err->active_kids, 0, 'Check active_kids' );
49	49	ok( ! $err->compat_mode, 'Check compat_mode' );
50	50	ok( ! $err->inactive_destroy, 'Check inactive_destroy' );
51	51

53	53	# PurePerl->{TraceLevel} should return an integer, but it doesn't. It
54	54	# returns undef instead.
55	55	local $^W;
56		ok( $err->trace_level == 0, 'Check trace_level' );
	56	cmp_ok( $err->trace_level, '==', 0, 'Check trace_level' );
57	57	}
58	58
59	59	is( $err->fetch_hash_key_name, 'NAME', 'Check fetch_hash_key_name' );
60	60	ok( ! $err->chop_blanks, 'Check chop_blanks' );
61		ok( $err->long_read_len == 80, 'Check long_read_len' );
	61	is( $err->long_read_len, 80, 'Check long_read_len' );
62	62	ok( ! $err->long_trunc_ok, 'Check long_trunc_ok' );
63	63	ok( ! $err->taint, 'Check taint' );
64		ok( $err->num_of_fields == 14, 'Check num_of_fields' );
65		ok( $err->num_of_params == 0, 'Check num_of_params' );
	64	is( $err->num_of_fields, 14, 'Check num_of_fields' );
	65	is( $err->num_of_params, 0, 'Check num_of_params' );
66	66	is( ref $err->field_names, 'ARRAY', "Check field_names" );
67	67
68	68	# These tend to return undef. Probably ought to try to add tests to make