Commit 7608e26a4ca499ad36eb13afb9ebd4b38b5e4c60 - libdbix-class-perl

+33

-0

Changes less more

0	0	Revision history for DBIx::Class
	1
	2	0.08193 2011-07-14 17:00 (UTC)
	3	* New Features / Changes
	4	- Allow schema cloning to mutate attributes
	5	- DBIC now attempts more aggressive de-duplication of where
	6	conditions on resultset chaining
	7	- The Ordered component is now smarter wrt reordering of dirty
	8	objects, and does its job with less storage queries
	9	- Logging via DBIC_TRACE=1=<filename> no longer overwrites the
	10	logfile on every program startup, appending loglines instead
	11
	12	* Fixes
	13	- Fix issue where the query was becoming overly mangled when trying
	14	to use pagination with a query that has a sub-select in the WHERE
	15	clause
	16	- Fix possible incorrect pagination on Oracle, when a resultset
	17	is not ordered by a unique column
	18	- Revert "Fix incorrect signature of the default sqlt_deploy_hook"
	19	from 0.08191 - documentation was in fact incorrect, not the code
	20	- Fix Sybase ASE IC::DateTime support (::Storage going out of sync
	21	with new default format expected by DateTime::Format::Sybase)
	22	- Fix a bug in update_all() resulting in the first row receiving a
	23	different dataset than the subsequent ones
	24	- Accomodate MSAccess supporting only 'INNER JOIN' (not plain 'JOIN')
	25	- InflateColumn::DateTime option datetime_undef_if_invalid no longer
	26	masks missing dependency exceptions (RT#66823)
	27	- Fix bug in Schema::Versioned failing to insert a schema version row
	28	during upgrades at the turn of the second
	29	- Fix incorrect bind of integers >= 2^^32 (bigint columns) to
	30	SQL_INTEGER, resulting in silent conversion to '-1'
	31	- Fix pre 5.10 failures of t/55namespaces_cleaned.t due to buggy
	32	require() (RT#68814)
	33	- Oracle autoinc inserts no longer leave open cursors behind
1	34
2	35	0.08192 2011-05-10 04:20 (UTC)
3	36	* Fixes

+5

-0

MANIFEST less more

351	351	t/inflate/datetime_determine_parser.t
352	352	t/inflate/datetime_firebird.t
353	353	t/inflate/datetime_informix.t
	354	t/inflate/datetime_missing_deps.t
354	355	t/inflate/datetime_msaccess.t
355	356	t/inflate/datetime_mssql.t
356	357	t/inflate/datetime_mysql.t

390	391	t/lib/DBICTest/BaseResult.pm
391	392	t/lib/DBICTest/BaseResultSet.pm
392	393	t/lib/DBICTest/Cursor.pm
	394	t/lib/DBICTest/DeployComponent.pm
393	395	t/lib/DBICTest/ErrorComponent.pm
394	396	t/lib/DBICTest/FakeComponent.pm
395	397	t/lib/DBICTest/ForeignComponent.pm

538	540	t/resultset_class.t
539	541	t/resultset_overload.t
540	542	t/row/filter_column.t
	543	t/row/find_one_has_many.t
541	544	t/row/inflate_result.t
542	545	t/row/pkless.t
543	546	t/schema/anon.t

594	597	t/storage/stats.t
595	598	t/storage/txn.t
596	599	t/storage/txn_scope_guard.t
	600	t/update/all.t
	601	t/update/ident_cond.t
597	602	t/update/type_aware.t
598	603	t/zzzzzzz_perl_perf_bug.t
599	604	t/zzzzzzz_sqlite_deadlock.t

+4

-2

META.yml less more

12	12	configure_requires:
13	13	ExtUtils::MakeMaker: 6.42
14	14	distribution_type: module
15		generated_by: 'Module::Install version 1.00'
	15	generated_by: 'Module::Install version 1.01'
16	16	license: perl
17	17	meta-spec:
18	18	url: http://module-build.sourceforge.net/META-spec-v1.4.html

37	37	Config::Any: 0.20
38	38	Context::Preserve: 0.01
39	39	DBI: 1.57
	40	Data::Compare: 1.22
40	41	Data::Dumper::Concise: 2.020
41	42	Data::Page: 2.00
42	43	File::Path: 2.07

47	48	SQL::Abstract: 1.72
48	49	Scope::Guard: 0.03
49	50	Sub::Name: 0.04
	51	Test::Deep: 0.108
50	52	Try::Tiny: 0.04
51	53	Variable::Magic: 0.44
52	54	namespace::clean: 0.20

58	60	homepage: http://www.dbix-class.org/
59	61	license: http://dev.perl.org/licenses/
60	62	repository: git://git.shadowcat.co.uk/dbsrgits/DBIx-Class.git
61		version: 0.08192
	63	version: 0.08193

+2

-0

Makefile.PL less more

72	72	'Path::Class' => '0.18',
73	73	'Scope::Guard' => '0.03',
74	74	'SQL::Abstract' => '1.72',
	75	'Test::Deep' => '0.108',
75	76	'Try::Tiny' => '0.04',
	77	'Data::Compare' => '1.22',
76	78
77	79	# XS (or XS-dependent) libs
78	80	'DBI' => '1.57',

+1

-1

README less more

41	41	__PACKAGE__->table('artist');
42	42	__PACKAGE__->add_columns(qw/ artistid name /);
43	43	__PACKAGE__->set_primary_key('artistid');
44		__PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
	44	__PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD', 'artistid');
45	45
46	46	1;
47	47

+1

-1

inc/Module/Install/AutoInstall.pm less more

5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '1.00';
	8	$VERSION = '1.01';
9	9	@ISA = 'Module::Install::Base';
10	10	$ISCORE = 1;
11	11	}

+1

-1

inc/Module/Install/Base.pm less more

3	3	use strict 'vars';
4	4	use vars qw{$VERSION};
5	5	BEGIN {
6		$VERSION = '1.00';
	6	$VERSION = '1.01';
7	7	}
8	8
9	9	# Suspend handler for "redefined" warnings

+1

-1

inc/Module/Install/Can.pm less more

8	8
9	9	use vars qw{$VERSION @ISA $ISCORE};
10	10	BEGIN {
11		$VERSION = '1.00';
	11	$VERSION = '1.01';
12	12	@ISA = 'Module::Install::Base';
13	13	$ISCORE = 1;
14	14	}

+1

-1

inc/Module/Install/Fetch.pm less more

5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '1.00';
	8	$VERSION = '1.01';
9	9	@ISA = 'Module::Install::Base';
10	10	$ISCORE = 1;
11	11	}

+1

-1

inc/Module/Install/Include.pm less more

5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '1.00';
	8	$VERSION = '1.01';
9	9	@ISA = 'Module::Install::Base';
10	10	$ISCORE = 1;
11	11	}

+1

-1

inc/Module/Install/Makefile.pm less more

7	7
8	8	use vars qw{$VERSION @ISA $ISCORE};
9	9	BEGIN {
10		$VERSION = '1.00';
	10	$VERSION = '1.01';
11	11	@ISA = 'Module::Install::Base';
12	12	$ISCORE = 1;
13	13	}

+5

-4

inc/Module/Install/Metadata.pm less more

5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '1.00';
	8	$VERSION = '1.01';
9	9	@ISA = 'Module::Install::Base';
10	10	$ISCORE = 1;
11	11	}

514	514	'GNU Free Documentation license' => 'unrestricted', 1,
515	515	'GNU Affero General Public License' => 'open_source', 1,
516	516	'(?:Free)?BSD license' => 'bsd', 1,
	517	'Artistic license 2\.0' => 'artistic_2', 1,
517	518	'Artistic license' => 'artistic', 1,
518	519	'Apache (?:Software )?license' => 'apache', 1,
519	520	'GPL' => 'gpl', 1,

549	550
550	551	sub _extract_bugtracker {
551	552	my @links = $_[0] =~ m#L<(
552		\Qhttp://rt.cpan.org/\E[^>]+\|
553		\Qhttp://github.com/\E[\w_]+/[\w_]+/issues\|
554		\Qhttp://code.google.com/p/\E[\w_\-]+/issues/list
	553	https?\Q://rt.cpan.org/\E[^>]+\|
	554	https?\Q://github.com/\E[\w_]+/[\w_]+/issues\|
	555	https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
555	556	)>#gx;
556	557	my %links;
557	558	@links{@links}=();

+1

-1

inc/Module/Install/Scripts.pm less more

5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '1.00';
	8	$VERSION = '1.01';
9	9	@ISA = 'Module::Install::Base';
10	10	$ISCORE = 1;
11	11	}

+1

-1

inc/Module/Install/Win32.pm less more

5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '1.00';
	8	$VERSION = '1.01';
9	9	@ISA = 'Module::Install::Base';
10	10	$ISCORE = 1;
11	11	}

+1

-1

inc/Module/Install/WriteAll.pm less more

5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '1.00';
	8	$VERSION = '1.01';
9	9	@ISA = qw{Module::Install::Base};
10	10	$ISCORE = 1;
11	11	}

+2

-2

inc/Module/Install.pm less more

30	30	# This is not enforced yet, but will be some time in the next few
31	31	# releases once we can make sure it won't clash with custom
32	32	# Module::Install extensions.
33		$VERSION = '1.00';
	33	$VERSION = '1.01';
34	34
35	35	# Storage for the pseudo-singleton
36	36	$MAIN = undef;

466	466
467	467	1;
468	468
469		# Copyright 2008 - 2010 Adam Kennedy.
	469	# Copyright 2008 - 2011 Adam Kennedy.

+4

-2

lib/DBIx/Class/CDBICompat/ImaDBI.pm less more

54	54	$self->throw_exception( "No relationship to JOIN from ${from_class} to ${to_class}" )
55	55	unless $rel_obj;
56	56	my $join = $from_class->storage->sql_maker->_join_condition(
57		$from_class->result_source_instance->_resolve_condition(
58		$rel_obj->{cond}, $to, $from) );
	57	scalar $from_class->result_source_instance->_resolve_condition(
	58	$rel_obj->{cond}, $to, $from
	59	)
	60	);
59	61	return $join;
60	62	}
61	63

+14

-9

lib/DBIx/Class/InflateColumn/DateTime.pm less more

168	168	inflate => sub {
169	169	my ($value, $obj) = @_;
170	170
171		my $dt = try
172		{ $obj->_inflate_to_datetime( $value, $infcopy ) }
173		catch {
174		$self->throw_exception ("Error while inflating ${value} for ${column} on ${self}: $_")
175		unless $infcopy->{datetime_undef_if_invalid};
176		undef; # rv
177		};
	171	# propagate for error reporting
	172	$infcopy->{__dbic_colname} = $column;
	173
	174	my $dt = $obj->_inflate_to_datetime( $value, $infcopy );
178	175
179	176	return (defined $dt)
180	177	? $obj->_post_inflate_datetime( $dt, $infcopy )

197	194
198	195	my $parser = $self->_datetime_parser;
199	196	my $preferred_method = sprintf($method_fmt, $info->{ _ic_dt_method });
200		my $method = $parser->can($preferred_method) ? $preferred_method : sprintf($method_fmt, 'datetime');
201		return $parser->$method($value);
	197	my $method = $parser->can($preferred_method) \|\| sprintf($method_fmt, 'datetime');
	198
	199	return try {
	200	$parser->$method($value);
	201	}
	202	catch {
	203	$self->throw_exception ("Error while inflating ${value} for $info->{__dbic_colname} on ${self}: $_")
	204	unless $info->{datetime_undef_if_invalid};
	205	undef; # rv
	206	};
202	207	}
203	208
204	209	sub _inflate_to_datetime {

+143

-3

lib/DBIx/Class/Optional/Dependencies.pm less more

75	75	my $rdbms_db2 = {
76	76	'DBD::DB2' => '0',
77	77	};
	78	my $rdbms_db2_400 = {
	79	'DBD::ODBC' => '0',
	80	};
	81	my $rdbms_informix = {
	82	'DBD::Informix' => '0',
	83	};
	84	my $rdbms_sqlanywhere = {
	85	'DBD::SQLAnywhere' => '0',
	86	};
	87	my $rdbms_sqlanywhere_odbc = {
	88	'DBD::ODBC' => '0',
	89	};
	90	my $rdbms_firebird = {
	91	'DBD::Firebird' => '0',
	92	};
	93	my $rdbms_firebird_interbase = {
	94	'DBD::InterBase' => '0',
	95	};
78	96	my $rdbms_firebird_odbc = {
79	97	'DBD::ODBC' => '0',
80	98	};

333	351	},
334	352	},
335	353
	354	rdbms_db2_400 => {
	355	req => {
	356	%$rdbms_db2_400,
	357	},
	358	pod => {
	359	title => 'DB2 on AS/400 support',
	360	desc => 'Modules required to connect to DB2 on AS/400',
	361	},
	362	},
	363
	364	rdbms_informix => {
	365	req => {
	366	%$rdbms_informix,
	367	},
	368	pod => {
	369	title => 'Informix support',
	370	desc => 'Modules required to connect to Informix',
	371	},
	372	},
	373
	374	rdbms_sqlanywhere => {
	375	req => {
	376	%$rdbms_sqlanywhere,
	377	},
	378	pod => {
	379	title => 'SQLAnywhere support',
	380	desc => 'Modules required to connect to SQLAnywhere',
	381	},
	382	},
	383
	384	rdbms_sqlanywhere_odbc => {
	385	req => {
	386	%$rdbms_sqlanywhere_odbc,
	387	},
	388	pod => {
	389	title => 'SQLAnywhere support via DBD::ODBC',
	390	desc => 'Modules required to connect to SQLAnywhere via DBD::ODBC',
	391	},
	392	},
	393
	394	rdbms_firebird => {
	395	req => {
	396	%$rdbms_firebird,
	397	},
	398	pod => {
	399	title => 'Firebird support',
	400	desc => 'Modules required to connect to Firebird',
	401	},
	402	},
	403
	404	rdbms_firebird_interbase => {
	405	req => {
	406	%$rdbms_firebird_interbase,
	407	},
	408	pod => {
	409	title => 'Firebird support via DBD::InterBase',
	410	desc => 'Modules required to connect to Firebird via DBD::InterBase',
	411	},
	412	},
	413
	414	rdbms_firebird_odbc => {
	415	req => {
	416	%$rdbms_firebird_odbc,
	417	},
	418	pod => {
	419	title => 'Firebird support via DBD::ODBC',
	420	desc => 'Modules required to connect to Firebird via DBD::ODBC',
	421	},
	422	},
	423
336	424	# the order does matter because the rdbms support group might require
337	425	# a different version that the test group
338	426	test_rdbms_pg => {

340	428	$ENV{DBICTEST_PG_DSN}
341	429	? (
342	430	%$rdbms_pg,
343		'Sys::SigAction' => '0',
	431	($^O ne 'MSWin32' ? ('Sys::SigAction' => '0') : ()),
344	432	'DBD::Pg' => '2.009002',
345	433	) : ()
346	434	},

420	508	$ENV{DBICTEST_SYBASE_DSN}
421	509	? (
422	510	%$rdbms_ase,
423		'DateTime::Format::Sybase' => '0',
424	511	) : ()
425	512	},
426	513	},

430	517	$ENV{DBICTEST_DB2_DSN}
431	518	? (
432	519	%$rdbms_db2,
	520	) : ()
	521	},
	522	},
	523
	524	test_rdbms_db2_400 => {
	525	req => {
	526	$ENV{DBICTEST_DB2_400_DSN}
	527	? (
	528	%$rdbms_db2_400,
	529	) : ()
	530	},
	531	},
	532
	533	test_rdbms_informix => {
	534	req => {
	535	$ENV{DBICTEST_INFORMIX_DSN}
	536	? (
	537	%$rdbms_informix,
	538	) : ()
	539	},
	540	},
	541
	542	test_rdbms_sqlanywhere => {
	543	req => {
	544	$ENV{DBICTEST_SQLANYWHERE_DSN}
	545	? (
	546	%$rdbms_sqlanywhere,
	547	) : ()
	548	},
	549	},
	550
	551	test_rdbms_sqlanywhere_odbc => {
	552	req => {
	553	$ENV{DBICTEST_SQLANYWHERE_ODBC_DSN}
	554	? (
	555	%$rdbms_sqlanywhere_odbc,
	556	) : ()
	557	},
	558	},
	559
	560	test_rdbms_firebird => {
	561	req => {
	562	$ENV{DBICTEST_FIREBIRD_DSN}
	563	? (
	564	%$rdbms_firebird,
	565	) : ()
	566	},
	567	},
	568
	569	test_rdbms_firebird_interbase => {
	570	req => {
	571	$ENV{DBICTEST_FIREBIRD_INTERBASE_DSN}
	572	? (
	573	%$rdbms_firebird_interbase,
433	574	) : ()
434	575	},
435	576	},

520	661	if (keys %errors) {
521	662	my $missing = join (', ', map { $deps->{$_} ? "$_ >= $deps->{$_}" : $_ } (sort keys %errors) );
522	663	$missing .= " (see $class for details)" if $reqs->{$group}{pod};
523		$missing .= "\n";
524	664	$res = {
525	665	status => 0,
526	666	errorlist => \%errors,

+85

-1

lib/DBIx/Class/Optional/Dependencies.pod less more

17	17
18	18	...
19	19
20		configure_requires 'DBIx::Class' => '0.08192';
	20	configure_requires 'DBIx::Class' => '0.08193';
21	21
22	22	require DBIx::Class::Optional::Dependencies;
23	23

136	136
137	137	Requirement group: B<rdbms_db2>
138	138
	139	=head2 DB2 on AS/400 support
	140
	141	Modules required to connect to DB2 on AS/400
	142
	143	=over
	144
	145	=item * DBD::ODBC
	146
	147	=back
	148
	149	Requirement group: B<rdbms_db2_400>
	150
	151	=head2 Firebird support
	152
	153	Modules required to connect to Firebird
	154
	155	=over
	156
	157	=item * DBD::Firebird
	158
	159	=back
	160
	161	Requirement group: B<rdbms_firebird>
	162
	163	=head2 Firebird support via DBD::InterBase
	164
	165	Modules required to connect to Firebird via DBD::InterBase
	166
	167	=over
	168
	169	=item * DBD::InterBase
	170
	171	=back
	172
	173	Requirement group: B<rdbms_firebird_interbase>
	174
	175	=head2 Firebird support via DBD::ODBC
	176
	177	Modules required to connect to Firebird via DBD::ODBC
	178
	179	=over
	180
	181	=item * DBD::ODBC
	182
	183	=back
	184
	185	Requirement group: B<rdbms_firebird_odbc>
	186
	187	=head2 Informix support
	188
	189	Modules required to connect to Informix
	190
	191	=over
	192
	193	=item * DBD::Informix
	194
	195	=back
	196
	197	Requirement group: B<rdbms_informix>
	198
139	199	=head2 MS Access support via DBD::ADO (Windows only)
140	200
141	201	Modules required to connect to MS Access via DBD::ADO. This particular DBD is available on Windows only

235	295	=back
236	296
237	297	Requirement group: B<rdbms_pg>
	298
	299	=head2 SQLAnywhere support
	300
	301	Modules required to connect to SQLAnywhere
	302
	303	=over
	304
	305	=item * DBD::SQLAnywhere
	306
	307	=back
	308
	309	Requirement group: B<rdbms_sqlanywhere>
	310
	311	=head2 SQLAnywhere support via DBD::ODBC
	312
	313	Modules required to connect to SQLAnywhere via DBD::ODBC
	314
	315	=over
	316
	317	=item * DBD::ODBC
	318
	319	=back
	320
	321	Requirement group: B<rdbms_sqlanywhere_odbc>
238	322
239	323	=head2 SQLite support
240	324

+91

-145

lib/DBIx/Class/Ordered.pm less more

1	1	use strict;
2	2	use warnings;
3	3	use base qw( DBIx::Class );
	4
	5	use List::Util 'first';
	6	use namespace::clean;
4	7
5	8	=head1 NAME
6	9

363	366
364	367	my $position_column = $self->position_column;
365	368
366		my $guard;
367
368	369	if ($self->is_column_changed ($position_column) ) {
369		# something changed our position, we have no idea where we
370		# used to be - requery without using discard_changes
371		# (we need only a specific column back)
372
373		$guard = $self->result_source->schema->txn_scope_guard;
374
375		my $cursor = $self->result_source->resultset->search(
376		$self->ident_condition,
377		{ select => $position_column },
378		)->cursor;
379
380		my ($pos) = $cursor->next;
381		$self->$position_column ($pos);
	370	# something changed our position, we need to know where we
	371	# used to be - use the stashed value
	372	$self->store_column($position_column, delete $self->{_column_data_in_storage}{$position_column});
382	373	delete $self->{_dirty_columns}{$position_column};
383	374	}
384	375
385	376	my $from_position = $self->_position;
386	377
387	378	if ( $from_position == $to_position ) { # FIXME this will not work for non-numeric order
388		$guard->commit if $guard;
389	379	return 0;
390	380	}
391	381
392		$guard \|\|= $self->result_source->schema->txn_scope_guard;
	382	my $guard = $self->result_source->schema->txn_scope_guard;
393	383
394	384	my ($direction, @between);
395	385	if ( $from_position < $to_position ) {

446	436	return 0 if ( defined($to_position) and $to_position < 1 );
447	437
448	438	# check if someone changed the _grouping_columns - this will
449		# prevent _is_in_group working, so we need to requery the db
450		# for the original values
451		my (@dirty_cols, %values, $guard);
	439	# prevent _is_in_group working, so we need to restore the
	440	# original stashed values
452	441	for ($self->_grouping_columns) {
453		$values{$_} = $self->get_column ($_);
454		push @dirty_cols, $_ if $self->is_column_changed ($_);
455		}
456
457		# re-query only the dirty columns, and restore them on the
458		# object (subsequent code will update them to the correct
459		# after-move values)
460		if (@dirty_cols) {
461		$guard = $self->result_source->schema->txn_scope_guard;
462
463		my $cursor = $self->result_source->resultset->search(
464		$self->ident_condition,
465		{ select => \@dirty_cols },
466		)->cursor;
467
468		my @original_values = $cursor->next;
469		$self->set_inflated_columns ({ %values, map { $_ => shift @original_values } (@dirty_cols) });
470		delete $self->{_dirty_columns}{$_} for (@dirty_cols);
	442	if ($self->is_column_changed ($_)) {
	443	$self->store_column($_, delete $self->{_column_data_in_storage}{$_});
	444	delete $self->{_dirty_columns}{$_};
	445	}
471	446	}
472	447
473	448	if ($self->_is_in_group ($to_group) ) {

476	451	$ret = $self->move_to ($to_position);
477	452	}
478	453
479		$guard->commit if $guard;
480	454	return $ret\|\|0;
481	455	}
482	456
483		$guard \|\|= $self->result_source->schema->txn_scope_guard;
	457	my $guard = $self->result_source->schema->txn_scope_guard;
484	458
485	459	# Move to end of current group to adjust siblings
486	460	$self->move_last;

548	522	=cut
549	523
550	524	sub update {
551		my $self = shift;
552
553		# this is set by _ordered_internal_update()
554		return $self->next::method(@_) if $self->{_ORDERED_INTERNAL_UPDATE};
555
556		my $position_column = $self->position_column;
557		my @ordering_columns = ($self->_grouping_columns, $position_column);
558
559
560		# these steps are necessary to keep the external appearance of
561		# ->update($upd) so that other things overloading update() will
562		# work properly
563		my %original_values = $self->get_columns;
564		my %existing_changes = $self->get_dirty_columns;
565
566		# See if any of the supplied changes would affect the ordering
567		# The reason this is so contrived, is that we want to leverage
568		# the datatype aware value comparing, while at the same time
569		# keep the original value intact (it will be updated later by the
570		# corresponding routine)
571
572		my %upd = %{shift \|\| {}};
573		my %changes = %existing_changes;
574
575		for (@ordering_columns) {
576		next unless exists $upd{$_};
577
578		# we do not want to keep propagating this to next::method
579		# as it will be a done deal by the time get there
580		my $value = delete $upd{$_};
581		$self->set_inflated_columns ({ $_ => $value });
582
583		# see if an update resulted in a dirty column
584		# it is important to preserve the old value, as it
585		# will be needed to carry on a successfull move()
586		# operation without re-querying the database
587		if ($self->is_column_changed ($_) && not exists $existing_changes{$_}) {
588		$changes{$_} = $value;
589		$self->set_inflated_columns ({ $_ => $original_values{$_} });
590		delete $self->{_dirty_columns}{$_};
591		}
592		}
593
594		# if nothing group/position related changed - short circuit
595		if (not grep { exists $changes{$_} } ( @ordering_columns ) ) {
596		return $self->next::method( \%upd, @_ );
597		}
598
599		{
600		my $guard = $self->result_source->schema->txn_scope_guard;
601
602		# if any of our grouping columns have been changed
603		if (grep { exists $changes{$_} } ($self->_grouping_columns) ) {
604
605		# create new_group by taking the current group and inserting changes
606		my $new_group = {$self->_grouping_clause};
607		foreach my $col (keys %$new_group) {
608		$new_group->{$col} = $changes{$col} if exists $changes{$col};
609		}
610
611		$self->move_to_group(
612		$new_group,
613		(exists $changes{$position_column}
614		# The FIXME bit contradicts the documentation: POD states that
615		# when changing groups without supplying explicit positions in
616		# move_to_group(), we push the item to the end of the group.
617		# However when I was rewriting this, the position from the old
618		# group was clearly passed to the new one
619		# Probably needs to go away (by ribasushi)
620		? $changes{$position_column} # means there was a position change supplied with the update too
621		: $self->_position # FIXME! (replace with undef)
622		),
623		);
624		}
625		elsif (exists $changes{$position_column}) {
626		$self->move_to($changes{$position_column});
627		}
628
629		my @res;
630		if (not defined wantarray) {
631		$self->next::method( \%upd, @_ );
632		}
633		elsif (wantarray) {
634		@res = $self->next::method( \%upd, @_ );
635		}
636		else {
637		$res[0] = $self->next::method( \%upd, @_ );
638		}
639
640		$guard->commit;
641		return wantarray ? @res : $res[0];
642		}
	525	my $self = shift;
	526
	527	# this is set by _ordered_internal_update()
	528	return $self->next::method(@_) if $self->result_source->schema->{_ORDERED_INTERNAL_UPDATE};
	529
	530	my $upd = shift;
	531	$self->set_inflated_columns($upd) if $upd;
	532
	533	my $position_column = $self->position_column;
	534	my @group_columns = $self->_grouping_columns;
	535
	536	# see if the order is already changed
	537	my $changed_ordering_cols = { map { $_ => $self->get_column($_) } grep { $self->is_column_changed($_) } ($position_column, @group_columns) };
	538
	539	# nothing changed - short circuit
	540	if (! keys %$changed_ordering_cols) {
	541	return $self->next::method( undef, @_ );
	542	}
	543	elsif (defined first { exists $changed_ordering_cols->{$_} } @group_columns ) {
	544	$self->move_to_group(
	545	# since the columns are already re-set the _grouping_clause is correct
	546	# move_to_group() knows how to get the original storage values
	547	{ $self->_grouping_clause },
	548
	549	# The FIXME bit contradicts the documentation: POD states that
	550	# when changing groups without supplying explicit positions in
	551	# move_to_group(), we push the item to the end of the group.
	552	# However when I was rewriting this, the position from the old
	553	# group was clearly passed to the new one
	554	# Probably needs to go away (by ribasushi)
	555	(exists $changed_ordering_cols->{$position_column}
	556	? $changed_ordering_cols->{$position_column} # means there was a position change supplied with the update too
	557	: $self->_position # FIXME! (replace with undef)
	558	),
	559	);
	560	}
	561	else {
	562	$self->move_to($changed_ordering_cols->{$position_column});
	563	}
	564
	565	return $self;
643	566	}
644	567
645	568	=head2 delete
646	569
647		Overrides the DBIC delete() method by first moving the object
	570	Overrides the DBIC delete() method by first moving the object
648	571	to the last position, then deleting it, thus ensuring the
649	572	integrity of the positions.
650	573

670	593
671	594	$guard->commit;
672	595	return wantarray ? @res : $res[0];
	596	}
	597
	598	# add the current position/group to the things we track old values for
	599	sub _track_storage_value {
	600	my ($self, $col) = @_;
	601	return $self->next::method($col) \|\| defined first { $_ eq $col } ($self->position_column, $self->_grouping_columns);
673	602	}
674	603
675	604	=head1 METHODS FOR EXTENDING ORDERED

789	718	# increment/decrement. So what we do here is check if the
790	719	# position column is part of a unique constraint, and do a
791	720	# one-by-one update if this is the case
	721	# Also we do a one-by-one if the position is part of the PK
	722	# since once we update a column via scalarref we lose the
	723	# ability to retrieve this column back (we do not know the
	724	# id anymore)
792	725
793	726	my $rsrc = $self->result_source;
794	727
795		if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->unique_constraints }} ) ) ) {
796
797		my @pcols = $rsrc->_pri_cols;
798		my $cursor = $shift_rs->search ({}, { order_by => { "-$ord", $position_column }, columns => \@pcols } )->cursor;
	728	# set in case there are more cascades combined with $rs->update => $rs_update_all overrides
	729	local $rsrc->schema->{_ORDERED_INTERNAL_UPDATE} = 1;
	730	my @pcols = $rsrc->primary_columns;
	731	my $pos_is_pk = first { $_ eq $position_column } @pcols;
	732	if (
	733	$pos_is_pk
	734	or
	735	first { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->unique_constraints }} ) )
	736	) {
	737	my $cursor = $shift_rs->search (
	738	{}, { order_by => { "-$ord", $position_column }, select => [$position_column, @pcols] }
	739	)->cursor;
799	740	my $rs = $self->result_source->resultset;
800	741
801		my @all_pks = $cursor->all;
802		while (my $pks = shift @all_pks) {
	742	my @all_data = $cursor->all;
	743	while (my $data = shift @all_data) {
	744	my $pos = shift @$data;
803	745	my $cond;
804	746	for my $i (0.. $#pcols) {
805		$cond->{$pcols[$i]} = $pks->[$i];
	747	$cond->{$pcols[$i]} = $data->[$i];
806	748	}
807	749
808		$rs->search($cond)->update ({ $position_column => \ "$position_column $op 1" } );
	750	$rs->find($cond)->update ({ $position_column => $pos + ( ($op eq '+') ? 1 : -1 ) });
809	751	}
810	752	}
811	753	else {

838	780	sub _siblings {
839	781	my $self = shift;
840	782	my $position_column = $self->position_column;
841		return $self->_group_rs->search(
842		{ $position_column => { '!=' => $self->get_column($position_column) } },
843		);
	783	my $pos;
	784	return defined ($pos = $self->get_column($position_column))
	785	? $self->_group_rs->search(
	786	{ $position_column => { '!=' => $pos } },
	787	)
	788	: $self->_group_rs
	789	;
844	790	}
845	791
846	792	=head2 _position

930	876
931	877	sub _ordered_internal_update {
932	878	my $self = shift;
933		local $self->{_ORDERED_INTERNAL_UPDATE} = 1;
	879	local $self->result_source->schema->{_ORDERED_INTERNAL_UPDATE} = 1;
934	880	return $self->update (@_);
935	881	}
936	882

+15

-4

lib/DBIx/Class/PK.pm less more

35	35	}
36	36
37	37	sub _ident_values {
38		my ($self) = @_;
	38	my ($self, $use_storage_state) = @_;
39	39
40	40	my (@ids, @missing);
41	41
42	42	for ($self->_pri_cols) {
43		push @ids, $self->get_column($_);
	43	push @ids, ($use_storage_state and exists $self->{_column_data_in_storage}{$_})
	44	? $self->{_column_data_in_storage}{$_}
	45	: $self->get_column($_)
	46	;
44	47	push @missing, $_ if (! defined $ids[-1] and ! $self->has_column_loaded ($_) );
45	48	}
46	49

99	102	=cut
100	103
101	104	sub ident_condition {
102		my ($self, $alias) = @_;
	105	shift->_mk_ident_cond(@_);
	106	}
	107
	108	sub _storage_ident_condition {
	109	shift->_mk_ident_cond(shift, 1);
	110	}
	111
	112	sub _mk_ident_cond {
	113	my ($self, $alias, $use_storage_state) = @_;
103	114
104	115	my @pks = $self->_pri_cols;
105		my @vals = $self->_ident_values;
	116	my @vals = $self->_ident_values($use_storage_state);
106	117
107	118	my (%cond, @undef);
108	119	my $prefix = defined $alias ? $alias.'.' : '';

+55

-10

lib/DBIx/Class/ResultSet.pm less more

7	7	use DBIx::Class::ResultSetColumn;
8	8	use Scalar::Util qw/blessed weaken/;
9	9	use Try::Tiny;
	10	use Data::Compare;
10	11
11	12	# not importing first() as it will clash with our own method
12	13	use List::Util ();

85	86	sub get_data {
86	87	my $self = shift;
87	88	my $request = $self->get_request; # Get a request object somehow.
88		my $schema = $self->get_schema; # Get the DBIC schema object somehow.
	89	my $schema = $self->result_source->schema;
89	90
90	91	my $cd_rs = $schema->resultset('CD')->search({
91	92	title => $request->param('title'),

528	529
529	530	sub _stack_cond {
530	531	my ($self, $left, $right) = @_;
	532
	533	# collapse single element top-level conditions
	534	# (single pass only, unlikely to need recursion)
	535	for ($left, $right) {
	536	if (ref $_ eq 'ARRAY') {
	537	if (@$_ == 0) {
	538	$_ = undef;
	539	}
	540	elsif (@$_ == 1) {
	541	$_ = $_->[0];
	542	}
	543	}
	544	elsif (ref $_ eq 'HASH') {
	545	my ($first, $more) = keys %$_;
	546
	547	# empty hash
	548	if (! defined $first) {
	549	$_ = undef;
	550	}
	551	# one element hash
	552	elsif (! defined $more) {
	553	if ($first eq '-and' and ref $_->{'-and'} eq 'HASH') {
	554	$_ = $_->{'-and'};
	555	}
	556	elsif ($first eq '-or' and ref $_->{'-or'} eq 'ARRAY') {
	557	$_ = $_->{'-or'};
	558	}
	559	}
	560	}
	561	}
	562
	563	# merge hashes with weeding out of duplicates (simple cases only)
	564	if (ref $left eq 'HASH' and ref $right eq 'HASH') {
	565
	566	# shallow copy to destroy
	567	$right = { %$right };
	568	for (grep { exists $right->{$_} } keys %$left) {
	569	# the use of eq_deeply here is justified - the rhs of an
	570	# expression can contain a lot of twisted weird stuff
	571	delete $right->{$_} if Compare( $left->{$_}, $right->{$_} );
	572	}
	573
	574	$right = undef unless keys %$right;
	575	}
	576
	577
531	578	if (defined $left xor defined $right) {
532	579	return defined $left ? $left : $right;
533	580	}
534		elsif (defined $left) {
535		return { -and => [ map
536		{ ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
537		($left, $right)
538		]};
539		}
540
541		return undef;
	581	elsif (! defined $left) {
	582	return undef;
	583	}
	584	else {
	585	return { -and => [ $left, $right ] };
	586	}
542	587	}
543	588
544	589	=head2 search_literal

1784	1829	unless ref $values eq 'HASH';
1785	1830
1786	1831	my $guard = $self->result_source->schema->txn_scope_guard;
1787		$_->update($values) for $self->all;
	1832	$_->update({%$values}) for $self->all; # shallow copy - update will mangle it
1788	1833	$guard->commit;
1789	1834	return 1;
1790	1835	}

+39

-27

lib/DBIx/Class/ResultSource.pm less more

14	14
15	15	use base qw/DBIx::Class/;
16	16
17		__PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
18		_columns _primaries _unique_constraints name resultset_attributes
19		from _relationships column_info_from_storage source_info
20		source_name sqlt_deploy_callback/);
21
22		__PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
23		result_class/);
	17	__PACKAGE__->mk_group_accessors(simple => qw/
	18	source_name name source_info
	19	_ordered_columns _columns _primaries _unique_constraints
	20	_relationships resultset_attributes
	21	column_info_from_storage
	22	/);
	23
	24	__PACKAGE__->mk_group_accessors(component_class => qw/
	25	resultset_class
	26	result_class
	27	/);
	28
	29	__PACKAGE__->mk_classdata( sqlt_deploy_callback => 'default_sqlt_deploy_hook' );
24	30
25	31	=head1 NAME
26	32

114	120	$new->{_relationships} = { %{$new->{_relationships}\|\|{}} };
115	121	$new->{name} \|\|= "!!NAME NOT SET!!";
116	122	$new->{_columns_info_loaded} \|\|= 0;
117		$new->{sqlt_deploy_callback} \|\|= "default_sqlt_deploy_hook";
118	123	return $new;
119	124	}
120	125

885	890
886	891	=over
887	892
888		=item Arguments: $callback
	893	=item Arguments: $callback_name \| \&callback_code
	894
	895	=item Return value: $callback_name \| \&callback_code
889	896
890	897	=back
891	898
892	899	__PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
	900
	901	or
	902
	903	__PACKAGE__->sqlt_deploy_callback(sub {
	904	my ($source_instance, $sqlt_table) = @_;
	905	...
	906	} );
893	907
894	908	An accessor to set a callback to be called during deployment of
895	909	the schema via L<DBIx::Class::Schema/create_ddl_dir> or

898	912	The callback can be set as either a code reference or the name of a
899	913	method in the current result class.
900	914
901		If not set, the L</default_sqlt_deploy_hook> is called.
	915	Defaults to L</default_sqlt_deploy_hook>.
902	916
903	917	Your callback will be passed the $source object representing the
904	918	ResultSource instance being deployed, and the

918	932
919	933	=head2 default_sqlt_deploy_hook
920	934
921		=over
922
923		=item Arguments: $source, $sqlt_table
924
925		=item Return value: undefined
926
927		=back
928
929		This is the sensible default for L</sqlt_deploy_callback>.
930
931		If a method named C<sqlt_deploy_hook> exists in your Result class, it
932		will be called and passed the current C<$source> and the
933		C<$sqlt_table> being deployed.
	935	This is the default deploy hook implementation which checks if your
	936	current Result class has a C<sqlt_deploy_hook> method, and if present
	937	invokes it B<on the Result class directly>. This is to preserve the
	938	semantics of C<sqlt_deploy_hook> which was originally designed to expect
	939	the Result class name and the
	940	L<$sqlt_table instance\|SQL::Translator::Schema::Table> of the table being
	941	deployed.
934	942
935	943	=cut
936	944

939	947
940	948	my $class = $self->result_class;
941	949
942		if ($class and my $hook = $class->can('sqlt_deploy_hook')) {
943		$self->$hook(@_);
	950	if ($class and $class->can('sqlt_deploy_hook')) {
	951	$class->sqlt_deploy_hook(@_);
944	952	}
945	953	}
946	954

1069	1077	Returns an expression of the source to be supplied to storage to specify
1070	1078	retrieval from this source. In the case of a database, the required FROM
1071	1079	clause contents.
	1080
	1081	=cut
	1082
	1083	sub from { die 'Virtual method!' }
1072	1084
1073	1085	=head2 schema
1074	1086

1497	1509	-alias => $as,
1498	1510	-relation_chain_depth => $seen->{-relation_chain_depth} \|\| 0,
1499	1511	},
1500		$self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
	1512	scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
1501	1513	];
1502	1514	}
1503	1515	}

1577	1589
1578	1590	# FIXME sanity check until things stabilize, remove at some point
1579	1591	$self->throw_exception (
1580		"A join-free condition returned for relationship '$relname' whithout a row-object to chain from"
	1592	"A join-free condition returned for relationship '$relname' without a row-object to chain from"
1581	1593	) unless $obj_rel;
1582	1594
1583	1595	# FIXME another sanity check

+51

-49

lib/DBIx/Class/Row.pm less more

6	6
7	7	use DBIx::Class::Exception;
8	8	use Scalar::Util 'blessed';
	9	use List::Util 'first';
9	10	use Try::Tiny;
10	11
11	12	###

355	356	# this ensures we fire store_column only once
356	357	# (some asshats like overriding it)
357	358	if (
358		(! defined $current_rowdata{$_})
	359	(!exists $current_rowdata{$_})
359	360	or
360		( $current_rowdata{$_} ne $returned_cols->{$_})
	361	(defined $current_rowdata{$_} xor defined $returned_cols->{$_})
	362	or
	363	(defined $current_rowdata{$_} and $current_rowdata{$_} ne $returned_cols->{$_})
361	364	);
362	365	}
	366
	367	delete $self->{_column_data_in_storage};
	368	$self->in_storage(1);
363	369
364	370	$self->{_dirty_columns} = {};
365	371	$self->{related_resultsets} = {};

393	399	}
394	400	}
395	401
396		$self->in_storage(1);
397		delete $self->{_orig_ident};
398		delete $self->{_orig_ident_failreason};
399	402	delete $self->{_ignore_at_insert};
	403
400	404	$rollback_guard->commit if $rollback_guard;
401	405
402	406	return $self;

493	497	my %to_update = $self->get_dirty_columns
494	498	or return $self;
495	499
496		my $ident_cond = $self->{_orig_ident} \|\| $self->ident_condition;
497	500	$self->throw_exception( "Not in database" ) unless $self->in_storage;
498	501
499		$self->throw_exception($self->{_orig_ident_failreason})
500		if ! keys %$ident_cond;
501
502	502	my $rows = $self->result_source->storage->update(
503		$self->result_source, \%to_update, $ident_cond
	503	$self->result_source, \%to_update, $self->_storage_ident_condition
504	504	);
505	505	if ($rows == 0) {
506	506	$self->throw_exception( "Can't update ${self}: row not found" );

509	509	}
510	510	$self->{_dirty_columns} = {};
511	511	$self->{related_resultsets} = {};
512		delete $self->{_orig_ident};
	512	delete $self->{_column_data_in_storage};
513	513	return $self;
514	514	}
515	515

561	561	if (ref $self) {
562	562	$self->throw_exception( "Not in database" ) unless $self->in_storage;
563	563
564		my $ident_cond = $self->{_orig_ident} \|\| $self->ident_condition;
565		$self->throw_exception($self->{_orig_ident_failreason})
566		if ! keys %$ident_cond;
567
568	564	$self->result_source->storage->delete(
569		$self->result_source, $ident_cond
	565	$self->result_source, $self->_storage_ident_condition
570	566	);
571	567
572		delete $self->{_orig_ident}; # no longer identifiable
	568	delete $self->{_column_data_in_storage};
573	569	$self->in_storage(undef);
574	570	}
575	571	else {

834	830	sub set_column {
835	831	my ($self, $column, $new_value) = @_;
836	832
837		# if we can't get an ident condition on first try - mark the object as unidentifiable
838		# (by using an empty hashref) and store the error for further diag
839		unless ($self->{_orig_ident}) {
840		try {
841		$self->{_orig_ident} = $self->ident_condition
842		}
843		catch {
844		$self->{_orig_ident_failreason} = $_;
845		$self->{_orig_ident} = {};
846		};
847		}
848
849		my $old_value = $self->get_column($column);
	833	my $had_value = $self->has_column_loaded($column);
	834	my ($old_value, $in_storage) = ($self->get_column($column), $self->in_storage)
	835	if $had_value;
	836
850	837	$new_value = $self->store_column($column, $new_value);
851	838
852	839	my $dirty =
853	840	$self->{_dirty_columns}{$column}
854	841	\|\|
855		$self->in_storage # no point tracking dirtyness on uninserted data
	842	$in_storage # no point tracking dirtyness on uninserted data
856	843	? ! $self->_eq_column_values ($column, $old_value, $new_value)
857	844	: 1
858	845	;

881	868	delete $self->{_inflated_column}{$rel};
882	869	}
883	870	}
	871
	872	if (
	873	# value change from something (even if NULL)
	874	$had_value
	875	and
	876	# no storage - no storage-value
	877	$in_storage
	878	and
	879	# no value already stored (multiple changes before commit to storage)
	880	! exists $self->{_column_data_in_storage}{$column}
	881	and
	882	$self->_track_storage_value($column)
	883	) {
	884	$self->{_column_data_in_storage}{$column} = $old_value;
	885	}
884	886	}
885	887
886	888	return $new_value;

904	906	else {
905	907	return 0;
906	908	}
	909	}
	910
	911	# returns a boolean indicating if the passed column should have its original
	912	# value tracked between column changes and commitment to storage
	913	sub _track_storage_value {
	914	my ($self, $col) = @_;
	915	return defined first { $col eq $_ } ($self->primary_columns);
907	916	}
908	917
909	918	=head2 set_columns

1362	1371	$resultset = $resultset->search(undef, $attrs);
1363	1372	}
1364	1373
1365		my $ident_cond = $self->{_orig_ident} \|\| $self->ident_condition;
1366
1367		$self->throw_exception($self->{_orig_ident_failreason})
1368		if ! keys %$ident_cond;
1369
1370		return $resultset->find($ident_cond);
	1374	return $resultset->find($self->_storage_ident_condition);
1371	1375	}
1372	1376
1373	1377	=head2 discard_changes ($attrs?)

1460	1464	Returns the primary key(s) for a row. Can't be called as a class method.
1461	1465	Actually implemented in L<DBIx::Class::PK>
1462	1466
	1467	=head1 AUTHORS
	1468
	1469	Matt S. Trout <mst@shadowcatsystems.co.uk>
	1470
	1471	=head1 LICENSE
	1472
	1473	You may distribute this code under the same terms as Perl itself.
	1474
	1475	=cut
	1476
1463	1477	1;
1464
1465		=head1 AUTHORS
1466
1467		Matt S. Trout <mst@shadowcatsystems.co.uk>
1468
1469		=head1 LICENSE
1470
1471		You may distribute this code under the same terms as Perl itself.
1472
1473		=cut
1474
1475		1;

+10

-0

lib/DBIx/Class/SQLMaker/ACCESS.pm less more

3	3	use strict;
4	4	use warnings;
5	5	use base 'DBIx::Class::SQLMaker';
	6
	7	# inner joins must be prefixed with 'INNER '
	8	sub new {
	9	my $class = shift;
	10	my $self = $class->next::method(@_);
	11
	12	$self->{_default_jointype} = 'INNER';
	13
	14	return $self;
	15	}
6	16
7	17	# MSAccess is retarded wrt multiple joins in FROM - it requires a certain
8	18	# way of parenthesizing each left part before each next right part

+99

-18

lib/DBIx/Class/SQLMaker/LimitDialects.pm less more

213	213	);
214	214	}
215	215
	216
216	217	=head2 RowNum
	218
	219	Depending on the resultset attributes one of:
217	220
218	221	SELECT * FROM (
219	222	SELECT *, ROWNUM rownum__index FROM (

221	224	) WHERE ROWNUM <= ($limit+$offset)
222	225	) WHERE rownum__index >= ($offset+1)
223	226
	227	or
	228
	229	SELECT * FROM (
	230	SELECT *, ROWNUM rownum__index FROM (
	231	SELECT ...
	232	)
	233	) WHERE rownum__index BETWEEN ($offset+1) AND ($limit+$offset)
	234
	235	or
	236
	237	SELECT * FROM (
	238	SELECT ...
	239	) WHERE ROWNUM <= ($limit+1)
	240
224	241	Supported by B<Oracle>.
225	242
226	243	=cut

233	250	my $idx_name = $self->_quote ('rownum__index');
234	251	my $order_group_having = $self->_parse_rs_attrs($rs_attrs);
235	252
236
237		if ($offset) {
238
239		push @{$self->{limit_bind}}, [ $self->__total_bindtype => $offset + $rows ], [ $self->__offset_bindtype => $offset + 1 ];
240
241		return <<EOS;
	253	#
	254	# There are two ways to limit in Oracle, one vastly faster than the other
	255	# on large resultsets: https://decipherinfosys.wordpress.com/2007/08/09/paging-and-countstopkey-optimization/
	256	# However Oracle is retarded and does not preserve stable ROWNUM() values
	257	# when called twice in the same scope. Therefore unless the resultset is
	258	# ordered by a unique set of columns, it is not safe to use the faster
	259	# method, and the slower BETWEEN query is used instead
	260	#
	261	# FIXME - this is quite expensive, and doe snot perform caching of any sort
	262	# as soon as some of the DQ work becomes viable consider switching this
	263	# over
	264	if ( __order_by_is_unique($rs_attrs) ) {
	265
	266	# if offset is 0 (first page) the we can skip a subquery
	267	if (! $offset) {
	268	push @{$self->{limit_bind}}, [ $self->__rows_bindtype => $rows ];
	269
	270	return <<EOS;
	271	SELECT $outsel FROM (
	272	SELECT $insel ${stripped_sql}${order_group_having}
	273	) $qalias WHERE ROWNUM <= ?
	274	EOS
	275	}
	276	else {
	277	push @{$self->{limit_bind}}, [ $self->__total_bindtype => $offset + $rows ], [ $self->__offset_bindtype => $offset + 1 ];
	278
	279	return <<EOS;
242	280	SELECT $outsel FROM (
243	281	SELECT $outsel, ROWNUM $idx_name FROM (
244	282	SELECT $insel ${stripped_sql}${order_group_having}
245	283	) $qalias WHERE ROWNUM <= ?
246	284	) $qalias WHERE $idx_name >= ?
247	285	EOS
248
	286	}
249	287	}
250	288	else {
251		push @{$self->{limit_bind}}, [ $self->__rows_bindtype => $rows ];
	289	push @{$self->{limit_bind}}, [ $self->__offset_bindtype => $offset + 1 ], [ $self->__total_bindtype => $offset + $rows ];
252	290
253	291	return <<EOS;
254		SELECT $outsel FROM (
	292	SELECT $outsel FROM (
	293	SELECT $outsel, ROWNUM $idx_name FROM (
255	294	SELECT $insel ${stripped_sql}${order_group_having}
256		) $qalias WHERE ROWNUM <= ?
	295	) $qalias
	296	) $qalias WHERE $idx_name BETWEEN ? AND ?
257	297	EOS
258
259		}
260		}
261
262		# used by _Top and _FetchFirst
	298	}
	299	}
	300
	301	# determine if the supplied order_by contains a unique column (set)
	302	sub __order_by_is_unique {
	303	my $rs_attrs = shift;
	304	my $rsrc = $rs_attrs->{_rsroot_rsrc};
	305	my $order_by = $rs_attrs->{order_by}
	306	\|\| return 0;
	307
	308	my $storage = $rsrc->schema->storage;
	309
	310	my @order_by_cols = map { $_->[0] } $storage->_extract_order_criteria($order_by)
	311	or return 0;
	312
	313	my $colinfo =
	314	$storage->_resolve_column_info($rs_attrs->{from}, \@order_by_cols);
	315
	316	my $sources = {
	317	map {( "$_" => $_ )} map { $_->{-result_source} } values %$colinfo
	318	};
	319
	320	my $supplied_order = {
	321	map { $_ => 1 }
	322	grep { exists $colinfo->{$_} and ! $colinfo->{$_}{is_nullable} }
	323	@order_by_cols
	324	};
	325
	326	return 0 unless keys %$supplied_order;
	327
	328	for my $uks (
	329	map { values %$_ } map { +{ $_->unique_constraints } } values %$sources
	330	) {
	331	return 1
	332	unless first { ! exists $supplied_order->{$_} } @$uks;
	333	}
	334
	335	return 0;
	336	}
	337
	338	# used by _Top and _FetchFirst below
263	339	sub _prep_for_skimming_limit {
264	340	my ( $self, $sql, $rs_attrs ) = @_;
265	341

622	698	'Limit dialect implementation usable only in the context of DBIC (missing $rs_attrs)'
623	699	) unless ref ($rs_attrs) eq 'HASH';
624	700
625		# mangle the input sql as we will be replacing the selector
626		$proto_sql =~ s/^ \s* SELECT \s+ .+ \s+ (?= \b FROM \b )//ix
627		or $self->throw_exception("Unrecognizable SELECT: $proto_sql");
	701	# mangle the input sql as we will be replacing the selector entirely
	702	unless (
	703	$rs_attrs->{_selector_sql}
	704	and
	705	$proto_sql =~ s/^ \s* SELECT \s* \Q$rs_attrs->{_selector_sql}//ix
	706	) {
	707	$self->throw_exception("Unrecognizable SELECT: $proto_sql");
	708	}
628	709
629	710	my ($re_sep, $re_alias) = map { quotemeta $_ } ( $self->{name_sep}, $rs_attrs->{alias} );
630	711

+3

-5

lib/DBIx/Class/SQLMaker/MySQL.pm less more

9	9	sub insert {
10	10	my $self = shift;
11	11
12		my $table = $_[0];
13		$table = $self->_quote($table);
14
15	12	if (! $_[1] or (ref $_[1] eq 'HASH' and !keys %{$_[1]} ) ) {
	13	my $table = $self->_quote($_[0]);
16	14	return "INSERT INTO ${table} () VALUES ()"
17	15	}
18	16
19		return $self->SUPER::insert (@_);
	17	return $self->next::method (@_);
20	18	}
21	19
22	20	# Allow STRAIGHT_JOIN's

27	25	return ' STRAIGHT_JOIN '
28	26	}
29	27
30		return $self->SUPER::_generate_join_clause( $join_type );
	28	return $self->next::method($join_type);
31	29	}
32	30
33	31	# LOCK IN SHARE MODE

+2

-2

lib/DBIx/Class/SQLMaker/Oracle.pm less more

19	19	handler => '_where_field_PRIOR',
20	20	};
21	21
22		$self->SUPER::new (\%opts);
	22	$self->next::method(\%opts);
23	23	}
24	24
25	25	sub _assemble_binds {

35	35	my ($cb_sql, @cb_bind) = $self->_connect_by($rs_attrs);
36	36	push @{$self->{oracle_connect_by_bind}}, @cb_bind;
37	37
38		my $sql = $self->SUPER::_parse_rs_attrs(@_);
	38	my $sql = $self->next::method(@_);
39	39
40	40	return "$cb_sql $sql";
41	41	}

+6

-1

lib/DBIx/Class/SQLMaker.pm less more

204	204	}
205	205	;
206	206
207		$sql = $self->$limiter ($sql, $rs_attrs, $limit, $offset);
	207	$sql = $self->$limiter (
	208	$sql,
	209	{ %{$rs_attrs\|\|{}}, _selector_sql => $fields },
	210	$limit,
	211	$offset
	212	);
208	213	}
209	214	else {
210	215	($sql, @bind) = $self->next::method ($table, $fields, $where, $rs_attrs);

+1

-1

lib/DBIx/Class/Schema/Versioned.pm less more

718	718	$dt[2],
719	719	$dt[1],
720	720	$dt[0],
721		$tm[1] / 1000, # convert to millisecs, format as up/down rounded int above
	721	int($tm[1] / 1000), # convert to millisecs
722	722	),
723	723	});
724	724	}

+10

-3

lib/DBIx/Class/Schema.pm less more

1003	1003
1004	1004	=over 4
1005	1005
	1006	=item Arguments: %attrs?
	1007
1006	1008	=item Return Value: $new_schema
1007	1009
1008	1010	=back
1009	1011
1010	1012	Clones the schema and its associated result_source objects and returns the
1011		copy.
	1013	copy. The resulting copy will have the same attributes as the source schema,
	1014	except for those attributes explicitly overriden by the provided C<%attrs>.
1012	1015
1013	1016	=cut
1014	1017
1015	1018	sub clone {
1016		my ($self) = @_;
1017		my $clone = { (ref $self ? %$self : ()) };
	1019	my $self = shift;
	1020
	1021	my $clone = {
	1022	(ref $self ? %$self : ()),
	1023	(@_ == 1 && ref $_[0] eq 'HASH' ? %{ $_[0] } : @_),
	1024	};
1018	1025	bless $clone, (ref $self \|\| $self);
1019	1026
1020	1027	$clone->class_mappings({ %{$clone->class_mappings} });

+1

-0

lib/DBIx/Class/Storage/DBI/ACCESS.pm less more

4	4	use base 'DBIx::Class::Storage::DBI::UniqueIdentifier';
5	5	use mro 'c3';
6	6
	7	use DBI ();
7	8	use List::Util 'first';
8	9	use namespace::clean;
9	10

+18

-8

lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm less more

157	157	my ( $schema, $table ) = $source_name =~ /( (?:${ql})? \w+ (?:${qr})? ) \. ( (?:${ql})? \w+ (?:${qr})? )/x;
158	158
159	159	# if no explicit schema was requested - use the default schema (which in the case of Oracle is the db user)
160		$schema \|\|= uc( ($self->_dbi_connect_info\|\|[])->[1] \|\| '');
	160	$schema \|\|= \'= USER';
161	161
162	162	my ($sql, @bind) = $sql_maker->select (
163	163	'ALL_TRIGGERS',
164	164	[qw/TRIGGER_BODY TABLE_OWNER TRIGGER_NAME/],
165	165	{
166		$schema ? (OWNER => $schema) : (),
	166	OWNER => $schema,
167	167	TABLE_NAME => $table \|\| $source_name,
168	168	TRIGGERING_EVENT => { -like => '%INSERT%' }, # this will also catch insert_or_update
169	169	TRIGGER_TYPE => { -like => '%BEFORE%' }, # we care only about 'before' triggers

173	173
174	174	# to find all the triggers that mention the column in question a simple
175	175	# regex grep since the trigger_body above is a LONG and hence not searchable
	176	# via -like
176	177	my @triggers = ( map
177	178	{ my %inf; @inf{qw/body schema name/} = @$_; \%inf }
178	179	( grep

181	182	)
182	183	);
183	184
184		# extract all sequence names mentioned in each trigger
185		for (@triggers) {
186		$_->{sequences} = [ $_->{body} =~ / ( "? [\.\w\"\-]+ "? ) \. nextval /xig ];
187		}
	185	# extract all sequence names mentioned in each trigger, throw away
	186	# triggers without apparent sequences
	187	@triggers = map {
	188	my @seqs = $_->{body} =~ / ( [\.\w\"\-]+ ) \. nextval /xig;
	189	@seqs
	190	? { %$_, sequences => \@seqs }
	191	: ()
	192	;
	193	} @triggers;
188	194
189	195	my $chosen_trigger;
190	196

251	257	my ( $self, $type, $seq ) = @_;
252	258
253	259	# use the maker to leverage quoting settings
254		my $sql_maker = $self->sql_maker;
255		my ($id) = $self->_get_dbh->selectrow_array ($sql_maker->select('DUAL', [ ref $seq ? \"$$seq.$type" : "$seq.$type" ] ) );
	260	my $sth = $self->_dbh->prepare_cached(
	261	$self->sql_maker->select('DUAL', [ ref $seq ? \"$$seq.$type" : "$seq.$type" ] )
	262	);
	263	$sth->execute;
	264	my ($id) = $sth->fetchrow_array;
	265	$sth->finish;
256	266	return $id;
257	267	}
258	268

+1

-1

lib/DBIx/Class/Storage/DBI/SQLite.pm less more

90	90	}
91	91
92	92	sub bind_attribute_by_data_type {
93		$_[1] =~ /^ (?: int(?:eger)? \| (?:tiny\|small\|medium\|big)int ) $/ix
	93	$_[1] =~ /^ (?: int(?:eger)? \| (?:tiny\|small\|medium)int ) $/ix
94	94	? do { require DBI; DBI::SQL_INTEGER() }
95	95	: undef
96	96	;

+41

-6

lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm less more

17	17
18	18	__PACKAGE__->sql_limit_dialect ('RowCountOrGenericSubQ');
19	19	__PACKAGE__->sql_quote_char ([qw/[ ]/]);
20		__PACKAGE__->datetime_parser_type('DateTime::Format::Sybase');
	20	__PACKAGE__->datetime_parser_type(
	21	'DBIx::Class::Storage::DBI::Sybase::ASE::DateTime::Format'
	22	);
21	23
22	24	__PACKAGE__->mk_group_accessors('simple' =>
23	25	qw/_identity _blob_log_on_update _writer_storage _is_extra_storage

26	28	_identity_method/
27	29	);
28	30
	31
29	32	my @also_proxy_to_extra_storages = qw/
30	33	connect_call_set_auto_cast auto_cast connect_call_blob_setup
31	34	connect_call_datetime_setup

68	71	my $no_bind_vars = __PACKAGE__ . '::NoBindVars';
69	72
70	73	if ($self->using_freetds) {
71		carp <<'EOF' unless $ENV{DBIC_SYBASE_FREETDS_NOWARN};
	74	carp_once <<'EOF' unless $ENV{DBIC_SYBASE_FREETDS_NOWARN};
72	75
73	76	You are using FreeTDS with Sybase.
74	77

849	852	$dbh->syb_date_fmt('ISO_strict'); # output fmt: 2004-08-21T14:36:48.080Z
850	853	$dbh->do('set dateformat mdy'); # input fmt: 08/13/1979 18:08:55.080
851	854
852		On connection for use with L<DBIx::Class::InflateColumn::DateTime>, using
853		L<DateTime::Format::Sybase>, which you will need to install.
854
855	855	This works for both C<DATETIME> and C<SMALLDATETIME> columns, note that
856	856	C<SMALLDATETIME> columns only have minute precision.
857	857

870	870	'Your DBD::Sybase is too old to support '
871	871	.'DBIx::Class::InflateColumn::DateTime, please upgrade!';
872	872
	873	# FIXME - in retrospect this is a rather bad US-centric choice
	874	# of format. Not changing as a bugwards compat, though in reality
	875	# the only piece that sees the results of $dt object formatting
	876	# (as opposed to parsing) is the database itself, so theoretically
	877	# changing both this SET command and the formatter definition of
	878	# ::S::D::Sybase::ASE::DateTime::Format below should be safe and
	879	# transparent
	880
873	881	$dbh->do('SET DATEFORMAT mdy');
874		1;
875	882	}
876	883	}
877	884

903	910	my ($self, $name) = @_;
904	911
905	912	$self->_dbh->do("ROLLBACK TRANSACTION $name");
	913	}
	914
	915	package # hide from PAUSE
	916	DBIx::Class::Storage::DBI::Sybase::ASE::DateTime::Format;
	917
	918	my $datetime_parse_format = '%Y-%m-%dT%H:%M:%S.%3NZ';
	919	my $datetime_format_format = '%m/%d/%Y %H:%M:%S.%3N';
	920
	921	my ($datetime_parser, $datetime_formatter);
	922
	923	sub parse_datetime {
	924	shift;
	925	require DateTime::Format::Strptime;
	926	$datetime_parser \|\|= DateTime::Format::Strptime->new(
	927	pattern => $datetime_parse_format,
	928	on_error => 'croak',
	929	);
	930	return $datetime_parser->parse_datetime(shift);
	931	}
	932
	933	sub format_datetime {
	934	shift;
	935	require DateTime::Format::Strptime;
	936	$datetime_formatter \|\|= DateTime::Format::Strptime->new(
	937	pattern => $datetime_format_format,
	938	on_error => 'croak',
	939	);
	940	return $datetime_formatter->format_datetime(shift);
906	941	}
907	942
908	943	1;

+1

-1

lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm less more

43	43
44	44	return if ref $self ne __PACKAGE__;
45	45	if (not $self->_use_typeless_placeholders) {
46		carp <<'EOF' unless $ENV{DBIC_MSSQL_FREETDS_LOWVER_NOWARN};
	46	carp_once <<'EOF' unless $ENV{DBIC_MSSQL_FREETDS_LOWVER_NOWARN};
47	47	Placeholders do not seem to be supported in your configuration of
48	48	DBD::Sybase/FreeTDS.
49	49

+57

-1

lib/DBIx/Class/Storage/DBIHacks.pm less more

3	3	#
4	4	# This module contains code that should never have seen the light of day,
5	5	# does not belong in the Storage, or is otherwise unfit for public
6		# display. The arrival of SQLA2 should immediately oboslete 90% of this
	6	# display. The arrival of SQLA2 should immediately obsolete 90% of this
7	7	#
8	8
9	9	use strict;

14	14
15	15	use List::Util 'first';
16	16	use Scalar::Util 'blessed';
	17	use Sub::Name 'subname';
17	18	use namespace::clean;
18	19
19	20	#

590	591	return \@new_from;
591	592	}
592	593
	594	# yet another atrocity: attempt to extract all columns from a
	595	# where condition by hooking _quote
	596	sub _extract_condition_columns {
	597	my ($self, $cond, $sql_maker) = @_;
	598
	599	return [] unless $cond;
	600
	601	$sql_maker \|\|= $self->{_sql_ident_capturer} \|\|= do {
	602	# FIXME - replace with a Moo trait
	603	my $orig_sm_class = ref $self->sql_maker;
	604	my $smic_class = "${orig_sm_class}::_IdentCapture_";
	605
	606	unless ($smic_class->isa('SQL::Abstract')) {
	607
	608	no strict 'refs';
	609	*{"${smic_class}::_quote"} = subname "${smic_class}::_quote" => sub {
	610	my ($self, $ident) = @_;
	611	if (ref $ident eq 'SCALAR') {
	612	$ident = $$ident;
	613	my $storage_quotes = $self->sql_quote_char \|\| '"';
	614	my ($ql, $qr) = map
	615	{ quotemeta $_ }
	616	(ref $storage_quotes eq 'ARRAY' ? @$storage_quotes : ($storage_quotes) x 2 )
	617	;
	618
	619	while ($ident =~ /
	620	$ql (\w+) $qr
	621	\|
	622	([\w\.]+)
	623	/xg) {
	624	$self->{_captured_idents}{$1\|\|$2}++;
	625	}
	626	}
	627	else {
	628	$self->{_captured_idents}{$ident}++;
	629	}
	630	return $ident;
	631	};
	632
	633	*{"${smic_class}::_get_captured_idents"} = subname "${smic_class}::_get_captures" => sub {
	634	(delete shift->{_captured_idents}) \|\| {};
	635	};
	636
	637	$self->inject_base ($smic_class, $orig_sm_class);
	638
	639	}
	640
	641	$smic_class->new();
	642	};
	643
	644	$sql_maker->_recurse_where($cond);
	645
	646	return [ sort keys %{$sql_maker->_get_captured_idents} ];
	647	}
	648
593	649	sub _extract_order_criteria {
594	650	my ($self, $order_by, $sql_maker) = @_;
595	651

+1

-1

lib/DBIx/Class/Storage/Statistics.pm less more

60	60	my $debug_env = $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG}
61	61	\|\| $ENV{DBIC_TRACE};
62	62	if (defined($debug_env) && ($debug_env =~ /=(.+)$/)) {
63		$fh = IO::File->new($1, 'w')
	63	$fh = IO::File->new($1, 'a')
64	64	or die("Cannot open trace file $1");
65	65	} else {
66	66	$fh = IO::File->new('>&STDERR')

+2

-2

lib/DBIx/Class.pm less more

10	10	# $VERSION declaration must stay up here, ahead of any other package
11	11	# declarations, as to not confuse various modules attempting to determine
12	12	# this ones version, whether that be s.c.o. or Module::Metadata, etc
13		$VERSION = '0.08192';
	13	$VERSION = '0.08193';
14	14
15	15	$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
16	16

154	154	__PACKAGE__->table('artist');
155	155	__PACKAGE__->add_columns(qw/ artistid name /);
156	156	__PACKAGE__->set_primary_key('artistid');
157		__PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD');
	157	__PACKAGE__->has_many(cds => 'MyApp::Schema::Result::CD', 'artistid');
158	158
159	159	1;
160	160

+4

-0

t/50fork.t less more

0	0	use strict;
1	1	use warnings;
2	2	use Test::More;
	3	use DBIx::Class::Optional::Dependencies ();
	4
	5	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('rdbms_pg')
	6	unless DBIx::Class::Optional::Dependencies->req_ok_for ('rdbms_pg');
3	7
4	8	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
5	9

+4

-0

t/51threads.t less more

15	15
16	16	use threads;
17	17	use Test::Exception;
	18	use DBIx::Class::Optional::Dependencies ();
18	19	use lib qw(t/lib);
	20
	21	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('rdbms_pg')
	22	unless DBIx::Class::Optional::Dependencies->req_ok_for ('rdbms_pg');
19	23
20	24	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
21	25	plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test'

+4

-0

t/51threadtxn.t less more

17	17
18	18
19	19	use threads;
	20	use DBIx::Class::Optional::Dependencies ();
20	21	use lib qw(t/lib);
	22
	23	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('rdbms_pg')
	24	unless DBIx::Class::Optional::Dependencies->req_ok_for ('rdbms_pg');
21	25
22	26	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
23	27	plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test'

+2

-0

t/53lean_startup.t less more

43	43
44	44	Class::Accessor::Grouped
45	45	Class::C3::Componentised
	46
	47	Data::Compare
46	48	/, $] < 5.010 ? 'MRO::Compat' : () };
47	49
48	50	$test_hook = sub {

+27

-7

t/55namespaces_cleaned.t less more

	0	# Pre-5.10 perls pollute %INC on unsuccesfull module
	1	# require, making it appear as if the module is already
	2	# loaded on subsequent require()s
	3	# Can't seem to find the exact RT/perldelta entry
	4	BEGIN {
	5	if ($] < 5.010) {
	6	# shut up spurious warnings without loading warnings.pm
	7	*CORE::GLOBAL::require = sub {};
	8
	9	*CORE::GLOBAL::require = sub {
	10	my $res = eval { CORE::require($_[0]) };
	11	if ($@) {
	12	delete $INC{$_[0]};
	13	die
	14	}
	15	$res;
	16	}
	17	}
	18	}
	19
0	20	use strict;
1	21	use warnings;
2	22

14	34	my @modules = grep {
15	35	my $mod = $_;
16	36
17		# trap deprecation warnings and whatnot
18		local $SIG{__WARN__} = sub {};
19
20	37	# not all modules are loadable at all times
21		eval "require $mod" ? $mod : do {
22		SKIP: { skip "Failed require of $mod: $@", 1 };
23		();
	38	do {
	39	# trap deprecation warnings and whatnot
	40	local $SIG{__WARN__} = sub {};
	41	eval "require $mod";
	42	} ? $mod : do {
	43	SKIP: { skip "Failed require of $mod: " . ($@ =~ /^(.+?)$/m)[0], 1 };
	44	(); # empty RV for @modules
24	45	};
25
26	46
27	47	} find_modules();
28	48

+4

-0

t/71mysql.t less more

5	5
6	6	use DBI::Const::GetInfoType;
7	7	use Scalar::Util qw/weaken/;
	8	use DBIx::Class::Optional::Dependencies ();
8	9
9	10	use lib qw(t/lib);
10	11	use DBICTest;
11	12	use DBIC::SqlMakerTest;
	13
	14	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_mysql')
	15	unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_mysql');
12	16
13	17	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/};
14	18

+3

-0

t/72pg.t less more

3	3	use Test::More;
4	4	use Test::Exception;
5	5	use Sub::Name;
	6	use DBIx::Class::Optional::Dependencies ();
6	7	use lib qw(t/lib);
7	8	use DBICTest;
8	9
	10	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_pg')
	11	unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_pg');
9	12
10	13	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
11	14

+4

-0

t/72pg_bytea.t less more

1	1	use warnings;
2	2
3	3	use Test::More;
	4	use DBIx::Class::Optional::Dependencies ();
4	5	use lib qw(t/lib);
5	6	use DBICTest;
	7
	8	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('rdbms_pg')
	9	unless DBIx::Class::Optional::Dependencies->req_ok_for ('rdbms_pg');
6	10
7	11	my ($dsn, $dbuser, $dbpass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
8	12

+1

-0

t/73oracle.t less more

4	4	use Test::More;
5	5	use Sub::Name;
6	6	use Try::Tiny;
	7	use DBIx::Class::Optional::Dependencies ();
7	8
8	9	use lib qw(t/lib);
9	10	use DBICTest;

+16

-11

t/73oracle_hq.t less more

2	2
3	3	use Test::Exception;
4	4	use Test::More;
5
	5	use DBIx::Class::Optional::Dependencies ();
6	6	use lib qw(t/lib);
7	7	use DBIC::SqlMakerTest;
8	8

14	14	$ENV{NLS_COMP} = "BINARY";
15	15	$ENV{NLS_LANG} = "AMERICAN";
16	16
17		plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_oracle')
18		unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_oracle');
	17	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('rdbms_oracle')
	18	unless DBIx::Class::Optional::Dependencies->req_ok_for ('rdbms_oracle');
19	19
20	20	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_ORA_${_}" } qw/DSN USER PASS/};
21	21

315	315	my $rs = $schema->resultset('Artist')->search({}, {
316	316	start_with => { name => 'root' },
317	317	connect_by => { parentid => { -prior => { -ident => 'artistid' } } },
318		order_by => { -asc => 'name' },
	318	order_by => [ { -asc => 'name' }, { -desc => 'artistid' } ],
319	319	rows => 2,
320	320	});
321	321

328	328	FROM artist me
329	329	START WITH name = ?
330	330	CONNECT BY parentid = PRIOR artistid
331		ORDER BY name ASC
	331	ORDER BY name ASC, artistid DESC
332	332	) me
333	333	WHERE ROWNUM <= ?
334	334	)',

351	351	FROM (
352	352	SELECT artistid
353	353	FROM (
354		SELECT me.artistid
355		FROM artist me
356		START WITH name = ?
357		CONNECT BY parentid = PRIOR artistid
	354	SELECT artistid, ROWNUM rownum__index
	355	FROM (
	356	SELECT me.artistid
	357	FROM artist me
	358	START WITH name = ?
	359	CONNECT BY parentid = PRIOR artistid
	360	) me
358	361	) me
359		WHERE ROWNUM <= ?
	362	WHERE rownum__index BETWEEN ? AND ?
360	363	) me
361	364	)',
362	365	[
363	366	[ { 'sqlt_datatype' => 'varchar', 'dbic_colname' => 'name', 'sqlt_size' => 100 }
364		=> 'root'], [ $ROWS => 2 ] ,
	367	=> 'root'],
	368	[ $ROWS => 1 ],
	369	[ $TOTAL => 2 ],
365	370	],
366	371	);
367	372

+4

-0

t/745db2.t less more

3	3	use Test::More;
4	4	use Test::Exception;
5	5	use Try::Tiny;
	6	use DBIx::Class::Optional::Dependencies ();
6	7	use lib qw(t/lib);
7	8	use DBICTest;
	9
	10	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_db2')
	11	unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_db2');
8	12
9	13	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_DB2_${_}" } qw/DSN USER PASS/};
10	14

+4

-0

t/746db2_400.t less more

1	1	use warnings;
2	2
3	3	use Test::More;
	4	use DBIx::Class::Optional::Dependencies ();
4	5	use lib qw(t/lib);
5	6	use DBICTest;
	7
	8	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_db2_400')
	9	unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_db2_400');
6	10
7	11	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_DB2_400_${_}" } qw/DSN USER PASS/};
8	12

+7

-3

t/746mssql.t less more

2	2
3	3	use Test::More;
4	4	use Test::Exception;
	5	use Try::Tiny;
	6	use DBIx::Class::SQLMaker::LimitDialects;
	7	use DBIx::Class::Optional::Dependencies ();
5	8	use lib qw(t/lib);
6	9	use DBICTest;
7	10	use DBIC::SqlMakerTest;
8		use Try::Tiny;
9
10		use DBIx::Class::SQLMaker::LimitDialects;
	11
	12	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_mssql_odbc')
	13	unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_mssql_odbc');
	14
11	15	my $OFFSET = DBIx::Class::SQLMaker::LimitDialects->__offset_bindtype;
12	16	my $TOTAL = DBIx::Class::SQLMaker::LimitDialects->__total_bindtype;
13	17

+6

-6

t/746sybase.t less more

3	3
4	4	use Test::More;
5	5	use Test::Exception;
	6	use DBIx::Class::Optional::Dependencies ();
6	7	use lib qw(t/lib);
7	8	use DBICTest;
	9
	10	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_ase')
	11	unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_ase');
8	12
9	13	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/};
10	14

438	442	lives_ok {
439	443	$rs->populate([
440	444	{
441		bytea => 1,
442	445	blob => $binstr{large},
443	446	clob => $new_str,
444		a_memo => 2,
445		},
446		{
447		bytea => 1,
	447	},
	448	{
448	449	blob => $binstr{large},
449	450	clob => $new_str,
450		a_memo => 2,
451	451	},
452	452	]);
453	453	} 'insert_bulk with blobs does not die';

+4

-0

t/747mssql_ado.t less more

2	2
3	3	use Test::More;
4	4	use Test::Exception;
	5	use DBIx::Class::Optional::Dependencies ();
5	6	use lib qw(t/lib);
6	7	use DBICTest;
	8
	9	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_mssql_ado')
	10	unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_mssql_ado');
7	11
8	12	# Example DSN (from frew):
9	13	# dbi:ADO:PROVIDER=sqlncli10;SERVER=tcp:172.24.2.10;MARS Connection=True;Initial Catalog=CIS;UID=cis_web;PWD=...;DataTypeCompatibility=80;

+4

-0

t/748informix.t less more

2	2
3	3	use Test::More;
4	4	use Test::Exception;
	5	use DBIx::Class::Optional::Dependencies ();
5	6	use lib qw(t/lib);
6	7	use DBICTest;
	8
	9	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_informix')
	10	unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_informix');
7	11
8	12	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_INFORMIX_${_}" } qw/DSN USER PASS/};
9	13

+16

-4

t/749sqlanywhere.t less more

4	4	use Test::Exception;
5	5	use Scope::Guard ();
6	6	use Try::Tiny;
	7	use DBIx::Class::Optional::Dependencies ();
7	8	use lib qw(t/lib);
8	9	use DBICTest;
9	10
10		DBICTest::Schema->load_classes('ArtistGUID');
11
12		# tests stolen from 748informix.t
13
14	11	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SQLANYWHERE_${_}" } qw/DSN USER PASS/};
15	12	my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_SQLANYWHERE_ODBC_${_}" } qw/DSN USER PASS/};
	13
	14	plan skip_all => 'Test needs ' .
	15	(join ' or ', map { $_ ? $_ : () }
	16	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_sqlanywhere'),
	17	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_sqlanywhere_odbc'))
	18	unless
	19	$dsn && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_sqlanywhere')
	20	or
	21	$dsn2 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_sqlanywhere_odbc')
	22	or
	23	(not $dsn \|\| $dsn2);
	24
	25	DBICTest::Schema->load_classes('ArtistGUID');
	26
	27	# tests stolen from 748informix.t
16	28
17	29	plan skip_all => <<'EOF' unless $dsn \|\| $dsn2;
18	30	Set $ENV{DBICTEST_SQLANYWHERE_DSN} and/or $ENV{DBICTEST_SQLANYWHERE_ODBC_DSN},

+4

-0

t/74mssql.t less more

9	9
10	10	use Test::More;
11	11	use Test::Exception;
	12	use DBIx::Class::Optional::Dependencies ();
12	13	use lib qw(t/lib);
13	14	use DBICTest;
	15
	16	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_mssql_sybase')
	17	unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_mssql_sybase');
14	18
15	19	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_${_}" } qw/DSN USER PASS/};
16	20

+24

-6

t/750firebird.t less more

2	2
3	3	use Test::More;
4	4	use Test::Exception;
	5	use DBIx::Class::Optional::Dependencies ();
5	6	use lib qw(t/lib);
6	7	use DBICTest;
7	8	use Scope::Guard ();
8	9
	10	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_FIREBIRD_${_}" } qw/DSN USER PASS/};
	11	my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_FIREBIRD_INTERBASE_${_}" } qw/DSN USER PASS/};
	12	my ($dsn3, $user3, $pass3) = @ENV{map { "DBICTEST_FIREBIRD_ODBC_${_}" } qw/DSN USER PASS/};
	13
	14	plan skip_all => 'Test needs ' .
	15	(join ' or ', map { $_ ? $_ : () }
	16	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_firebird'),
	17	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_firebird_interbase'),
	18	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_firebird_odbc'))
	19	unless
	20	$dsn && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_firebird')
	21	or
	22	$dsn2 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_firebird_interbase')
	23	or
	24	$dsn3 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_firebird_odbc')
	25	or
	26	(not $dsn \|\| $dsn2 \|\| $dsn3);
	27
9	28	# tests stolen from 749sybase_asa.t
10	29
11		my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_FIREBIRD_${_}" } qw/DSN USER PASS/};
12		my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_FIREBIRD_ODBC_${_}" } qw/DSN USER PASS/};
13
14	30	# Example DSNs:
	31	# dbi:Firebird:db=/var/lib/firebird/2.5/data/hlaghdb.fdb
15	32	# dbi:InterBase:db=/var/lib/firebird/2.5/data/hlaghdb.fdb
16		# dbi:Firebird:db=/var/lib/firebird/2.5/data/hlaghdb.fdb
17	33
18	34	# Example ODBC DSN:
19	35	# dbi:ODBC:Driver=Firebird;Dbname=/var/lib/firebird/2.5/data/hlaghdb.fdb
20	36
21		plan skip_all => <<'EOF' unless $dsn \|\| $dsn2;
22		Set $ENV{DBICTEST_FIREBIRD_DSN} and/or $ENV{DBICTEST_FIREBIRD_ODBC_DSN},
	37	plan skip_all => <<'EOF' unless $dsn \|\| $dsn2 \|\| $dsn3;
	38	Set $ENV{DBICTEST_FIREBIRD_DSN} and/or $ENV{DBICTEST_FIREBIRD_INTERBASE_DSN}
	39	and/or $ENV{DBICTEST_FIREBIRD_ODBC_DSN},
23	40	_USER and _PASS to run these tests.
24	41
25	42	WARNING: this test creates and drops the tables "artist", "bindtype_test" and

30	47	my @info = (
31	48	[ $dsn, $user, $pass ],
32	49	[ $dsn2, $user2, $pass2 ],
	50	[ $dsn3, $user3, $pass3 ],
33	51	);
34	52
35	53	my $schema;

+67

-15

t/751msaccess.t less more

4	4	use Test::Exception;
5	5	use Scope::Guard ();
6	6	use Try::Tiny;
	7	use DBIx::Class::Optional::Dependencies ();
7	8	use lib qw(t/lib);
8	9	use DBICTest;
	10	use DBIC::DebugObj ();
	11	use DBIC::SqlMakerTest;
	12
	13	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSACCESS_ODBC_${_}" } qw/DSN USER PASS/};
	14	my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_MSACCESS_ADO_${_}" } qw/DSN USER PASS/};
	15
	16	plan skip_all => 'Test needs ' .
	17	(join ' or ', map { $_ ? $_ : () }
	18	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_msaccess_odbc'),
	19	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_msaccess_ado'))
	20	unless
	21	$dsn && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_odbc')
	22	or
	23	$dsn2 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_ado')
	24	or
	25	(not $dsn \|\| $dsn2);
9	26
10	27	DBICTest::Schema->load_classes('ArtistGUID');
11	28

14	31	# dbi:ADO:Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\rkitover\Documents\access_sample.accdb
15	32	# dbi:ADO:Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\rkitover\Documents\access_sample.accdb;Persist Security Info=False'
16	33
17		my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSACCESS_ODBC_${_}" } qw/DSN USER PASS/};
18		my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_MSACCESS_ADO_${_}" } qw/DSN USER PASS/};
19
20	34	plan skip_all => <<'EOF' unless $dsn \|\| $dsn2;
21		Set $ENV{DBICTEST_MSACCESS_ODBC_DSN} and/or $ENV{DBICTEST_MSACCESS_ADO_DSN} (and optionally _USER and _PASS) to run these tests.\nWarning: this test drops and creates the tables 'artist', 'cd', 'bindtype_test' and 'artist_guid'.
	35	Set $ENV{DBICTEST_MSACCESS_ODBC_DSN} and/or $ENV{DBICTEST_MSACCESS_ADO_DSN} (and optionally _USER and _PASS) to run these tests.
	36	Warning: this test drops and creates the tables 'artist', 'cd', 'bindtype_test' and 'artist_guid'.
22	37	EOF
23
24		plan skip_all => 'Test needs ' .
25		DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_msaccess_odbc')
26		. ' or ' .
27		DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_msaccess_ado')
28		unless
29		DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_odbc')
30		or
31		DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_ado');
32	38
33	39	my @info = (
34	40	[ $dsn, $user \|\| '', $pass \|\| '' ],

139	145	title => 'my track',
140	146	});
141	147
	148	my ($sql, @bind);
	149
142	150	my $joined_track = try {
	151	local $schema->storage->{debug} = 1;
	152	local $schema->storage->{debugobj} = DBIC::DebugObj->new(\$sql, \@bind);
	153
143	154	$schema->resultset('Artist')->search({
144	155	artistid => $first_artistid,
145	156	}, {

149	160	})->next;
150	161	}
151	162	catch {
152		diag "Could not execute two-step join: $_";
	163	diag "Could not execute two-step left join: $_";
153	164	};
154	165
	166	s/^'//, s/'\z// for @bind;
	167
	168	is_same_sql_bind(
	169	$sql,
	170	\@bind,
	171	'SELECT [me].[artistid], [me].[name], [me].[rank], [me].[charfield], [tracks].[title] FROM ( ( [artist] [me] LEFT JOIN cd [cds] ON [cds].[artist] = [me].[artistid] ) LEFT JOIN [track] [tracks] ON [tracks].[cd] = [cds].[cdid] ) WHERE ( [artistid] = ? )',
	172	[1],
	173	'correct SQL for two-step left join',
	174	);
	175
155	176	is try { $joined_track->get_column('track_title') }, 'my track',
156		'two-step join works';
	177	'two-step left join works';
	178
	179	($sql, @bind) = ();
	180
	181	$joined_artist = try {
	182	local $schema->storage->{debug} = 1;
	183	local $schema->storage->{debugobj} = DBIC::DebugObj->new(\$sql, \@bind);
	184
	185	$schema->resultset('Track')->search({
	186	trackid => $track->trackid,
	187	}, {
	188	join => [{ cd => 'artist' }],
	189	'+select' => [ 'artist.name' ],
	190	'+as' => [ 'artist_name' ],
	191	})->next;
	192	}
	193	catch {
	194	diag "Could not execute two-step inner join: $_";
	195	};
	196
	197	s/^'//, s/'\z// for @bind;
	198
	199	is_same_sql_bind(
	200	$sql,
	201	\@bind,
	202	'SELECT [me].[trackid], [me].[cd], [me].[position], [me].[title], [me].[last_updated_on], [me].[last_updated_at], [artist].[name] FROM ( ( [track] [me] INNER JOIN cd [cd] ON [cd].[cdid] = [me].[cd] ) INNER JOIN [artist] [artist] ON [artist].[artistid] = [cd].[artist] ) WHERE ( [trackid] = ? )',
	203	[$track->trackid],
	204	'correct SQL for two-step inner join',
	205	);
	206
	207	is try { $joined_artist->get_column('artist_name') }, 'foo',
	208	'two-step inner join works';
157	209
158	210	# test basic transactions
159	211	$schema->txn_do(sub {

+74

-25

t/752sqlite.t less more

3	3	use Test::More;
4	4	use Test::Exception;
5	5	use Test::Warn;
	6	use Config;
	7
6	8	use lib qw(t/lib);
7	9	use DBICTest;
8	10
9		my $schema = DBICTest->init_schema(auto_savepoint => 1);
	11	# savepoints test
	12	{
	13	my $schema = DBICTest->init_schema(auto_savepoint => 1);
10	14
11		my $ars = $schema->resultset('Artist');
	15	my $ars = $schema->resultset('Artist');
12	16
13		# test two-phase commit and inner transaction rollback from nested transactions
14		$schema->txn_do(sub {
15		$ars->create({ name => 'in_outer_transaction' });
	17	# test two-phase commit and inner transaction rollback from nested transactions
16	18	$schema->txn_do(sub {
17		$ars->create({ name => 'in_inner_transaction' });
	19	$ars->create({ name => 'in_outer_transaction' });
	20	$schema->txn_do(sub {
	21	$ars->create({ name => 'in_inner_transaction' });
	22	});
	23	ok($ars->search({ name => 'in_inner_transaction' })->first,
	24	'commit from inner transaction visible in outer transaction');
	25	throws_ok {
	26	$schema->txn_do(sub {
	27	$ars->create({ name => 'in_inner_transaction_rolling_back' });
	28	die 'rolling back inner transaction';
	29	});
	30	} qr/rolling back inner transaction/, 'inner transaction rollback executed';
	31	$ars->create({ name => 'in_outer_transaction2' });
18	32	});
	33
	34	ok($ars->search({ name => 'in_outer_transaction' })->first,
	35	'commit from outer transaction');
	36	ok($ars->search({ name => 'in_outer_transaction2' })->first,
	37	'second commit from outer transaction');
19	38	ok($ars->search({ name => 'in_inner_transaction' })->first,
20		'commit from inner transaction visible in outer transaction');
21		throws_ok {
22		$schema->txn_do(sub {
23		$ars->create({ name => 'in_inner_transaction_rolling_back' });
24		die 'rolling back inner transaction';
25		});
26		} qr/rolling back inner transaction/, 'inner transaction rollback executed';
27		$ars->create({ name => 'in_outer_transaction2' });
28		});
	39	'commit from inner transaction');
	40	is $ars->search({ name => 'in_inner_transaction_rolling_back' })->first,
	41	undef,
	42	'rollback from inner transaction';
	43	}
29	44
30		ok($ars->search({ name => 'in_outer_transaction' })->first,
31		'commit from outer transaction');
32		ok($ars->search({ name => 'in_outer_transaction2' })->first,
33		'second commit from outer transaction');
34		ok($ars->search({ name => 'in_inner_transaction' })->first,
35		'commit from inner transaction');
36		is $ars->search({ name => 'in_inner_transaction_rolling_back' })->first,
37		undef,
38		'rollback from inner transaction';
	45	my $schema = DBICTest->init_schema();
39	46
40	47	# make sure the side-effects of RT#67581 do not result in data loss
41	48	my $row;
42		warnings_exist { $row = $ars->create ({ name => 'alpha rank', rank => 'abc' }) }
	49	warnings_exist { $row = $schema->resultset('Artist')->create ({ name => 'alpha rank', rank => 'abc' }) }
43	50	[qr/Non-numeric value supplied for column 'rank' despite the numeric datatype/],
44	51	'proper warning on string insertion into an numeric column'
45	52	;
46	53	$row->discard_changes;
47	54	is ($row->rank, 'abc', 'proper rank inserted into database');
48	55
	56	# and make sure we do not lose actual bigints
	57	{
	58	package DBICTest::BigIntArtist;
	59	use base 'DBICTest::Schema::Artist';
	60	__PACKAGE__->table('artist');
	61	__PACKAGE__->add_column(bigint => { data_type => 'bigint' });
	62	}
	63	$schema->register_class(BigIntArtist => 'DBICTest::BigIntArtist');
	64	$schema->storage->dbh_do(sub {
	65	$_[1]->do('ALTER TABLE artist ADD COLUMN bigint BIGINT');
	66	});
	67
	68	# test upper/lower boundaries for sqlite and some values inbetween
	69	# range is -(263) .. 263 - 1
	70	for my $bi (qw/
	71	-9223372036854775808
	72	-9223372036854775807
	73	-8694837494948124658
	74	-6848440844435891639
	75	-5664812265578554454
	76	-5380388020020483213
	77	-2564279463598428141
	78	2442753333597784273
	79	4790993557925631491
	80	6773854980030157393
	81	7627910776496326154
	82	8297530189347439311
	83	9223372036854775806
	84	9223372036854775807
	85	/) {
	86	$row = $schema->resultset('BigIntArtist')->create({ bigint => $bi });
	87	is ($row->bigint, $bi, "value in object correct ($bi)");
	88
	89	TODO: {
	90	local $TODO = 'This perl does not seem to have 64bit int support - DBI roundtrip of large int will fail'
	91	unless $Config{ivsize} >= 8;
	92
	93	$row->discard_changes;
	94	is ($row->bigint, $bi, "value in database correct ($bi)");
	95	}
	96	}
	97
49	98	done_testing;
50	99
51	100	# vim:sts=2 sw=2:

+9

-4

t/86sqlt.t less more

58	58	$custom_deployment_statements_called = 0;
59	59
60	60	# add a temporary sqlt_deploy_hook to a source
61		no warnings 'once';
62		local *DBICTest::Track::sqlt_deploy_hook = sub {
63		my ($self, $sqlt_table) = @_;
	61	local $DBICTest::Schema::Track::hook_cb = sub {
	62	my ($class, $sqlt_table) = @_;
64	63
65	64	$deploy_hook_called = 1;
66	65
67		is (blessed ($self), 'DBIx::Class::ResultSource::Table', 'Source object passed to plain hook');
	66	is ($class, 'DBICTest::Track', 'Result class passed to plain hook');
68	67
69	68	is (
70	69	$sqlt_table->schema->translator->producer_type,

73	72	);
74	73	};
75	74
	75	my $component_deploy_hook_called = 0;
	76	local $DBICTest::DeployComponent::hook_cb = sub {
	77	$component_deploy_hook_called = 1;
	78	};
	79
76	80	$schema->deploy; # do not remove, this fires the is() test in the callback above
77	81	ok($deploy_hook_called, 'deploy hook got called');
78	82	ok($custom_deployment_statements_called, '->deploy used the schemas deploy_statements method');
	83	ok($component_deploy_hook_called, 'component deploy hook got called');
79	84	}
80	85
81	86	{

+25

-0

t/87ordered.t less more

95	95	"overloaded update 7"
96	96	);
97	97
	98	$employee->group_id(2);
	99	$employee->name('E of the month');
	100	$employee->update({ employee_id => 666, position => 2 });
	101	is_deeply(
	102	{ $employee->get_columns },
	103	{
	104	employee_id => 666,
	105	encoded => undef,
	106	group_id => 2,
	107	group_id_2 => undef,
	108	group_id_3 => undef,
	109	name => "E of the month",
	110	position => 2
	111	},
	112	'combined update() worked correctly'
	113	);
	114	is_deeply(
	115	{ $employee->get_columns },
	116	{ $employee->get_from_storage->get_columns },
	117	'object matches database state',
	118	);
	119
	120	#####
98	121	# multicol tests begin here
	122	#####
	123
99	124	DBICTest::Employee->grouping_column(['group_id_2', 'group_id_3']);
100	125	$employees->delete();
101	126	foreach my $group_id_2 (1..4) {

+7

-0

t/98savepoints.t less more

1	1	use warnings;
2	2
3	3	use Test::More;
	4	use DBIx::Class::Optional::Dependencies ();
4	5
5	6	my ($create_sql, $dsn, $user, $pass);
6	7
7	8	if ($ENV{DBICTEST_PG_DSN}) {
	9	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('rdbms_pg')
	10	unless DBIx::Class::Optional::Dependencies->req_ok_for ('rdbms_pg');
	11
8	12	($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
9	13
10	14	$create_sql = "CREATE TABLE artist (artistid serial PRIMARY KEY, name VARCHAR(100), rank INTEGER NOT NULL DEFAULT '13', charfield CHAR(10))";
11	15	} elsif ($ENV{DBICTEST_MYSQL_DSN}) {
	16	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_mysql')
	17	unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_mysql');
	18
12	19	($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/};
13	20
14	21	$create_sql = "CREATE TABLE artist (artistid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(100), rank INTEGER NOT NULL DEFAULT '13', charfield CHAR(10)) ENGINE=InnoDB";

+22

-5

t/inflate/datetime_firebird.t less more

2	2
3	3	use Test::More;
4	4	use Test::Exception;
	5	use DBIx::Class::Optional::Dependencies ();
5	6	use lib qw(t/lib);
6	7	use DBICTest;
7	8	use Scope::Guard ();
8	9
9	10	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_FIREBIRD_${_}" } qw/DSN USER PASS/};
10		my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_FIREBIRD_ODBC_${_}" } qw/DSN USER PASS/};
	11	my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_FIREBIRD_INTERBASE_${_}" } qw/DSN USER PASS/};
	12	my ($dsn3, $user3, $pass3) = @ENV{map { "DBICTEST_FIREBIRD_ODBC_${_}" } qw/DSN USER PASS/};
	13
	14	plan skip_all => 'Test needs ' .
	15	(join ' and ', map { $_ ? $_ : () }
	16	DBIx::Class::Optional::Dependencies->req_missing_for('test_dt'),
	17	(join ' or ', map { $_ ? $_ : () }
	18	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_firebird'),
	19	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_firebird_interbase'),
	20	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_firebird_odbc')))
	21	unless
	22	DBIx::Class::Optional::Dependencies->req_ok_for ('test_dt') && (
	23	$dsn && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_firebird')
	24	or
	25	$dsn2 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_firebird_interbase')
	26	or
	27	$dsn3 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_firebird_odbc'))
	28	or (not $dsn \|\| $dsn2 \|\| $dsn3);
11	29
12	30	if (not ($dsn \|\| $dsn2)) {
13	31	plan skip_all => <<'EOF';
14		Set $ENV{DBICTEST_FIREBIRD_DSN} and/or $ENV{DBICTEST_FIREBIRD_ODBC_DSN}
	32	Set $ENV{DBICTEST_FIREBIRD_DSN} and/or $ENV{DBICTEST_FIREBIRD_INTERBASE_DSN}
	33	and/or $ENV{DBICTEST_FIREBIRD_ODBC_DSN}
15	34	_USER and _PASS to run this test'.
16	35	Warning: This test drops and creates a table called 'event'";
17	36	EOF
18	37	}
19	38
20		plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_dt')
21		unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_dt');
22
23	39	my @info = (
24	40	[ $dsn, $user, $pass ],
25	41	[ $dsn2, $user2, $pass2 ],
	42	[ $dsn3, $user3, $pass3 ],
26	43	);
27	44
28	45	my $schema;

+7

-3

t/inflate/datetime_informix.t less more

2	2
3	3	use Test::More;
4	4	use Test::Exception;
	5	use DBIx::Class::Optional::Dependencies ();
5	6	use lib qw(t/lib);
6	7	use DBICTest;
7	8	use Scope::Guard ();
	9
	10	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_dt')
	11	. ' and ' .
	12	DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_informix')
	13	unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_dt')
	14	&& DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_informix');
8	15
9	16	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_INFORMIX_${_}" } qw/DSN USER PASS/};
10	17

14	21	Warning: This test drops and creates a table called 'event'";
15	22	EOF
16	23	}
17
18		plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_dt')
19		unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_dt');
20	24
21	25	my $schema;
22	26

+21

-0

t/inflate/datetime_missing_deps.t less more

	0	use strict;
	1	use warnings;
	2
	3	use Test::More;
	4	use Test::Exception;
	5	use lib qw(t/lib);
	6	use DBICTest;
	7
	8	my $no_class = '_DBICTEST_NONEXISTENT_CLASS_';
	9
	10	my $schema = DBICTest->init_schema();
	11	$schema->storage->datetime_parser_type($no_class);
	12
	13	my $event = $schema->resultset('Event')->find(1);
	14
	15	# test that datetime_undef_if_invalid does not eat the missing dep exception
	16	throws_ok {
	17	my $dt = $event->starts_at;
	18	} qr{Can't locate ${no_class}\.pm};
	19
	20	done_testing;

+16

-4

t/inflate/datetime_msaccess.t less more

4	4	use Test::Exception;
5	5	use Scope::Guard ();
6	6	use Try::Tiny;
	7	use DBIx::Class::Optional::Dependencies ();
7	8	use lib qw(t/lib);
8	9	use DBICTest;
9	10
10	11	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSACCESS_ODBC_${_}" } qw/DSN USER PASS/};
11	12	my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_MSACCESS_ADO_${_}" } qw/DSN USER PASS/};
12	13
	14	plan skip_all => 'Test needs ' .
	15	(join ' and ', map { $_ ? $_ : () }
	16	DBIx::Class::Optional::Dependencies->req_missing_for('test_dt'),
	17	(join ' or ', map { $_ ? $_ : () }
	18	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_msaccess_odbc'),
	19	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_msaccess_ado')))
	20	unless
	21	DBIx::Class::Optional::Dependencies->req_ok_for ('test_dt') && (
	22	$dsn && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_odbc')
	23	or
	24	$dsn2 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_ado'))
	25	or (not $dsn \|\| $dsn2);
	26
13	27	plan skip_all => <<'EOF' unless $dsn \|\| $dsn2;
14		Set $ENV{DBICTEST_MSACCESS_ODBC_DSN} and/or $ENV{DBICTEST_MSACCESS_ADO_DSN} (and optionally _USER and _PASS) to run these tests.\nWarning: this test drops and creates the table 'track'.
	28	Set $ENV{DBICTEST_MSACCESS_ODBC_DSN} and/or $ENV{DBICTEST_MSACCESS_ADO_DSN} (and optionally _USER and _PASS) to run these tests.
	29	Warning: this test drops and creates the table 'track'.
15	30	EOF
16
17		plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_dt')
18		unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_dt');
19	31
20	32	my @connect_info = (
21	33	[ $dsn, $user \|\| '', $pass \|\| '' ],

+21

-7

t/inflate/datetime_mssql.t less more

4	4	use Test::Exception;
5	5	use Scope::Guard ();
6	6	use Try::Tiny;
	7	use DBIx::Class::Optional::Dependencies ();
7	8	use lib qw(t/lib);
8	9	use DBICTest;
9	10
10		DBICTest::Schema->load_classes('EventSmallDT');
	11	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/};
	12	my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_MSSQL_${_}" } qw/DSN USER PASS/};
	13	my ($dsn3, $user3, $pass3) = @ENV{map { "DBICTEST_MSSQL_ADO_${_}" } qw/DSN USER PASS/};
	14
	15	plan skip_all => 'Test needs ' .
	16	(join ' and ', map { $_ ? $_ : () }
	17	DBIx::Class::Optional::Dependencies->req_missing_for('test_dt'),
	18	(join ' or ', map { $_ ? $_ : () }
	19	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_mssql_odbc'),
	20	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_mssql_sybase'),
	21	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_mssql_ado')))
	22	unless
	23	DBIx::Class::Optional::Dependencies->req_ok_for ('test_dt') && (
	24	$dsn && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_mssql_odbc')
	25	or
	26	$dsn2 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_mssql_sybase')
	27	or
	28	$dsn3 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_mssql_ado'))
	29	or (not $dsn \|\| $dsn2 \|\| $dsn3);
11	30
12	31	# use this if you keep a copy of DBD::Sybase linked to FreeTDS somewhere else
13	32	BEGIN {

15	34	unshift @INC, $_ for split /:/, $lib_dirs;
16	35	}
17	36	}
18
19		my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/};
20		my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_MSSQL_${_}" } qw/DSN USER PASS/};
21		my ($dsn3, $user3, $pass3) = @ENV{map { "DBICTEST_MSSQL_ADO_${_}" } qw/DSN USER PASS/};
22	37
23	38	if (not ($dsn \|\| $dsn2 \|\| $dsn3)) {
24	39	plan skip_all =>

28	43	." 'track'.";
29	44	}
30	45
31		plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_dt')
32		unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_dt');
	46	DBICTest::Schema->load_classes('EventSmallDT');
33	47
34	48	my @connect_info = (
35	49	[ $dsn, $user, $pass ],

+1

-0

t/inflate/datetime_mysql.t less more

3	3	use Test::More;
4	4	use Test::Exception;
5	5	use Test::Warn;
	6	use DBIx::Class::Optional::Dependencies ();
6	7	use lib qw(t/lib);
7	8	use DBICTest;
8	9	use DBICTest::Schema;

+4

-3

t/inflate/datetime_oracle.t less more

2	2
3	3	use Test::More;
4	4	use Test::Exception;
	5	use DBIx::Class::Optional::Dependencies ();
5	6	use lib qw(t/lib);
6	7	use DBICTest;
	8
	9	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_oracle')
	10	unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_oracle');
7	11
8	12	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_ORA_${_}" } qw/DSN USER PASS/};
9	13

11	15	plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test. ' .
12	16	'Warning: This test drops and creates a table called \'track\'';
13	17	}
14
15		plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_oracle')
16		unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_oracle');
17	18
18	19	# DateTime::Format::Oracle needs this set
19	20	$ENV{NLS_DATE_FORMAT} = 'DD-MON-YY';

+1

-0

t/inflate/datetime_pg.t less more

2	2
3	3	use Test::More;
4	4	use Test::Warn;
	5	use DBIx::Class::Optional::Dependencies ();
5	6	use lib qw(t/lib);
6	7	use DBICTest;
7	8

+14

-3

t/inflate/datetime_sqlanywhere.t less more

3	3	use Test::More;
4	4	use Test::Exception;
5	5	use Scope::Guard ();
	6	use DBIx::Class::Optional::Dependencies ();
6	7	use lib qw(t/lib);
7	8	use DBICTest;
8	9
9	10	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SQLANYWHERE_${_}" } qw/DSN USER PASS/};
10	11	my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_SQLANYWHERE_ODBC_${_}" } qw/DSN USER PASS/};
	12
	13	plan skip_all => 'Test needs ' .
	14	(join ' and ', map { $_ ? $_ : () }
	15	DBIx::Class::Optional::Dependencies->req_missing_for('test_dt'),
	16	(join ' or ', map { $_ ? $_ : () }
	17	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_sqlanywhere'),
	18	DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_sqlanywhere_odbc')))
	19	unless
	20	DBIx::Class::Optional::Dependencies->req_ok_for ('test_dt') && (
	21	$dsn && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_sqlanywhere')
	22	or
	23	$dsn2 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_sqlanywhere_odbc'))
	24	or (not $dsn \|\| $dsn2);
11	25
12	26	if (not ($dsn \|\| $dsn2)) {
13	27	plan skip_all => <<'EOF';

16	30	Warning: This test drops and creates a table called 'event'";
17	31	EOF
18	32	}
19
20		plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_dt')
21		unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_dt');
22	33
23	34	my @info = (
24	35	[ $dsn, $user, $pass ],

+9

-4

t/inflate/datetime_sybase.t less more

4	4	use Test::Exception;
5	5	use Scope::Guard ();
6	6	use Try::Tiny;
	7	use DBIx::Class::Optional::Dependencies ();
7	8	use lib qw(t/lib);
8	9	use DBICTest;
9	10
10		DBICTest::Schema->load_classes('EventSmallDT');
	11	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_dt')
	12	. ' and ' .
	13	DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_ase')
	14	unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_dt')
	15	&& DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_ase');
11	16
12	17	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/};
13	18
14	19	if (not ($dsn && $user)) {
15	20	plan skip_all =>
16	21	'Set $ENV{DBICTEST_SYBASE_DSN}, _USER and _PASS to run this test' .
17		"\nWarning: This test drops and creates a table called 'track'";
	22	"\nWarning: This test drops and creates a table called 'track' and " .
	23	"'event_small_dt'";
18	24	}
19	25
20		plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_ase')
21		unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_ase');
	26	DBICTest::Schema->load_classes('EventSmallDT');
22	27
23	28	my @storage_types = (
24	29	'DBI::Sybase::ASE',

+19

-0

t/lib/DBICTest/BaseResult.pm less more

3	3	use strict;
4	4	use warnings;
5	5
	6	#use base qw/DBIx::Class::Relationship::Cascade::Rekey DBIx::Class::Core/;
6	7	use base qw/DBIx::Class::Core/;
7	8	use DBICTest::BaseResultSet;
8	9
9	10	__PACKAGE__->table ('bogus');
10	11	__PACKAGE__->resultset_class ('DBICTest::BaseResultSet');
11	12
	13	#sub add_relationship {
	14	# my $self = shift;
	15	# my $opts = $_[3] \|\| {};
	16	# if (grep { $_ eq $_[0] } qw/
	17	# cds_90s cds_80s cds_84 artist_undirected_maps mapped_artists last_track
	18	# /) {
	19	# # nothing - join-dependent or non-cascadeable relationship
	20	# }
	21	# elsif ($opts->{is_foreign_key_constraint}) {
	22	# $opts->{on_update} \|\|= 'cascade';
	23	# }
	24	# else {
	25	# $opts->{cascade_rekey} = 1
	26	# unless ref $_[2] eq 'CODE';
	27	# }
	28	# $self->next::method(@_[0..2], $opts);
	29	#}
	30
12	31	1;

+16

-0

t/lib/DBICTest/DeployComponent.pm less more

	0	# belongs to t/86sqlt.t
	1	package # hide from PAUSE
	2	DBICTest::DeployComponent;
	3	use warnings;
	4	use strict;
	5
	6	our $hook_cb;
	7
	8	sub sqlt_deploy_hook {
	9	my $class = shift;
	10
	11	$hook_cb->($class, @_) if $hook_cb;
	12	$class->next::method(@_) if $class->next::can;
	13	}
	14
	15	1;

+1

-1

t/lib/DBICTest/Schema/Event.pm less more

11	11	id => { data_type => 'integer', is_auto_increment => 1 },
12	12
13	13	# this MUST be 'date' for the Firebird and SQLAnywhere tests
14		starts_at => { data_type => 'date' },
	14	starts_at => { data_type => 'date', datetime_undef_if_invalid => 1 },
15	15
16	16	created_on => { data_type => 'timestamp' },
17	17	varchar_date => { data_type => 'varchar', size => 20, is_nullable => 1 },

+18

-5

t/lib/DBICTest/Schema/Track.pm less more

3	3	use base qw/DBICTest::BaseResult/;
4	4	use Carp qw/confess/;
5	5
6		__PACKAGE__->load_components(qw/InflateColumn::DateTime Ordered/);
	6	__PACKAGE__->load_components(qw{
	7	+DBICTest::DeployComponent
	8	InflateColumn::DateTime
	9	Ordered
	10	});
7	11
8	12	__PACKAGE__->table('track');
9	13	__PACKAGE__->add_columns(

64	68	{ join_type => 'left' },
65	69	);
66	70
67		__PACKAGE__->might_have (
68		next_track => __PACKAGE__,
	71	__PACKAGE__->has_many (
	72	next_tracks => __PACKAGE__,
69	73	sub {
70	74	my $args = shift;
71	75

82	86	"$args->{foreign_alias}.position" => { '>' => { -ident => "$args->{self_alias}.position" } },
83	87	},
84	88	$args->{self_rowobj} && {
85		"$args->{foreign_alias}.cd" => $args->{self_rowobj}->cd,
86		"$args->{foreign_alias}.position" => { '>' => $args->{self_rowobj}->position },
	89	"$args->{foreign_alias}.cd" => $args->{self_rowobj}->get_column('cd'),
	90	"$args->{foreign_alias}.position" => { '>' => $args->{self_rowobj}->pos },
87	91	}
88	92	)
89	93	}
90	94	);
91	95
	96	our $hook_cb;
	97
	98	sub sqlt_deploy_hook {
	99	my $class = shift;
	100
	101	$hook_cb->($class, @_) if $hook_cb;
	102	$class->next::method(@_) if $class->next::can;
	103	}
	104
92	105	1;

+2

-0

t/lib/DBICTest/Schema.pm less more

3	3	use base qw/DBIx::Class::Schema/;
4	4
5	5	no warnings qw/qw/;
	6
	7	__PACKAGE__->mk_group_accessors(simple => 'custom_attr');
6	8
7	9	__PACKAGE__->load_classes(qw/
8	10	Artist

+2

-2

t/lib/sqlite.sql less more

0	0	--
1	1	-- Created by SQL::Translator::Producer::SQLite
2		-- Created on Tue Feb 22 18:42:16 2011
	2	-- Created on Sat Jun 11 00:39:51 2011
3	3	--
4	4
5	5	--

67	67	hello integer NOT NULL,
68	68	goodbye integer NOT NULL,
69	69	sensors character(10) NOT NULL,
70		read_count integer,
	70	read_count int,
71	71	PRIMARY KEY (foo, bar, hello, goodbye)
72	72	);
73	73

+2

-2

t/relationship/custom.t less more

193	193	}
194	194
195	195	my $last_tracks_rs = $schema->resultset('Track')->search (
196		{'next_track.trackid' => undef},
197		{ join => 'next_track', order_by => 'me.cd' },
	196	{'next_tracks.trackid' => undef},
	197	{ join => 'next_tracks', order_by => 'me.cd' },
198	198	);
199	199
200	200	is_deeply (

+35

-0

t/row/find_one_has_many.t less more

	0	use strict;
	1	use warnings;
	2
	3	use Test::More;
	4	use Test::Exception;
	5	use lib qw(t/lib);
	6	use DBICTest;
	7	use DBIC::DebugObj;
	8	use DBIC::SqlMakerTest;
	9
	10	my $schema = DBICTest->init_schema();
	11
	12	$schema->resultset('Artist')->delete;
	13	$schema->resultset('CD')->delete;
	14
	15	my $artist = $schema->resultset("Artist")->create({ artistid => 21, name => 'Michael Jackson', rank => 20 });
	16	my $cd = $artist->create_related('cds', { year => 1975, title => 'Compilation from 1975' });
	17
	18	my ($sql, @bind);
	19	local $schema->storage->{debug} = 1;
	20	local $schema->storage->{debugobj} = DBIC::DebugObj->new(\$sql, \@bind);
	21
	22	my $find_cd = $artist->find_related('cds',{title => 'Compilation from 1975'});
	23
	24	s/^'//, s/'\z// for @bind; # why does DBIC::DebugObj not do this?
	25
	26	is_same_sql_bind (
	27	$sql,
	28	\@bind,
	29	'SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE ( ( me.artist = ? AND me.title = ? ) ) ORDER BY year ASC',
	30	[21, 'Compilation from 1975'],
	31	'find_related only uses foreign key condition once',
	32	);
	33
	34	done_testing;

+16

-2

t/schema/clone.t less more

6	6
7	7	my $schema = DBICTest->init_schema();
8	8
9		my $clone = $schema->clone;
10		cmp_ok ($clone->storage, 'eq', $schema->storage, 'Storage copied into new schema (not a new instance)');
	9	{
	10	my $clone = $schema->clone;
	11	cmp_ok ($clone->storage, 'eq', $schema->storage, 'Storage copied into new schema (not a new instance)');
	12	}
	13
	14	{
	15	is $schema->custom_attr, undef;
	16	my $clone = $schema->clone(custom_attr => 'moo');
	17	is $clone->custom_attr, 'moo', 'cloning can change existing attrs';
	18	}
	19
	20	{
	21	my $clone = $schema->clone({ custom_attr => 'moo' });
	22	is $clone->custom_attr, 'moo', 'cloning can change existing attrs';
	23	}
	24
11	25
12	26	done_testing;

+30

-0

t/sqlmaker/limit_dialects/rno.t less more

179	179	);
180	180	}
181	181
	182	{
	183	my $subq = $schema->resultset('Owners')->search({
	184	'books.owner' => { -ident => 'owner.id' },
	185	}, { alias => 'owner', select => ['id'] } )->count_rs;
	186
	187	my $rs_selectas_rel = $schema->resultset('BooksInLibrary')->search( { -exists => $subq->as_query }, { select => ['id','owner'], rows => 1 } );
	188
	189	is_same_sql_bind(
	190	$rs_selectas_rel->as_query,
	191	'(
	192	SELECT [id], [owner] FROM (
	193	SELECT [id], [owner], ROW_NUMBER() OVER( ) AS [rno__row__index] FROM (
	194	SELECT [me].[id], [me].[owner]
	195	FROM [books] [me]
	196	WHERE ( ( (EXISTS (
	197	SELECT COUNT( * ) FROM [owners] [owner] WHERE ( [books].[owner] = [owner].[id] )
	198	)) AND [source] = ? ) )
	199	) [me]
	200	) [me] WHERE [rno__row__index] >= ? AND [rno__row__index] <= ?
	201	)',
	202	[
	203	[ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' } => 'Library' ],
	204	[ $OFFSET => 1 ],
	205	[ $TOTAL => 1 ],
	206	],
	207	'Pagination with sub-query in WHERE works'
	208	);
	209
	210	}
	211
182	212
183	213	done_testing;

+136

-43

t/sqlmaker/limit_dialects/rownum.t less more

17	17
18	18	my $rs = $s->resultset ('CD');
19	19
20		is_same_sql_bind (
21		$rs->search ({}, { rows => 1, offset => 3,columns => [
22		{ id => 'foo.id' },
23		{ 'bar.id' => 'bar.id' },
24		{ bleh => \ 'TO_CHAR (foo.womble, "blah")' },
25		]})->as_query,
26		'(
27		SELECT id, bar__id, bleh
	20	for my $test_set (
	21	{
	22	name => 'Rownum subsel aliasing works correctly',
	23	rs => $rs->search_rs(undef, {
	24	rows => 1,
	25	offset => 3,
	26	columns => [
	27	{ id => 'foo.id' },
	28	{ 'bar.id' => 'bar.id' },
	29	{ bleh => \'TO_CHAR (foo.womble, "blah")' },
	30	]
	31	}),
	32	sql => '(
	33	SELECT id, bar__id, bleh
28	34	FROM (
29	35	SELECT id, bar__id, bleh, ROWNUM rownum__index
30		FROM (
31		SELECT foo.id AS id, bar.id AS bar__id, TO_CHAR(foo.womble, "blah") AS bleh
32		FROM cd me
33		) me
	36	FROM (
	37	SELECT foo.id AS id, bar.id AS bar__id, TO_CHAR (foo.womble, "blah") AS bleh
	38	FROM cd me
	39	) me
	40	) me WHERE rownum__index BETWEEN ? AND ?
	41	)',
	42	binds => [
	43	[ $OFFSET => 4 ],
	44	[ $TOTAL => 4 ],
	45	],
	46	}, {
	47	name => 'Rownum subsel aliasing works correctly with unique order_by',
	48	rs => $rs->search_rs(undef, {
	49	rows => 1,
	50	offset => 3,
	51	columns => [
	52	{ id => 'foo.id' },
	53	{ 'bar.id' => 'bar.id' },
	54	{ bleh => \'TO_CHAR (foo.womble, "blah")' },
	55	],
	56	order_by => [qw( artist title )],
	57	}),
	58	sql => '(
	59	SELECT id, bar__id, bleh
	60	FROM (
	61	SELECT id, bar__id, bleh, ROWNUM rownum__index
	62	FROM (
	63	SELECT foo.id AS id, bar.id AS bar__id, TO_CHAR(foo.womble, "blah") AS bleh
	64	FROM cd me
	65	ORDER BY artist, title
	66	) me
34	67	WHERE ROWNUM <= ?
35	68	) me
36		WHERE rownum__index >= ?
37		)',
38		[
39		[ $TOTAL => 4 ],
40		[ $OFFSET => 4 ],
41		],
42		'Rownum subsel aliasing works correctly'
43		);
44
45		is_same_sql_bind (
46		$rs->search ({}, { rows => 2, offset => 3,columns => [
47		{ id => 'foo.id' },
48		{ 'ends_with_me.id' => 'ends_with_me.id' },
49		]})->as_query,
50		'(SELECT id, ends_with_me__id
	69	WHERE rownum__index >= ?
	70	)',
	71	binds => [
	72	[ $TOTAL => 4 ],
	73	[ $OFFSET => 4 ],
	74	],
	75	}, {
	76	name => 'Rownum subsel aliasing #2 works correctly',
	77	rs => $rs->search_rs(undef, {
	78	rows => 2,
	79	offset => 3,
	80	columns => [
	81	{ id => 'foo.id' },
	82	{ 'ends_with_me.id' => 'ends_with_me.id' },
	83	]
	84	}),
	85	sql => '(
	86	SELECT id, ends_with_me__id
51	87	FROM (
52	88	SELECT id, ends_with_me__id, ROWNUM rownum__index
53		FROM (
54		SELECT foo.id AS id, ends_with_me.id AS ends_with_me__id
55		FROM cd me
56		) me
	89	FROM (
	90	SELECT foo.id AS id, ends_with_me.id AS ends_with_me__id
	91	FROM cd me
	92	) me
	93	) me WHERE rownum__index BETWEEN ? AND ?
	94	)',
	95	binds => [
	96	[ $OFFSET => 4 ],
	97	[ $TOTAL => 5 ],
	98	],
	99	}, {
	100	name => 'Rownum subsel aliasing #2 works correctly with unique order_by',
	101	rs => $rs->search_rs(undef, {
	102	rows => 2,
	103	offset => 3,
	104	columns => [
	105	{ id => 'foo.id' },
	106	{ 'ends_with_me.id' => 'ends_with_me.id' },
	107	],
	108	order_by => [qw( artist title )],
	109	}),
	110	sql => '(
	111	SELECT id, ends_with_me__id
	112	FROM (
	113	SELECT id, ends_with_me__id, ROWNUM rownum__index
	114	FROM (
	115	SELECT foo.id AS id, ends_with_me.id AS ends_with_me__id
	116	FROM cd me
	117	ORDER BY artist, title
	118	) me
57	119	WHERE ROWNUM <= ?
58	120	) me
59		WHERE rownum__index >= ?
60		)',
61		[
62		[ $TOTAL => 5 ],
63		[ $OFFSET => 4 ],
64		],
65		'Rownum subsel aliasing works correctly'
66		);
	121	WHERE rownum__index >= ?
	122	)',
	123	binds => [
	124	[ $TOTAL => 5 ],
	125	[ $OFFSET => 4 ],
	126	],
	127	}
	128	) {
	129	is_same_sql_bind(
	130	$test_set->{rs}->as_query,
	131	$test_set->{sql},
	132	$test_set->{binds},
	133	$test_set->{name});
	134	}
67	135
68	136	{
69	137	my $subq = $s->resultset('Owners')->search({

93	161	JOIN owners owner ON owner.id = me.owner
94	162	WHERE ( source = ? )
95	163	) me
96		WHERE ROWNUM <= ?
97		) me
98		WHERE rownum__index >= ?
	164	) me
	165	WHERE rownum__index BETWEEN ? AND ?
99	166	)',
100	167	[
101	168	[ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' }
102	169	=> 'Library' ],
	170	[ $OFFSET => 4 ],
103	171	[ $TOTAL => 5 ],
104		[ $OFFSET => 4 ],
105	172	],
106	173
107	174	'pagination with subquery works'

124	191	);
125	192	}
126	193
	194	{
	195	my $subq = $s->resultset('Owners')->search({
	196	'books.owner' => { -ident => 'owner.id' },
	197	}, { alias => 'owner', select => ['id'] } )->count_rs;
	198
	199	my $rs_selectas_rel = $s->resultset('BooksInLibrary')->search( { -exists => $subq->as_query }, { select => ['id','owner'], rows => 1 } );
	200
	201	is_same_sql_bind(
	202	$rs_selectas_rel->as_query,
	203	'(
	204	SELECT id, owner FROM (
	205	SELECT id, owner, ROWNUM rownum__index FROM (
	206	SELECT me.id, me.owner FROM books me WHERE ( ( (EXISTS (SELECT COUNT( * ) FROM owners owner WHERE ( books.owner = owner.id ))) AND source = ? ) )
	207	) me
	208	) me WHERE rownum__index BETWEEN ? AND ?
	209	)',
	210	[
	211	[ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' } => 'Library' ],
	212	[ $OFFSET => 1 ],
	213	[ $TOTAL => 1 ],
	214	],
	215	'Pagination with sub-query in WHERE works'
	216	);
	217
	218	}
	219
127	220
128	221	done_testing;

+18

-0

t/sqlmaker/limit_dialects/toplimit.t less more

252	252	);
253	253	}
254	254
	255	{
	256	my $subq = $schema->resultset('Owners')->search({
	257	'books.owner' => { -ident => 'owner.id' },
	258	}, { alias => 'owner', select => ['id'] } )->count_rs;
	259
	260	my $rs_selectas_rel = $schema->resultset('BooksInLibrary')->search( { -exists => $subq->as_query }, { select => ['id','owner'], rows => 1 } );
	261
	262	is_same_sql_bind(
	263	$rs_selectas_rel->as_query,
	264	'(SELECT TOP 1 me.id, me.owner FROM books me WHERE ( ( (EXISTS (SELECT COUNT( * ) FROM owners owner WHERE ( books.owner = owner.id ))) AND source = ? ) ) ORDER BY me.id)',
	265	[
	266	[ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' } => 'Library' ],
	267	],
	268	'Pagination with sub-query in WHERE works'
	269	);
	270
	271	}
	272
255	273	done_testing;

+4

-4

t/sqlmaker/msaccess.t less more

4	4	use DBICTest;
5	5	use DBIC::SqlMakerTest;
6	6
7		use DBIx::Class::SQLMaker::ACCESS;
	7	use DBIx::Class::SQLMaker::ACCESS ();
8	8
9	9	my $sa = DBIx::Class::SQLMaker::ACCESS->new;
10	10

35	35	{ "track.cd" => "me.cdid" },
36	36	],
37	37	[
38		{ "-join_type" => "LEFT", artist => "artist" },
	38	{ artist => "artist" },
39	39	{ "artist.artistid" => "me.artist" },
40	40	],
41	41	],

45	45	);
46	46	is_same_sql_bind(
47	47	$sql, \@bind,
48		'SELECT track.title, cd.cdid, cd.artist, cd.title, cd.year, artist.artistid, artist.name FROM ((cd me LEFT JOIN track track ON track.cd = me.cdid) LEFT JOIN artist artist ON artist.artistid = me.artist)', [],
49		'two-step join parenthesized'
	48	'SELECT track.title, cd.cdid, cd.artist, cd.title, cd.year, artist.artistid, artist.name FROM ((cd me LEFT JOIN track track ON track.cd = me.cdid) INNER JOIN artist artist ON artist.artistid = me.artist)', [],
	49	'two-step join parenthesized and inner join prepended with INNER'
50	50	);
51	51
52	52	done_testing;

+31

-21

t/storage/debug.t less more

0	0	use strict;
1	1	use warnings;
	2	no warnings 'once';
2	3
3	4	use Test::More;
4	5	use Test::Exception;

8	9	use DBIC::SqlMakerTest;
9	10	use Path::Class qw/file/;
10	11
	12	BEGIN { delete @ENV{qw(DBIC_TRACE_PROFILE)} }
	13
11	14	my $schema = DBICTest->init_schema();
	15
	16	my $lfn = file('t/var/sql.log');
	17	unlink $lfn or die $!
	18	if -e $lfn;
12	19
13	20	# make sure we are testing the vanilla debugger and not ::PrettyPrint
14	21	$schema->storage->debugobj(DBIx::Class::Storage::Statistics->new);
15	22
16	23	ok ( $schema->storage->debug(1), 'debug' );
17		$schema->storage->debugfh(file('t/var/sql.log')->openw);
	24	$schema->storage->debugfh($lfn->openw);
	25	$schema->storage->debugfh->autoflush(1);
	26	$schema->resultset('CD')->count;
18	27
19		$schema->storage->debugfh->autoflush(1);
20		my $rs = $schema->resultset('CD')->search({});
21		$rs->count();
22
23		my $log = file('t/var/sql.log')->openr;
24		my $line = <$log>;
25		$log->close();
26		like($line, qr/^SELECT COUNT/, 'Log success');
	28	my @loglines = $lfn->slurp;
	29	is (@loglines, 1, 'one line of log');
	30	like($loglines[0], qr/^SELECT COUNT/, 'File log via debugfh success');
27	31
28	32	$schema->storage->debugfh(undef);
29		$ENV{'DBIC_TRACE'} = '=t/var/foo.log';
30		$rs = $schema->resultset('CD')->search({});
31		$rs->count();
32		$log = file('t/var/foo.log')->openr;
33		$line = <$log>;
34		$log->close();
35		like($line, qr/^SELECT COUNT/, 'Log success');
36		$schema->storage->debugobj->debugfh(undef);
37		delete($ENV{'DBIC_TRACE'});
	33
	34	{
	35	local $ENV{DBIC_TRACE} = "=$lfn";
	36	unlink $lfn;
	37
	38	$schema->resultset('CD')->count;
	39
	40	my $schema2 = DBICTest->init_schema(no_deploy => 1);
	41	$schema2->storage->_do_query('SELECT 1'); # _do_query() logs via standard mechanisms
	42
	43	my @loglines = $lfn->slurp;
	44	is(@loglines, 2, '2 lines of log');
	45	like($loglines[0], qr/^SELECT COUNT/, 'Env log from schema1 success');
	46	like($loglines[1], qr/^SELECT 1:/, 'Env log from schema2 success');
	47
	48	$schema->storage->debugobj->debugfh(undef)
	49	}
38	50
39	51	open(STDERRCOPY, '>&STDERR');
40		stat(STDERRCOPY); # nop to get warnings quiet
41	52	close(STDERR);
42	53	dies_ok {
43		$rs = $schema->resultset('CD')->search({});
44		$rs->count();
	54	$schema->resultset('CD')->search({})->count;
45	55	} 'Died on closed FH';
46	56
47	57	open(STDERR, '>&STDERRCOPY');

+11

-0

t/storage/global_destruction.t less more

2	2
3	3	use Test::More;
4	4	use Test::Exception;
	5
	6	use DBIx::Class::Optional::Dependencies ();
5	7
6	8	use lib qw(t/lib);
7	9	use DBICTest;

11	13	SKIP: {
12	14	skip "Skipping $type tests without DBICTEST_${type}_DSN", 1
13	15	unless $ENV{"DBICTEST_${type}_DSN"};
	16
	17	if ($type eq 'PG') {
	18	skip "skipping Pg tests without dependencies installed", 1
	19	unless DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_pg');
	20	}
	21	elsif ($type eq 'MYSQL') {
	22	skip "skipping MySQL tests without dependencies installed", 1
	23	unless DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_mysql');
	24	}
14	25
15	26	my $schema = DBICTest::Schema->connect (@ENV{map { "DBICTEST_${type}_${_}" } qw/DSN USER PASS/});
16	27

+10

-3

t/storage/quote_names.t less more

2	2	use Test::More;
3	3	use Test::Exception;
4	4	use Data::Dumper::Concise;
	5	use Try::Tiny;
5	6	use lib qw(t/lib);
6	7	use DBICTest;
7	8

102	103
103	104	next unless $dsn;
104	105
105		my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
106		quote_names => 1
107		});
	106	my $schema;
	107
	108	try {
	109	$schema = DBICTest::Schema->connect($dsn, $user, $pass, {
	110	quote_names => 1
	111	});
	112	$schema->storage->ensure_connected;
	113	1;
	114	} \|\| next;
108	115
109	116	my $expected_quote_char = $expected{$base_class}{quote_char};
110	117	my $quote_char_text = dumper($expected_quote_char);

+21

-0

t/update/all.t less more

	0	use strict;
	1	use warnings;
	2
	3	use Test::More;
	4	use lib qw(t/lib);
	5	use DBICTest;
	6
	7	my $schema = DBICTest->init_schema();
	8
	9	my $new_artist = $schema->resultset('Artist')->create({ name => 'new kid behind the block' });
	10
	11	# see how many cds do we have, and relink them all to the new guy
	12	my $cds = $schema->resultset('CD');
	13	my $cds_count = $cds->count;
	14	cmp_ok($cds_count, '>', 0, 'have some cds');
	15
	16	$cds->update_all({ artist => $new_artist });
	17
	18	is( $new_artist->cds->count, $cds_count, 'All cds properly relinked');
	19
	20	done_testing;

+34

-0

t/update/ident_cond.t less more

	0	use strict;
	1	use warnings;
	2
	3	use Test::More;
	4	use lib qw(t/lib);
	5	use DBICTest;
	6
	7	my $schema = DBICTest->init_schema();
	8
	9	my $artist = $schema->resultset('Artist')->next;
	10
	11	is_deeply(
	12	[ $artist->id, $artist->ident_condition, $artist->_storage_ident_condition ],
	13	[ 1, { artistid => 1 }, { artistid => 1 } ],
	14	'Correct identity state of freshly retrieved object',
	15	);
	16
	17	$artist->artistid(888);
	18
	19	is_deeply(
	20	[ $artist->id, $artist->ident_condition, $artist->_storage_ident_condition ],
	21	[ 888, { artistid => 888 }, { artistid => 1 } ],
	22	'Correct identity state of object with modified PK',
	23	);
	24
	25	$artist->update;
	26
	27	is_deeply(
	28	[ $artist->id, $artist->ident_condition, $artist->_storage_ident_condition ],
	29	[ 888, { artistid => 888 }, { artistid => 888 } ],
	30	'Correct identity state after storage update',
	31	);
	32
	33	done_testing;