[Bast-commits] r7609 - in DBIx-Class/0.08/branches/extended_rels: .
lib/DBIx lib/DBIx/Class lib/DBIx/Class/InflateColumn
lib/DBIx/Class/Manual lib/DBIx/Class/ResultSourceProxy
lib/DBIx/Class/SQLAHacks lib/DBIx/Class/Schema
lib/DBIx/Class/Serialize lib/DBIx/Class/Storage
lib/DBIx/Class/Storage/DBI lib/DBIx/Class/Storage/DBI/ODBC
lib/DBIx/Class/Storage/DBI/Oracle
lib/DBIx/Class/Storage/DBI/Replicated
lib/DBIx/Class/Storage/DBI/Sybase
lib/SQL/Translator/Parser/DBIx script t t/cdbi/testlib
t/count t/inflate t/lib t/lib/DBICTest t/lib/DBICTest/Schema
t/multi_create t/prefetch t/resultset t/search t/storage
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Wed Sep 9 09:39:57 GMT 2009
Author: ribasushi
Date: 2009-09-09 09:39:56 +0000 (Wed, 09 Sep 2009)
New Revision: 7609
Added:
DBIx-Class/0.08/branches/extended_rels/.gitignore
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/AutoCast.pm
DBIx-Class/0.08/branches/extended_rels/t/93autocast.t
DBIx-Class/0.08/branches/extended_rels/t/inflate/datetime_determine_parser.t
DBIx-Class/0.08/branches/extended_rels/t/multi_create/diamond.t
DBIx-Class/0.08/branches/extended_rels/t/multi_create/existing_in_chain.t
DBIx-Class/0.08/branches/extended_rels/t/multi_create/has_many.t
DBIx-Class/0.08/branches/extended_rels/t/storage/
DBIx-Class/0.08/branches/extended_rels/t/storage/base.t
DBIx-Class/0.08/branches/extended_rels/t/storage/dbh_do.t
DBIx-Class/0.08/branches/extended_rels/t/storage/dbi_coderef.t
DBIx-Class/0.08/branches/extended_rels/t/storage/debug.t
DBIx-Class/0.08/branches/extended_rels/t/storage/disable_sth_caching.t
DBIx-Class/0.08/branches/extended_rels/t/storage/error.t
DBIx-Class/0.08/branches/extended_rels/t/storage/exception.t
DBIx-Class/0.08/branches/extended_rels/t/storage/on_connect_call.t
DBIx-Class/0.08/branches/extended_rels/t/storage/on_connect_do.t
DBIx-Class/0.08/branches/extended_rels/t/storage/ping_count.t
DBIx-Class/0.08/branches/extended_rels/t/storage/reconnect.t
DBIx-Class/0.08/branches/extended_rels/t/storage/replication.t
DBIx-Class/0.08/branches/extended_rels/t/storage/stats.t
Removed:
DBIx-Class/0.08/branches/extended_rels/t/18inserterror.t
DBIx-Class/0.08/branches/extended_rels/t/31stats.t
DBIx-Class/0.08/branches/extended_rels/t/32connect_code_ref.t
DBIx-Class/0.08/branches/extended_rels/t/33storage_reconnect.t
DBIx-Class/0.08/branches/extended_rels/t/35disable_sth_caching.t
DBIx-Class/0.08/branches/extended_rels/t/36datetime.t
DBIx-Class/0.08/branches/extended_rels/t/91debug.t
DBIx-Class/0.08/branches/extended_rels/t/92storage.t
DBIx-Class/0.08/branches/extended_rels/t/92storage_on_connect_call.t
DBIx-Class/0.08/branches/extended_rels/t/92storage_on_connect_do.t
DBIx-Class/0.08/branches/extended_rels/t/93storage_replication.t
DBIx-Class/0.08/branches/extended_rels/t/cdbi/testlib/Binary.pm
DBIx-Class/0.08/branches/extended_rels/t/cdbi/testlib/PgBase.pm
DBIx-Class/0.08/branches/extended_rels/t/dbh_do.t
Modified:
DBIx-Class/0.08/branches/extended_rels/
DBIx-Class/0.08/branches/extended_rels/Changes
DBIx-Class/0.08/branches/extended_rels/MANIFEST.SKIP
DBIx-Class/0.08/branches/extended_rels/Makefile.PL
DBIx-Class/0.08/branches/extended_rels/TODO
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Core.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/InflateColumn/DateTime.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Component.pod
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Cookbook.pod
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/DocMap.pod
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Example.pod
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/FAQ.pod
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Intro.pod
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Troubleshooting.pod
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Ordered.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSet.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSource.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSourceHandle.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSourceProxy/Table.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Row.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/SQLAHacks.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/SQLAHacks/MySQL.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Schema.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Schema/Versioned.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Serialize/Storable.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/MSSQL.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/ODBC.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Oracle.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Pg.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Sybase.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/mysql.pm
DBIx-Class/0.08/branches/extended_rels/lib/SQL/Translator/Parser/DBIx/Class.pm
DBIx-Class/0.08/branches/extended_rels/script/dbicadmin
DBIx-Class/0.08/branches/extended_rels/t/02pod.t
DBIx-Class/0.08/branches/extended_rels/t/03podcoverage.t
DBIx-Class/0.08/branches/extended_rels/t/103many_to_many_warning.t
DBIx-Class/0.08/branches/extended_rels/t/19quotes.t
DBIx-Class/0.08/branches/extended_rels/t/19quotes_newstyle.t
DBIx-Class/0.08/branches/extended_rels/t/26dumper.t
DBIx-Class/0.08/branches/extended_rels/t/46where_attribute.t
DBIx-Class/0.08/branches/extended_rels/t/60core.t
DBIx-Class/0.08/branches/extended_rels/t/71mysql.t
DBIx-Class/0.08/branches/extended_rels/t/72pg.t
DBIx-Class/0.08/branches/extended_rels/t/745db2.t
DBIx-Class/0.08/branches/extended_rels/t/746db2_400.t
DBIx-Class/0.08/branches/extended_rels/t/746mssql.t
DBIx-Class/0.08/branches/extended_rels/t/76joins.t
DBIx-Class/0.08/branches/extended_rels/t/76select.t
DBIx-Class/0.08/branches/extended_rels/t/80unique.t
DBIx-Class/0.08/branches/extended_rels/t/83cache.t
DBIx-Class/0.08/branches/extended_rels/t/86sqlt.t
DBIx-Class/0.08/branches/extended_rels/t/87ordered.t
DBIx-Class/0.08/branches/extended_rels/t/89dbicadmin.t
DBIx-Class/0.08/branches/extended_rels/t/93nobindvars.t
DBIx-Class/0.08/branches/extended_rels/t/94versioning.t
DBIx-Class/0.08/branches/extended_rels/t/95sql_maker.t
DBIx-Class/0.08/branches/extended_rels/t/95sql_maker_quote.t
DBIx-Class/0.08/branches/extended_rels/t/99dbic_sqlt_parser.t
DBIx-Class/0.08/branches/extended_rels/t/count/distinct.t
DBIx-Class/0.08/branches/extended_rels/t/count/grouped_pager.t
DBIx-Class/0.08/branches/extended_rels/t/count/in_subquery.t
DBIx-Class/0.08/branches/extended_rels/t/inflate/core.t
DBIx-Class/0.08/branches/extended_rels/t/inflate/serialize.t
DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest.pm
DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/AuthorCheck.pm
DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/Artist.pm
DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/CD.pm
DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/CustomSql.pm
DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/Serialized.pm
DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/Track.pm
DBIx-Class/0.08/branches/extended_rels/t/lib/sqlite.sql
DBIx-Class/0.08/branches/extended_rels/t/multi_create/multilev_single_PKeqFK.t
DBIx-Class/0.08/branches/extended_rels/t/multi_create/standard.t
DBIx-Class/0.08/branches/extended_rels/t/prefetch/attrs_untouched.t
DBIx-Class/0.08/branches/extended_rels/t/prefetch/grouped.t
DBIx-Class/0.08/branches/extended_rels/t/prefetch/multiple_hasmany.t
DBIx-Class/0.08/branches/extended_rels/t/prefetch/standard.t
DBIx-Class/0.08/branches/extended_rels/t/resultset/as_query.t
DBIx-Class/0.08/branches/extended_rels/t/search/preserve_original_rs.t
DBIx-Class/0.08/branches/extended_rels/t/search/subquery.t
DBIx-Class/0.08/branches/extended_rels/t/zzzzzzz_perl_perf_bug.t
Log:
r7259 at Thesaurus (orig r7256): ribasushi | 2009-08-07 14:16:13 +0200
Fix bogus POD
r7261 at Thesaurus (orig r7258): ribasushi | 2009-08-07 17:22:58 +0200
per mst: no optional deps
r7262 at Thesaurus (orig r7259): ribasushi | 2009-08-08 17:02:39 +0200
Stop using discard_changes() in Ordered (if I knew it will be *that* complex I would not touch it)
r7265 at Thesaurus (orig r7262): ribasushi | 2009-08-08 17:49:19 +0200
r7032 at Thesaurus (orig r7031): caelum | 2009-07-11 11:28:52 +0200
new branch to reduce connected() calls
r7033 at Thesaurus (orig r7032): caelum | 2009-07-11 13:07:41 +0200
added failing test
r7034 at Thesaurus (orig r7033): caelum | 2009-07-11 14:36:53 +0200
minor optimization
r7048 at Thesaurus (orig r7047): caelum | 2009-07-14 15:09:47 +0200
substantially reduced ping count, dynamic cursors support for mssql through odbc
r7050 at Thesaurus (orig r7049): caelum | 2009-07-14 16:06:39 +0200
a couple more options for odbc/mssql
r7052 at Thesaurus (orig r7051): caelum | 2009-07-15 00:14:09 +0200
unfuck ensure_connected for odbc/mssql
r7055 at Thesaurus (orig r7054): caelum | 2009-07-15 21:10:27 +0200
rename _scope_identity to _identity for odbc/mssql
r7056 at Thesaurus (orig r7055): caelum | 2009-07-16 00:41:45 +0200
add IC::DT tests for odbc/mssql
r7069 at Thesaurus (orig r7068): caelum | 2009-07-17 11:47:31 +0200
don't run connection actions if ->_rebless does not connect
r7108 at Thesaurus (orig r7105): caelum | 2009-07-24 07:26:13 +0200
moving test to another branch
r7110 at Thesaurus (orig r7107): caelum | 2009-07-24 07:52:33 +0200
revert odbc/mssql code to trunk and move it to another branch
r7111 at Thesaurus (orig r7108): caelum | 2009-07-24 08:13:35 +0200
revert t/746mssql.t to trunk and move to another branch
r7224 at Thesaurus (orig r7221): caelum | 2009-08-05 11:48:04 +0200
update branch after pull
r7225 at Thesaurus (orig r7222): ribasushi | 2009-08-05 12:09:07 +0200
Rename last_dbh and turn it into a public method
r7226 at Thesaurus (orig r7223): ribasushi | 2009-08-05 12:12:20 +0200
Whoopsie - more renames
r7227 at Thesaurus (orig r7224): ribasushi | 2009-08-05 12:32:09 +0200
Changes and a deploy() fix
r7228 at Thesaurus (orig r7225): ribasushi | 2009-08-05 12:36:01 +0200
We do not count pings during deploy - they are expected
r7229 at Thesaurus (orig r7226): ribasushi | 2009-08-05 12:49:06 +0200
Clarify autocommit default
r7238 at Thesaurus (orig r7235): caelum | 2009-08-05 20:39:47 +0200
fix up txn_begin and the ping_count test
r7263 at Thesaurus (orig r7260): ribasushi | 2009-08-08 17:40:19 +0200
A more straightforward txn_begin fix, some more test fixes
r7270 at Thesaurus (orig r7267): ribasushi | 2009-08-09 00:34:31 +0200
r6822 at Thesaurus (orig r6821): caelum | 2009-06-28 14:38:12 +0200
branch
r6825 at Thesaurus (orig r6824): caelum | 2009-06-28 14:40:37 +0200
->table(\"table")
r6827 at Thesaurus (orig r6826): caelum | 2009-06-28 14:55:06 +0200
revert
r6829 at Thesaurus (orig r6828): caelum | 2009-06-28 15:57:40 +0200
r5742 at hlagh (orig r6819): ribasushi | 2009-06-28 04:00:03 -0700
The prefetch+group_by is a complex problem - branch
r6834 at Thesaurus (orig r6833): caelum | 2009-06-28 23:24:47 +0200
->table(\"foo") now works
r6835 at Thesaurus (orig r6834): caelum | 2009-06-29 03:54:31 +0200
another test
r6849 at Thesaurus (orig r6848): caelum | 2009-06-29 21:39:26 +0200
separated table ref test out, changed CDTableRef to a view with less rels
r6852 at Thesaurus (orig r6851): caelum | 2009-06-29 22:56:45 +0200
changed CD to ->table(\"cd")
r6853 at Thesaurus (orig r6852): caelum | 2009-06-29 23:13:48 +0200
fix t/80unique.t
r6857 at Thesaurus (orig r6856): caelum | 2009-06-29 23:45:19 +0200
branch pushed, removing
r6858 at Thesaurus (orig r6857): caelum | 2009-06-29 23:46:54 +0200
removing debug statement
r6860 at Thesaurus (orig r6859): ribasushi | 2009-06-30 00:03:21 +0200
Minor fixes
r6861 at Thesaurus (orig r6860): ribasushi | 2009-06-30 00:25:27 +0200
This is sloppy, but sqlt is sloppy too. All tests pass now, all we really need is to intercept name() set-calls, and use a virtual view (the only legit setter is the new() call in ResultSourceProxy::Table
r6867 at Thesaurus (orig r6866): caelum | 2009-06-30 03:34:02 +0200
forgot to use Scalar::Util ()
r7007 at Thesaurus (orig r7006): caelum | 2009-07-09 07:37:22 +0200
r5766 at hlagh (orig r6843): abraxxa | 2009-06-29 02:02:17 -0700
fixed typo in test
r5779 at hlagh (orig r6847): ribasushi | 2009-06-29 10:09:00 -0700
Minor Ordered optimization (don't use count)
r5787 at hlagh (orig r6855): caelum | 2009-06-29 14:42:11 -0700
r5451 at hlagh (orig r6605): caelum | 2009-06-10 09:23:44 -0700
new branch to implement on_connect_call
r5484 at hlagh (orig r6633): caelum | 2009-06-11 11:03:10 -0700
on_connect_call implementation and set_datetime_format support for Oracle
r5492 at hlagh (orig r6641): caelum | 2009-06-11 16:39:28 -0700
connect_call_set_datetime_format for Oracle, I have no idea why this didn't get committed before...
r5504 at hlagh (orig r6655): caelum | 2009-06-12 17:28:06 -0700
finished up on_connect_call stuff
r5507 at hlagh (orig r6658): caelum | 2009-06-13 04:03:36 -0700
fixup _setup_connect_do, other minor cleanups
r5508 at hlagh (orig r6659): caelum | 2009-06-13 04:35:33 -0700
make the on_(dis)?connect_do accessors returnn the original structure
r5509 at hlagh (orig r6660): caelum | 2009-06-13 08:31:52 -0700
allow undef for _setup_connect_do
r5522 at hlagh (orig r6679): caelum | 2009-06-14 09:56:40 -0700
rename connect_do store
r5621 at hlagh (orig r6769): caelum | 2009-06-23 07:38:33 -0700
minor doc update
r5628 at hlagh (orig r6777): caelum | 2009-06-23 16:36:12 -0700
properly test nanosecond precision with oracle and datetime_setup
r5669 at hlagh (orig r6784): caelum | 2009-06-24 10:49:25 -0700
IC::DT does support timestamp with timezone
r5768 at hlagh (orig r6846): caelum | 2009-06-29 08:20:32 -0700
remove DateTime from 73oracle.t
r5781 at hlagh (orig r6849): caelum | 2009-06-29 13:07:43 -0700
remove the _store stuff for on_connect_do
r5785 at hlagh (orig r6853): ribasushi | 2009-06-29 14:38:30 -0700
Some beautification
r5802 at hlagh (orig r6870): ribasushi | 2009-06-30 01:09:03 -0700
Cleanup dependency handling a bit
r5806 at hlagh (orig r6874): ribasushi | 2009-06-30 03:39:06 -0700
Allow broken resultsource-class-derived objects to still work
r5807 at hlagh (orig r6875): ribasushi | 2009-06-30 03:40:46 -0700
clarify
r5835 at hlagh (orig r6877): ash | 2009-06-30 04:48:13 -0700
Update POD on Dynamic sub-classing
r5837 at hlagh (orig r6882): ribasushi | 2009-06-30 08:36:38 -0700
r6815 at Thesaurus (orig r6814): ribasushi | 2009-06-28 10:32:42 +0200
Branch to explore double joins on search_related
r6816 at Thesaurus (orig r6815): ribasushi | 2009-06-28 10:34:16 +0200
Thetest case that started it all
r6817 at Thesaurus (orig r6816): ribasushi | 2009-06-28 10:35:11 +0200
The proposed fix (do not add an extra join if it is already present in the topmost join)
r6818 at Thesaurus (orig r6817): ribasushi | 2009-06-28 11:04:26 +0200
Minor omission
r6819 at Thesaurus (orig r6818): ribasushi | 2009-06-28 11:07:33 +0200
Adjust a couple of tests for new behavior (thus all of this might be backwards incompatible to the point of being useless):
The counts in t/90join_torture.t are now 5*3, not 5*3*3, as a second join is not induced by search_related
The raw sql scan in t/prefetch/standard.t is just silly, won't even try to understand it
Just to maintain the TreeLike folding, I add a 3rd children join which was inserted by search_related before the code changes
r5843 at hlagh (orig r6888): ribasushi | 2009-06-30 10:36:11 -0700
Todoify test for now
r5844 at hlagh (orig r6889): ribasushi | 2009-06-30 10:37:05 -0700
Todoify test for now (2)
r5846 at hlagh (orig r6891): ribasushi | 2009-06-30 10:52:31 -0700
Todoify test for now (3)
r5850 at hlagh (orig r6902): ribasushi | 2009-06-30 23:46:12 -0700
Fixed deadlock test
r5851 at hlagh (orig r6903): ribasushi | 2009-07-01 03:22:00 -0700
Clarify exception text
r5854 at hlagh (orig r6906): ribasushi | 2009-07-01 04:23:46 -0700
r6821 at Thesaurus (orig r6820): ribasushi | 2009-06-28 13:09:11 +0200
Branch for prefetch+group play
r6823 at Thesaurus (orig r6822): ribasushi | 2009-06-28 14:38:36 +0200
Normalize group_by
r6824 at Thesaurus (orig r6823): ribasushi | 2009-06-28 14:39:54 +0200
Proper prefetch+group test
r6826 at Thesaurus (orig r6825): ribasushi | 2009-06-28 14:42:48 +0200
Whoops
r6828 at Thesaurus (orig r6827): ribasushi | 2009-06-28 15:06:57 +0200
Lose the literal sql bits - castaway is right it's silly to support those
r6833 at Thesaurus (orig r6832): ribasushi | 2009-06-28 22:38:43 +0200
Rogue comments
r6837 at Thesaurus (orig r6836): ribasushi | 2009-06-29 09:44:25 +0200
A couple of test fixes
r6838 at Thesaurus (orig r6837): ribasushi | 2009-06-29 09:46:13 +0200
Support for -select/-as in SQLAHacks field selection
r6839 at Thesaurus (orig r6838): ribasushi | 2009-06-29 09:49:53 +0200
This is tested elsewhere
r6840 at Thesaurus (orig r6839): ribasushi | 2009-06-29 09:50:43 +0200
This is tested elsewhere (2)
r6841 at Thesaurus (orig r6840): ribasushi | 2009-06-29 10:07:09 +0200
Test cleanups
r6842 at Thesaurus (orig r6841): ribasushi | 2009-06-29 10:11:13 +0200
Most of the grouped prefetch solution
r6843 at Thesaurus (orig r6842): ribasushi | 2009-06-29 10:14:45 +0200
clearer
r6845 at Thesaurus (orig r6844): ribasushi | 2009-06-29 12:05:37 +0200
And score! (all works)
r6882 at Thesaurus (orig r6881): ribasushi | 2009-06-30 16:23:06 +0200
rs->get_column now properly recognizes prefetch and collapses if at all possible
r6886 at Thesaurus (orig r6885): ribasushi | 2009-06-30 17:39:58 +0200
Whoops
r5857 at hlagh (orig r6909): ribasushi | 2009-07-01 04:27:15 -0700
Optimize set_column on uninserted objects
r5867 at hlagh (orig r6920): caelum | 2009-07-01 08:40:32 -0700
r5859 at hlagh (orig r6912): caelum | 2009-07-01 06:21:30 -0700
new connected() for dbd::sybase users
r5860 at hlagh (orig r6913): caelum | 2009-07-01 06:25:46 -0700
add a couple of dbd::sybase reconnection tests
r5861 at hlagh (orig r6914): caelum | 2009-07-01 06:35:07 -0700
better connection test
r5862 at hlagh (orig r6915): caelum | 2009-07-01 06:45:05 -0700
use dbh->do for connected instead of prepare_cached
r5863 at hlagh (orig r6916): ribasushi | 2009-07-01 06:55:21 -0700
Segfault
r5864 at hlagh (orig r6917): caelum | 2009-07-01 07:03:22 -0700
use ->do instead of ->prepare_cached in oracle's connected() too
r5865 at hlagh (orig r6918): caelum | 2009-07-01 08:20:52 -0700
fix segfault with old DBD::Sybase
r5866 at hlagh (orig r6919): caelum | 2009-07-01 08:39:18 -0700
move connection tests into _ping()
r5873 at hlagh (orig r6923): ijw | 2009-07-01 10:34:32 -0700
Added a test for a resultset to related-resultset join for 0 related records
r5874 at hlagh (orig r6927): ijw | 2009-07-01 11:04:16 -0700
Additional tests on prefetch - illustrates the bug with left-join has_many (NULL row returned) and the one that results from the trivial fix (prefetch gives no artist)
r5876 at hlagh (orig r6931): ribasushi | 2009-07-01 23:08:33 -0700
Another candidate for somethingawful.com (fix left join-ed count)
r5877 at hlagh (orig r6933): ribasushi | 2009-07-02 00:04:13 -0700
Changelog
r5878 at hlagh (orig r6934): ribasushi | 2009-07-02 02:23:48 -0700
cleanup
r5879 at hlagh (orig r6935): ijw | 2009-07-02 03:41:01 -0700
Check fetched rows == count for related resultsets
r5880 at hlagh (orig r6936): ijw | 2009-07-02 03:43:47 -0700
Confirm prefetch doesn't affect main row fetch, and main row fetch works with and without counting
r5881 at hlagh (orig r6937): ribasushi | 2009-07-02 03:52:51 -0700
More fail (fix is known but needs work)
r5882 at hlagh (orig r6938): ribasushi | 2009-07-02 04:07:22 -0700
And more fail
r5883 at hlagh (orig r6939): ribasushi | 2009-07-02 04:16:46 -0700
These tests are in prefetch/count.t
r5884 at hlagh (orig r6940): ribasushi | 2009-07-02 04:38:31 -0700
cleanup
r5885 at hlagh (orig r6941): ribasushi | 2009-07-02 04:38:49 -0700
Solve more prefetch inflation crap
r5886 at hlagh (orig r6942): ribasushi | 2009-07-02 04:47:41 -0700
Make the code readable
r5887 at hlagh (orig r6943): ribasushi | 2009-07-02 06:52:35 -0700
Everything works, just need to fix join-path chaining over search_related (to guard against obscure db quirks)
r5889 at hlagh (orig r6945): caelum | 2009-07-02 12:06:32 -0700
add sybase reconnect test
r5891 at hlagh (orig r6947): ribasushi | 2009-07-02 13:20:21 -0700
Last part of the join handling puzzle
r5894 at hlagh (orig r6950): ribasushi | 2009-07-02 15:14:50 -0700
r6360 at Thesaurus (orig r6359): arcanez | 2009-05-21 20:18:52 +0200
branch to work on prefetch/select
r6361 at Thesaurus (orig r6360): arcanez | 2009-05-21 20:32:46 +0200
failing test
r6373 at Thesaurus (orig r6372): ribasushi | 2009-05-22 11:07:26 +0200
Simplify unresolvable test by arcanez
r6905 at Thesaurus (orig r6904): ribasushi | 2009-07-01 12:54:03 +0200
Extend test
r6950 at Thesaurus (orig r6949): ribasushi | 2009-07-03 00:14:09 +0200
Apparent fix - simply delay the in_storage flagging of the main object until all prefetched objects are inflated. The rest of the changes are just cosmetics, preparing for the collapse_result rewrite
r5896 at hlagh (orig r6952): ribasushi | 2009-07-02 15:17:22 -0700
Changes
r5909 at hlagh (orig r6964): ribasushi | 2009-07-03 04:19:27 -0700
Add set_ansi_mode on_connect_call for mysql
Also switch to _do_query instead of plain dbh->do (shows up in the trace)
r5910 at hlagh (orig r6965): ribasushi | 2009-07-03 04:37:06 -0700
Capitalize mysql commands
r5911 at hlagh (orig r6966): ribasushi | 2009-07-03 06:07:49 -0700
Double an existing might_have test as has_one
r5912 at hlagh (orig r6967): ribasushi | 2009-07-03 07:36:32 -0700
Extra test to demonstrate has_one working, and a POD clarification of multicreate
r5917 at hlagh (orig r6972): ribasushi | 2009-07-03 11:20:42 -0700
r6554 at Thesaurus (orig r6553): frew | 2009-06-09 00:06:42 +0200
branch for mssql top issues
r6572 at Thesaurus (orig r6571): frew | 2009-06-09 23:18:46 +0200
more tests for SQL Server!
r6573 at Thesaurus (orig r6572): frew | 2009-06-09 23:49:10 +0200
Added AmbiguousGlob.pm for silly servers like mssql and mysql. See docs for more info
r6574 at Thesaurus (orig r6573): frew | 2009-06-09 23:55:22 +0200
fix plan
r6602 at Thesaurus (orig r6601): frew | 2009-06-10 17:03:30 +0200
more failing tests
r6608 at Thesaurus (orig r6607): frew | 2009-06-10 20:05:53 +0200
don't use eval!
r6610 at Thesaurus (orig r6609): frew | 2009-06-10 20:07:49 +0200
beginning of DWIM for IDENTITY_INSERT
r6628 at Thesaurus (orig r6627): frew | 2009-06-11 18:13:02 +0200
still busted :-(
r6631 at Thesaurus (orig r6630): frew | 2009-06-11 19:39:00 +0200
general function to go from column names and ident to result source
r6632 at Thesaurus (orig r6631): frew | 2009-06-11 19:40:11 +0200
Use new _resolve_column_sources method and begin insert_bulk method
r6635 at Thesaurus (orig r6634): frew | 2009-06-11 20:12:38 +0200
updated _resolve_column_source to _resolve_column_info as per ribasushi's suggestion
r6650 at Thesaurus (orig r6649): frew | 2009-06-12 17:13:32 +0200
Now I just need to check if the actual values are set...
r6651 at Thesaurus (orig r6650): frew | 2009-06-12 17:26:53 +0200
Insert Identity works!
r6652 at Thesaurus (orig r6651): frew | 2009-06-12 17:34:13 +0200
silly warns.
r6684 at Thesaurus (orig r6683): frew | 2009-06-15 16:49:00 +0200
failing test
r6686 at Thesaurus (orig r6685): ribasushi | 2009-06-15 18:10:26 +0200
make all resolved attrs visible to sqla
r6698 at Thesaurus (orig r6697): ribasushi | 2009-06-17 02:31:37 +0200
Half way working stuff, needs a LOT of tweaking still
r6729 at Thesaurus (orig r6728): ribasushi | 2009-06-19 19:49:27 +0200
Merge badness
r6730 at Thesaurus (orig r6729): ribasushi | 2009-06-19 19:49:40 +0200
fix eol
r6731 at Thesaurus (orig r6730): ribasushi | 2009-06-19 19:55:47 +0200
augment inheritance
r6735 at Thesaurus (orig r6734): ribasushi | 2009-06-20 10:34:42 +0200
Maybe I've nailed it
r6746 at Thesaurus (orig r6745): ribasushi | 2009-06-20 23:53:55 +0200
Test and merge fixes
r6747 at Thesaurus (orig r6746): ribasushi | 2009-06-21 00:01:09 +0200
Really fix tests
r6748 at Thesaurus (orig r6747): ribasushi | 2009-06-21 00:01:54 +0200
Really fix tests
r6749 at Thesaurus (orig r6748): ribasushi | 2009-06-21 00:18:33 +0200
Now really final
r6750 at Thesaurus (orig r6749): ribasushi | 2009-06-21 00:22:23 +0200
whoops
r6751 at Thesaurus (orig r6750): ribasushi | 2009-06-21 00:42:18 +0200
That should be all
r6752 at Thesaurus (orig r6751): ribasushi | 2009-06-21 08:54:00 +0200
Make sure quoting works
r6755 at Thesaurus (orig r6754): ribasushi | 2009-06-21 15:21:23 +0200
Groundwork for sanification of the toplimit test
r6863 at Thesaurus (orig r6862): ribasushi | 2009-06-30 01:13:49 +0200
Make sure storage classes use c3, just like the rest of dbic (tested on 5.8 as well)
r6869 at Thesaurus (orig r6868): ribasushi | 2009-06-30 09:53:27 +0200
Some fixes after review
r6874 at Thesaurus (orig r6873): ribasushi | 2009-06-30 11:54:34 +0200
Fix borked next invocation
r6896 at Thesaurus (orig r6895): frew | 2009-06-30 21:38:26 +0200
silly misspells and trailing whitespace
r6955 at Thesaurus (orig r6954): ribasushi | 2009-07-03 01:21:28 +0200
Some hack consolidation
r6962 at Thesaurus (orig r6961): ribasushi | 2009-07-03 12:06:57 +0200
Fix some mssql shortcommings when confronted with the new subequeried prefetch sql
r6963 at Thesaurus (orig r6962): ribasushi | 2009-07-03 12:47:57 +0200
Ask for newer DBD::Pg in author mode, suggest the newer version otherwise (proper array support). Make test more resilient as well
r6964 at Thesaurus (orig r6963): ribasushi | 2009-07-03 12:49:16 +0200
Switch to C3 mro throughout the ::Storage hierarchy (DBIx::Class brings in MRO::Compat, and all ::Storage's are based on it, tested on 5.8
r6969 at Thesaurus (orig r6968): ribasushi | 2009-07-03 19:54:04 +0200
Duh
r6970 at Thesaurus (orig r6969): frew | 2009-07-03 19:59:48 +0200
fix tests for new codez
r6971 at Thesaurus (orig r6970): ribasushi | 2009-07-03 20:18:53 +0200
detabify
r6972 at Thesaurus (orig r6971): ribasushi | 2009-07-03 20:20:07 +0200
changes
r5920 at hlagh (orig r6979): ribasushi | 2009-07-04 02:34:08 -0700
Hide devel documentation from the indexer
r5921 at hlagh (orig r6980): ribasushi | 2009-07-04 02:37:25 -0700
Add set_ansi_mode POD
r5922 at hlagh (orig r6981): ribasushi | 2009-07-04 02:45:24 -0700
Backout mysql changes for further polishing
r5925 at hlagh (orig r6984): ribasushi | 2009-07-04 03:08:16 -0700
Missing newline
r5926 at hlagh (orig r6985): ribasushi | 2009-07-04 03:11:18 -0700
typo
r5927 at hlagh (orig r6986): ribasushi | 2009-07-04 03:40:47 -0700
Fix POD
r5928 at hlagh (orig r6987): ribasushi | 2009-07-04 04:09:39 -0700
todos are shorter now
r5929 at hlagh (orig r6989): castaway | 2009-07-05 13:00:55 -0700
Added Pod::Inherit use to Makefile.PL at author-time, comments/suggestions as to whether its too "noisy" welcome.
r5930 at hlagh (orig r6990): ribasushi | 2009-07-05 15:06:52 -0700
Couple of makefile fixes:
use is compile time, use require
recommends is for distro maintainers only, push the dependency into the authors hash (it is not to be executed by mere mortals)
r5931 at hlagh (orig r6991): ribasushi | 2009-07-05 15:55:36 -0700
Forgotten pod exclusions
r5932 at hlagh (orig r6992): ribasushi | 2009-07-05 16:07:05 -0700
Temporarily backout Pod::Inherit changes
r5933 at hlagh (orig r6993): ribasushi | 2009-07-05 16:10:22 -0700
Put Pod::Inherit stuff back after proper copy
r7027 at Thesaurus (orig r7026): caelum | 2009-07-10 23:25:56 +0200
r5941 at hlagh (orig r7009): ribasushi | 2009-07-09 03:45:02 -0700
r6995 at Thesaurus (orig r6994): ribasushi | 2009-07-06 01:12:57 +0200
Where 08108 will come from
r7029 at Thesaurus (orig r7028): caelum | 2009-07-10 23:59:31 +0200
r5959 at hlagh (orig r7027): caelum | 2009-07-10 14:56:57 -0700
fix PodInherit call in Makefile.PL
r7067 at Thesaurus (orig r7066): caelum | 2009-07-17 10:18:24 +0200
r5961 at hlagh (orig r7029): robkinyon | 2009-07-10 18:03:07 -0400
Applied patch from kados regarding use of a DateTime::Format class to validate
r5962 at hlagh (orig r7030): caelum | 2009-07-11 05:26:40 -0400
reword IC::DT doc patch
r6009 at hlagh (orig r7037): dandv | 2009-07-13 08:06:08 -0400
PK::Auto has moved into Core since 2007
r6010 at hlagh (orig r7038): dandv | 2009-07-13 08:15:13 -0400
Fixed has_many example in Intro.pod
r6011 at hlagh (orig r7039): dandv | 2009-07-13 16:58:45 -0400
Fixed run-on sentences in FAQ
r6012 at hlagh (orig r7040): dandv | 2009-07-13 17:18:11 -0400
Minor POD fixes in Example.pod
r6013 at hlagh (orig r7041): dandv | 2009-07-13 17:48:18 -0400
Favored using ->single to get the topmost result over less readable ->slice(0)
r6014 at hlagh (orig r7042): dandv | 2009-07-13 18:56:31 -0400
Minor POD fixes in Cookbook
r6015 at hlagh (orig r7045): ribasushi | 2009-07-14 07:30:55 -0400
Minor logic cleanup
r6016 at hlagh (orig r7046): ribasushi | 2009-07-14 08:07:11 -0400
grouped prefetch fix
r6023 at hlagh (orig r7053): ijw | 2009-07-15 12:55:35 -0400
Added SQLA link for more comprehensive documentation of order_by options available
r6026 at hlagh (orig r7056): caelum | 2009-07-15 18:54:22 -0400
add "smalldatetime" support to IC::DT
r6029 at hlagh (orig r7059): ribasushi | 2009-07-16 00:29:41 -0400
r7013 at Thesaurus (orig r7012): jnapiorkowski | 2009-07-09 17:00:22 +0200
new branch
r7014 at Thesaurus (orig r7013): jnapiorkowski | 2009-07-09 20:06:44 +0200
changed the way transactions are detected for replication to work with the standard way to do this, minor doc updates, fix to the force pool so you can force a particular slave, changes to the way the debugging is created
r7015 at Thesaurus (orig r7014): jnapiorkowski | 2009-07-09 20:17:03 +0200
more changes to the way debug output works
r7016 at Thesaurus (orig r7015): jnapiorkowski | 2009-07-09 22:26:47 +0200
big update to the test suite so that we now check to make sure the storage that was expected was actually used
r7017 at Thesaurus (orig r7016): jnapiorkowski | 2009-07-09 23:23:37 +0200
set correct number of tests, changed the debuggin output to not warn on DDL, minor change to a test resultclass so we can deploy to mysql properly
r7018 at Thesaurus (orig r7017): jnapiorkowski | 2009-07-09 23:26:59 +0200
corrected the number of skipped tests
r7019 at Thesaurus (orig r7018): jnapiorkowski | 2009-07-09 23:52:22 +0200
fixed test resultclass formatting, added a few more DBIC::Storage::DBI methods that I might need to delegate.
r7020 at Thesaurus (orig r7019): jnapiorkowski | 2009-07-10 01:23:07 +0200
some documention updates and changed the way we find paths for the sqlite dbfiles to use File::Spec, which I hope will solve some of the Win32 error messages
r7023 at Thesaurus (orig r7022): jnapiorkowski | 2009-07-10 18:00:38 +0200
pod cleanup, fixed broken pod links, and new Introduction pod
r7024 at Thesaurus (orig r7023): jnapiorkowski | 2009-07-10 19:10:57 +0200
updated Changes file to reflect work completed
r7025 at Thesaurus (orig r7024): jnapiorkowski | 2009-07-10 19:37:53 +0200
a few more Moose Type related fixes and added diag to the replication test to report the moose and types version used, to help us debug some of the moose related errors being reported
r7058 at Thesaurus (orig r7057): ribasushi | 2009-07-16 06:28:44 +0200
A couple of typos, and general whitespace cleanup (ick)
r6031 at hlagh (orig r7062): jnapiorkowski | 2009-07-16 11:03:32 -0400
increased Moose version requirements due to changes in the way type constraints get validated, which is not backwardly compatible
r6032 at hlagh (orig r7063): dandv | 2009-07-16 21:37:28 -0400
Minor POD grammar: it's -> its where appropriate
r7105 at Thesaurus (orig r7102): caelum | 2009-07-24 06:34:56 +0200
r6075 at hlagh (orig r7074): tomboh | 2009-07-20 12:20:37 -0400
Fix POD changes from r7040.
r6081 at hlagh (orig r7077): norbi | 2009-07-20 18:59:30 -0400
r6082 at hlagh (orig r7078): norbi | 2009-07-20 18:59:58 -0400
r7232 at vger: mendel | 2009-07-21 00:58:12 +0200
Fixed documentation and added test for the "Arbitrary SQL through a custom ResultSource" Cookbook alternate (subclassing) recipe.
r6083 at hlagh (orig r7079): norbi | 2009-07-20 19:05:32 -0400
r7235 at vger: mendel | 2009-07-21 01:05:18 +0200
Fixed 'typo' (removed a word that I left there by accident).
r6084 at hlagh (orig r7080): norbi | 2009-07-21 04:06:21 -0400
r7237 at vger: mendel | 2009-07-21 10:06:05 +0200
Fixing what my svk client screwed up.
r6085 at hlagh (orig r7081): caelum | 2009-07-21 10:51:55 -0400
update Storage::Replicated prereqs
r6086 at hlagh (orig r7082): caelum | 2009-07-21 12:16:34 -0400
show Oracle datetime_setup alter session statements in debug output
r6088 at hlagh (orig r7085): ribasushi | 2009-07-21 21:50:57 -0400
Lazy folks do not run the whole test suite before merging >:(
r6287 at hlagh (orig r7097): caelum | 2009-07-23 14:14:11 -0400
r6092 at hlagh (orig r7090): caelum | 2009-07-23 08:24:39 -0400
new branch for fixing the MONEY type in MSSQL
r6093 at hlagh (orig r7091): caelum | 2009-07-23 08:34:01 -0400
add test
r6283 at hlagh (orig r7093): caelum | 2009-07-23 10:31:08 -0400
fix money columns
r6284 at hlagh (orig r7094): caelum | 2009-07-23 10:34:06 -0400
minor change
r6285 at hlagh (orig r7095): caelum | 2009-07-23 11:01:37 -0400
add test for updating money value to NULL
r6286 at hlagh (orig r7096): caelum | 2009-07-23 14:09:26 -0400
add money type tests to dbd::sybase+mssql tests
r7135 at Thesaurus (orig r7132): caelum | 2009-07-28 19:10:40 +0200
r6365 at hlagh (orig r7126): caelum | 2009-07-27 20:03:47 -0400
add postgres "timestamp without time zone" support
r7244 at Thesaurus (orig r7241): caelum | 2009-08-06 17:12:49 +0200
add warning for custom resultsources through ->name(SCALARREF) on ->deploy
r7245 at Thesaurus (orig r7242): caelum | 2009-08-06 17:54:33 +0200
improve the ->name(REF) warning code
r7268 at Thesaurus (orig r7265): ribasushi | 2009-08-09 00:23:24 +0200
Clarify POD and cleanup the ->name-hack warning
r7269 at Thesaurus (orig r7266): ribasushi | 2009-08-09 00:34:09 +0200
Fix a corner case and improve comments
r7279 at Thesaurus (orig r7276): ribasushi | 2009-08-09 15:25:34 +0200
r6535 at Thesaurus (orig r6534): ribasushi | 2009-06-06 11:12:03 +0200
Let's try again
r6536 at Thesaurus (orig r6535): ribasushi | 2009-06-06 11:32:00 +0200
Two failing MC tests
r6624 at Thesaurus (orig r6623): ribasushi | 2009-06-11 16:54:09 +0200
Another multicreate failing test - has_many should not do find_or_create
r6625 at Thesaurus (orig r6624): ribasushi | 2009-06-11 16:54:49 +0200
r6538 at Thesaurus (orig r6537): ribasushi | 2009-06-07 23:07:55 +0200
Fix for mysql subquery problem
r6539 at Thesaurus (orig r6538): ribasushi | 2009-06-07 23:36:43 +0200
Make empty/default inserts use standard SQL
r6540 at Thesaurus (orig r6539): ribasushi | 2009-06-08 00:59:21 +0200
Add mysql empty insert SQL override
Make SQLAHacks parts loadable at runtime via ensure_class_loaded
r6541 at Thesaurus (orig r6540): ribasushi | 2009-06-08 01:03:04 +0200
Make podcoverage happy
r6542 at Thesaurus (orig r6541): ribasushi | 2009-06-08 01:24:06 +0200
Fix find_or_new/create to stop returning random rows when default value insert is requested
r6543 at Thesaurus (orig r6542): ribasushi | 2009-06-08 11:36:56 +0200
Simply order_by/_virtual_order_by handling
r6553 at Thesaurus (orig r6552): ribasushi | 2009-06-08 23:56:41 +0200
duh
r6557 at Thesaurus (orig r6556): ash | 2009-06-09 12:20:34 +0200
Addjust bug to show problem with rows => 1 + child rel
r6558 at Thesaurus (orig r6557): ribasushi | 2009-06-09 13:12:46 +0200
Require a recent bugfixed Devel::Cycle
r6560 at Thesaurus (orig r6559): ash | 2009-06-09 15:07:30 +0200
Make IC::DT extra warning state the column name too
r6575 at Thesaurus (orig r6574): ribasushi | 2009-06-10 00:19:48 +0200
AuthorCheck fixes
r6579 at Thesaurus (orig r6578): ribasushi | 2009-06-10 00:52:17 +0200
r6522 at Thesaurus (orig r6521): ribasushi | 2009-06-05 19:27:55 +0200
New branch to try resultsource related stuff
r6545 at Thesaurus (orig r6544): ribasushi | 2009-06-08 13:00:54 +0200
First stab at adding resultsources to each join in select - works won-der-ful-ly
r6546 at Thesaurus (orig r6545): ribasushi | 2009-06-08 13:14:08 +0200
Commit failing test and thoughts on search arg deflation
r6576 at Thesaurus (orig r6575): ribasushi | 2009-06-10 00:31:55 +0200
Todoify DT in search deflation test until after 0.09
r6577 at Thesaurus (orig r6576): ribasushi | 2009-06-10 00:48:07 +0200
Factor out the $ident resolver
r6581 at Thesaurus (orig r6580): ribasushi | 2009-06-10 01:21:50 +0200
Move as_query out of the cursor
r6582 at Thesaurus (orig r6581): ribasushi | 2009-06-10 01:27:19 +0200
Think before commit
r6583 at Thesaurus (orig r6582): ribasushi | 2009-06-10 09:37:19 +0200
Clarify and disable rows/prefetch test - fix is easy, but architecturally unsound - need more time
r6591 at Thesaurus (orig r6590): ribasushi | 2009-06-10 13:33:37 +0200
r6544 at Thesaurus (orig r6543): ribasushi | 2009-06-08 11:44:59 +0200
Attempt to figure out why do we repeat joins on complex search_related
r6586 at Thesaurus (orig r6585): ribasushi | 2009-06-10 11:22:05 +0200
Move the rs preservation test to a more suitable place
r6589 at Thesaurus (orig r6588): ribasushi | 2009-06-10 13:15:48 +0200
Finally commit trully failing test
r6590 at Thesaurus (orig r6589): ribasushi | 2009-06-10 13:33:14 +0200
Duh, this was a pretty simple bug
r6593 at Thesaurus (orig r6592): ribasushi | 2009-06-10 13:43:31 +0200
What was I thinking - resultsource does not have an ->alias
r6598 at Thesaurus (orig r6597): ribasushi | 2009-06-10 14:48:39 +0200
Adjust changelog
r6601 at Thesaurus (orig r6600): ribasushi | 2009-06-10 15:50:43 +0200
Release 0.08104
r6615 at Thesaurus (orig r6614): ribasushi | 2009-06-11 14:29:48 +0200
Move around inflation tests
r6616 at Thesaurus (orig r6615): ribasushi | 2009-06-11 14:32:07 +0200
explicitly remove manifest on author mode make
r6617 at Thesaurus (orig r6616): ribasushi | 2009-06-11 15:02:41 +0200
IC::DT changes:
Switch SQLite storage to DT::F::SQLite
Fix exception when undef_if_invalid and timezone are both set on a column
Split t/89inflate_datetime into separate tests
Adjust makefile author dependencies
r6618 at Thesaurus (orig r6617): ribasushi | 2009-06-11 15:07:41 +0200
Move file_column test to inflate/ too
r6621 at Thesaurus (orig r6620): ribasushi | 2009-06-11 16:16:20 +0200
r5713 at Thesaurus (orig r5712): ribasushi | 2009-03-08 23:53:28 +0100
Branch for datatype-aware updates
r6604 at Thesaurus (orig r6603): ribasushi | 2009-06-10 18:08:25 +0200
Test for type-aware update
r6607 at Thesaurus (orig r6606): ribasushi | 2009-06-10 19:57:04 +0200
Datatype aware update works
r6609 at Thesaurus (orig r6608): ribasushi | 2009-06-10 20:06:40 +0200
Whoops
r6614 at Thesaurus (orig r6613): ribasushi | 2009-06-11 09:23:54 +0200
Add attribute doc
r6620 at Thesaurus (orig r6619): ribasushi | 2009-06-11 16:15:53 +0200
Use equality, not comparison
r6623 at Thesaurus (orig r6622): ribasushi | 2009-06-11 16:21:53 +0200
Changes
r6626 at Thesaurus (orig r6625): ribasushi | 2009-06-11 17:00:06 +0200
Adjust renamed relationship
r6646 at Thesaurus (orig r6645): ribasushi | 2009-06-12 09:00:02 +0200
This is not update_or_create - create any non-belongs_to without asking many questions
r7194 at Thesaurus (orig r7191): ribasushi | 2009-08-04 15:20:35 +0200
fix merge fallout
r7195 at Thesaurus (orig r7192): ribasushi | 2009-08-04 15:39:05 +0200
Remove bogus test - the real test is in t/multi_create/has_many.t
r7196 at Thesaurus (orig r7193): ribasushi | 2009-08-04 15:48:33 +0200
Separate the diamond MC test
Use the new Test::More's no_plan ability
r7274 at Thesaurus (orig r7271): ribasushi | 2009-08-09 14:39:29 +0200
Fix an arcane case with pk==fk tables (use the relationship direction specification if it is available
r7275 at Thesaurus (orig r7272): ribasushi | 2009-08-09 14:45:20 +0200
Optimize handling of {_rel_in_storage}, greatly reducing the amounf ot find_or_create calls (as indicated by the TODOs in t/multi_create/reentrance_count.t
r7277 at Thesaurus (orig r7274): ribasushi | 2009-08-09 15:23:24 +0200
Comment and todoify remaining test - too much of an undertaking / needs discussion
r7278 at Thesaurus (orig r7275): ribasushi | 2009-08-09 15:24:58 +0200
newline
r7282 at Thesaurus (orig r7279): ribasushi | 2009-08-09 16:17:03 +0200
Whoops, missed a line
r7283 at Thesaurus (orig r7280): mo | 2009-08-09 19:10:56 +0200
added TODO test: call accessors when create()ing a row
r7284 at Thesaurus (orig r7281): ribasushi | 2009-08-10 08:01:59 +0200
Fix bogus test
r7291 at Thesaurus (orig r7288): caelum | 2009-08-10 10:13:19 +0200
make _determine_driver more reentrant
r7297 at Thesaurus (orig r7294): michaelr | 2009-08-10 22:40:33 +0200
Added exception when resultset called without an argument
r7298 at Thesaurus (orig r7295): andyg | 2009-08-11 00:34:13 +0200
Add failing test for RT 47779, group_by as a scalar ref
r7301 at Thesaurus (orig r7298): ribasushi | 2009-08-11 09:52:03 +0200
Extra intro pod
r7302 at Thesaurus (orig r7299): mo | 2009-08-11 13:20:37 +0200
removed TODO test
r7303 at Thesaurus (orig r7300): ribasushi | 2009-08-11 14:16:28 +0200
Sanify group_by handling in complex prefetch rewrites
r7304 at Thesaurus (orig r7301): ribasushi | 2009-08-11 17:52:49 +0200
cleanup
r7305 at Thesaurus (orig r7302): ribasushi | 2009-08-11 19:40:59 +0200
Whitespace
r7306 at Thesaurus (orig r7303): ribasushi | 2009-08-11 20:00:11 +0200
Fix an obscure regression when inserting an object with a serialize-deflating column set
r7314 at Thesaurus (orig r7311): ribasushi | 2009-08-12 16:11:24 +0200
Remove needless inflate in Ordered
r7315 at Thesaurus (orig r7312): ribasushi | 2009-08-12 16:13:48 +0200
Remove leftovers from frew's tests
r7316 at Thesaurus (orig r7313): ribasushi | 2009-08-12 16:16:08 +0200
Grrrr
r7317 at Thesaurus (orig r7314): ribasushi | 2009-08-13 07:40:44 +0200
Caelum was right to make _get_dbh private - reverting (and some code refactoring)
r7318 at Thesaurus (orig r7315): ribasushi | 2009-08-13 07:41:43 +0200
Add a db/txn_do retry debugger (interesting results)
r7319 at Thesaurus (orig r7316): ribasushi | 2009-08-13 07:42:51 +0200
Adjust the storage DESTROY and the tests to accomodate the new global RaiseError=1
r7320 at Thesaurus (orig r7317): ribasushi | 2009-08-13 08:12:08 +0200
Last bit
r7322 at Thesaurus (orig r7319): ribasushi | 2009-08-17 11:09:39 +0200
Allow select AS specification for functions only via the -as hash-key (no pod yet)
r7323 at Thesaurus (orig r7320): ribasushi | 2009-08-17 11:41:08 +0200
Cookbook entry for -as and syntax tests
r7324 at Thesaurus (orig r7321): ribasushi | 2009-08-17 11:51:21 +0200
Changes
r7326 at Thesaurus (orig r7323): ribasushi | 2009-08-17 12:37:14 +0200
examples should be correct
r7332 at Thesaurus (orig r7329): caelum | 2009-08-18 06:19:12 +0200
always reconnect in odbc:mssql:connect_call_use_dynamic_cursors
r7333 at Thesaurus (orig r7330): caelum | 2009-08-18 06:43:35 +0200
minor change
r7335 at Thesaurus (orig r7332): ribasushi | 2009-08-18 08:51:20 +0200
r7248 at Thesaurus (orig r7245): rbuels | 2009-08-06 21:39:05 +0200
making topic branch for "currval undefined" problem when not qualifying tables with their schema names
r7249 at Thesaurus (orig r7246): rbuels | 2009-08-06 21:40:39 +0200
failing (crashing, really) test for this strange pg thing. could not figure out a way to make a non-crashing test
r7250 at Thesaurus (orig r7247): rbuels | 2009-08-06 21:42:30 +0200
fix for pg non-schema-qualified thing, with a nice vague commit message. performance should be the same as before, for the common (schema-qualified) case
r7251 at Thesaurus (orig r7248): rbuels | 2009-08-06 22:41:19 +0200
woops, pg search path fix needed support for quoted schema names in search paths
r7295 at Thesaurus (orig r7292): rbuels | 2009-08-10 20:45:50 +0200
added caching of pg search path in Pg storage object
r7296 at Thesaurus (orig r7293): rbuels | 2009-08-10 22:37:31 +0200
added test for empty table before non-schema-qualified pg sequence test in 72pg.t
r7299 at Thesaurus (orig r7296): rbuels | 2009-08-11 00:46:35 +0200
added blub to Changes for pg_unqualified_schema branch
r7300 at Thesaurus (orig r7297): rbuels | 2009-08-11 00:48:53 +0200
added me (rbuels) to contributors
r7328 at Thesaurus (orig r7325): rbuels | 2009-08-17 23:46:21 +0200
added POD section about schema support to DBIx::Class::Storage::Pg
r7329 at Thesaurus (orig r7326): rbuels | 2009-08-17 23:51:40 +0200
added more tests for multi-schema support in 72pg.t
r7334 at Thesaurus (orig r7331): ribasushi | 2009-08-18 08:49:03 +0200
Un-plan test and fix authorship
r7341 at Thesaurus (orig r7338): ribasushi | 2009-08-18 10:55:23 +0200
r7337 at Thesaurus (orig r7334): ribasushi | 2009-08-18 09:00:03 +0200
Pre-release branch
r7338 at Thesaurus (orig r7335): ribasushi | 2009-08-18 10:32:13 +0200
Disambiguate POD
r7339 at Thesaurus (orig r7336): ribasushi | 2009-08-18 10:32:53 +0200
Release 0.08109
r7346 at Thesaurus (orig r7343): robkinyon | 2009-08-19 21:44:48 +0200
Applied doc patch by spb
r7347 at Thesaurus (orig r7344): ribasushi | 2009-08-20 07:50:49 +0200
Fix a weird-ass sqlt invocation in deployment_statements()
r7348 at Thesaurus (orig r7345): ribasushi | 2009-08-20 08:19:07 +0200
Apply pod patch by arthas (slightly modified)
r7353 at Thesaurus (orig r7350): abraxxa | 2009-08-20 15:07:29 +0200
pod patch for 'Tracing SQL' examples
r7356 at Thesaurus (orig r7353): spb | 2009-08-20 19:53:02 +0200
Minor fix to the previous doc patch
r7357 at Thesaurus (orig r7354): frew | 2009-08-20 23:54:04 +0200
add some basic guards to get rid of warnings
r7361 at Thesaurus (orig r7358): ribasushi | 2009-08-21 11:18:43 +0200
Because prefetch uses the cache system, it is not possible to set HRI on a prefetched rs without upsetting the tests - don't compare
r7372 at Thesaurus (orig r7369): caelum | 2009-08-24 12:32:57 +0200
bump CAG dep
r7391 at Thesaurus (orig r7388): ribasushi | 2009-08-25 13:43:38 +0200
typo
r7392 at Thesaurus (orig r7389): ribasushi | 2009-08-25 14:29:37 +0200
r7354 at Thesaurus (orig r7351): abraxxa | 2009-08-20 17:46:06 +0200
new branch grouped_has_many_join
r7382 at Thesaurus (orig r7379): ribasushi | 2009-08-24 22:50:13 +0200
Seems like abraxxa's bug is fixed
r7385 at Thesaurus (orig r7382): ribasushi | 2009-08-25 11:33:40 +0200
One more test
r7396 at Thesaurus (orig r7393): ribasushi | 2009-08-26 18:07:51 +0200
Stop testing deprecated json::syck
r7397 at Thesaurus (orig r7394): ribasushi | 2009-08-26 18:08:24 +0200
Make sure sqlt_type gets called after determining driver
r7398 at Thesaurus (orig r7395): ribasushi | 2009-08-26 18:21:53 +0200
Make POD::Coverage happy... again
r7399 at Thesaurus (orig r7396): ribasushi | 2009-08-26 18:31:54 +0200
Clarify
r7400 at Thesaurus (orig r7397): frew | 2009-08-26 22:24:19 +0200
Remove dead, sketchtowne link
r7404 at Thesaurus (orig r7401): ribasushi | 2009-08-27 18:50:12 +0200
Changes
r7406 at Thesaurus (orig r7403): ribasushi | 2009-08-28 00:11:29 +0200
Add a test proving how dumb I am
r7407 at Thesaurus (orig r7404): ribasushi | 2009-08-28 16:34:46 +0200
Warning to spare mst explanations
r7422 at Thesaurus (orig r7419): caelum | 2009-08-29 08:34:07 +0200
r7381 at hlagh (orig r7380): ribasushi | 2009-08-24 17:07:58 -0400
Branch to add autocast support as a standalone piece of code
r7382 at hlagh (orig r7381): ribasushi | 2009-08-25 05:06:43 -0400
Move storage tests to their own dir
r7385 at hlagh (orig r7384): ribasushi | 2009-08-25 06:35:19 -0400
Switch storage class loading to ensure_class_loaded
r7386 at hlagh (orig r7385): ribasushi | 2009-08-25 06:37:48 -0400
Change a datatype for test purposes
r7387 at hlagh (orig r7386): ribasushi | 2009-08-25 06:45:35 -0400
Fix two storage tests
r7388 at hlagh (orig r7387): ribasushi | 2009-08-25 06:45:52 -0400
Actual autocast code
r18697 at hlagh (orig r7416): caelum | 2009-08-29 01:42:29 -0400
rename method and add docs
r18698 at hlagh (orig r7417): ribasushi | 2009-08-29 02:07:18 -0400
Make sure arrays work
r18699 at hlagh (orig r7418): caelum | 2009-08-29 02:11:14 -0400
rename _map_data_type to _native_data_type
r7425 at Thesaurus (orig r7422): ribasushi | 2009-08-29 08:55:12 +0200
Make podcoverage happy
r7426 at Thesaurus (orig r7423): ribasushi | 2009-08-29 09:06:07 +0200
Reduce the number of heavy dbh_do calls
r7439 at Thesaurus (orig r7436): ribasushi | 2009-08-30 08:54:10 +0200
r7435 at Thesaurus (orig r7432): caelum | 2009-08-30 02:53:21 +0200
new branch
r7436 at Thesaurus (orig r7433): caelum | 2009-08-30 03:14:36 +0200
add dbh_maker option to connect_info hash
r7437 at Thesaurus (orig r7434): ribasushi | 2009-08-30 08:51:14 +0200
Minor cleanup and test enhancement
r7438 at Thesaurus (orig r7435): ribasushi | 2009-08-30 08:53:59 +0200
Changes
r7444 at Thesaurus (orig r7441): ribasushi | 2009-08-30 09:53:04 +0200
Sanify 03podcoverage.t, allow wildcard skipping
r7449 at Thesaurus (orig r7446): caelum | 2009-08-31 04:36:08 +0200
support coderef connect_infos for repicated storage
r7450 at Thesaurus (orig r7447): caelum | 2009-08-31 04:58:43 +0200
make replicant dsn detection a bit nicer
r7451 at Thesaurus (orig r7448): caelum | 2009-08-31 17:30:37 +0200
fix case where repelicant coderef dsn does not connect
r7452 at Thesaurus (orig r7449): arcanez | 2009-08-31 23:13:50 +0200
remove . from end of =head links
r7455 at Thesaurus (orig r7452): ribasushi | 2009-09-01 10:38:37 +0200
Quote deps, avoid floating problems
r7456 at Thesaurus (orig r7453): ribasushi | 2009-09-01 11:10:11 +0200
Fix misleading FAQ entry
r7464 at Thesaurus (orig r7461): ribasushi | 2009-09-01 16:51:58 +0200
Fix insert_bulk with rebless
r7465 at Thesaurus (orig r7462): ribasushi | 2009-09-01 16:52:39 +0200
Comment
r7466 at Thesaurus (orig r7463): matthewt | 2009-09-01 17:17:08 +0200
clearer copyright
r7467 at Thesaurus (orig r7464): matthewt | 2009-09-01 17:18:31 +0200
split copyright and license
r7469 at Thesaurus (orig r7466): frew | 2009-09-01 20:27:36 +0200
pod describing strife with MSSQL
r7483 at Thesaurus (orig r7480): ribasushi | 2009-09-02 11:07:04 +0200
Streamline pg test-schemas cleanup
r7484 at Thesaurus (orig r7481): ribasushi | 2009-09-02 11:20:25 +0200
Centralize handling of minimum sqlt version to DBIx::Class
Bump version to the latest unborked sqlt (still just a recommend)
r7485 at Thesaurus (orig r7482): ribasushi | 2009-09-02 11:31:50 +0200
Some cleanup... don't remember where it came from
r7486 at Thesaurus (orig r7483): ribasushi | 2009-09-02 12:19:11 +0200
First part of mysql insanity
r7487 at Thesaurus (orig r7484): ribasushi | 2009-09-02 12:25:35 +0200
Invoke default_join_type only on undefined types
r7488 at Thesaurus (orig r7485): ribasushi | 2009-09-02 12:42:39 +0200
No fancy methods for the default_jointype, as we don't have proper sqlahacks inheritance and they are... well hacks
r7489 at Thesaurus (orig r7486): ribasushi | 2009-09-02 13:00:07 +0200
Mysql v3 support (ick)
r7494 at Thesaurus (orig r7491): rbuels | 2009-09-02 20:33:47 +0200
POD patch, corrected erroneous usage of dbh_do in Storage::DBI synopsis
r7500 at Thesaurus (orig r7497): ribasushi | 2009-09-03 11:11:29 +0200
POD lists the storable hooks, but does no load them
r7501 at Thesaurus (orig r7498): ribasushi | 2009-09-03 11:11:50 +0200
Storable sanification
r7502 at Thesaurus (orig r7499): ribasushi | 2009-09-03 11:24:17 +0200
Storable is now in Core
r7503 at Thesaurus (orig r7500): ribasushi | 2009-09-03 11:36:58 +0200
Make sure mysql is fixed
r7506 at Thesaurus (orig r7503): ribasushi | 2009-09-03 17:16:17 +0200
Add podcoverage skip
r7507 at Thesaurus (orig r7504): ribasushi | 2009-09-03 17:23:19 +0200
Consolidate _verify_pid calls
r7511 at Thesaurus (orig r7508): matthewt | 2009-09-03 20:12:53 +0200
get the COPYRIGHT in the right pless to not confuse META.yml generation
r7513 at Thesaurus (orig r7510): ribasushi | 2009-09-03 20:41:22 +0200
r7514 at Thesaurus (orig r7511): ribasushi | 2009-09-03 20:41:34 +0200
r7472 at Thesaurus (orig r7469): norbi | 2009-09-01 21:43:08 +0200
r7635 at vger: mendel | 2009-09-01 21:02:23 +0200
Added pointer to 'SQL functions on the lhs' to the 'using stored procs' section.
r7515 at Thesaurus (orig r7512): ribasushi | 2009-09-03 20:41:44 +0200
r7473 at Thesaurus (orig r7470): norbi | 2009-09-01 21:43:19 +0200
r7636 at vger: mendel | 2009-09-01 21:09:43 +0200
Mentions the possibiliby of creating indexes on SQL function return values.
r7516 at Thesaurus (orig r7513): ribasushi | 2009-09-03 20:41:52 +0200
r7474 at Thesaurus (orig r7471): norbi | 2009-09-01 21:43:31 +0200
r7637 at vger: mendel | 2009-09-01 21:19:14 +0200
Rewrote 'SQL functions on the lhs' to use the new SQLA literal SQL + bind feature.
r7517 at Thesaurus (orig r7514): ribasushi | 2009-09-03 20:41:59 +0200
r7475 at Thesaurus (orig r7472): norbi | 2009-09-01 21:43:42 +0200
r7638 at vger: mendel | 2009-09-01 21:20:17 +0200
Added a comment to the example code to stress that it does not work.
r7518 at Thesaurus (orig r7515): ribasushi | 2009-09-03 20:42:10 +0200
r7476 at Thesaurus (orig r7473): norbi | 2009-09-01 21:43:54 +0200
r7639 at vger: mendel | 2009-09-01 21:28:18 +0200
Added pointer to DBIx::Class::DynamicSubclass.
r7519 at Thesaurus (orig r7516): ribasushi | 2009-09-03 20:42:15 +0200
r7477 at Thesaurus (orig r7474): norbi | 2009-09-01 21:44:03 +0200
r7640 at vger: mendel | 2009-09-01 21:30:13 +0200
Replaced deprecated \'colname DESC' order_by syntax with { -desc => 'colname' } syntax.
r7520 at Thesaurus (orig r7517): ribasushi | 2009-09-03 20:42:22 +0200
r7478 at Thesaurus (orig r7475): norbi | 2009-09-01 21:44:17 +0200
r7641 at vger: mendel | 2009-09-01 21:32:48 +0200
Rewrote 'SQL functions on the lhs' to use the new SQLA literal SQL + bind feature.
r7521 at Thesaurus (orig r7518): ribasushi | 2009-09-03 20:42:26 +0200
r7479 at Thesaurus (orig r7476): norbi | 2009-09-01 21:44:28 +0200
r7642 at vger: mendel | 2009-09-01 21:42:25 +0200
Added many-to-many add_to_*() example to stress that it returns the related row and not the linking table row.
r7522 at Thesaurus (orig r7519): ribasushi | 2009-09-03 20:42:32 +0200
r7480 at Thesaurus (orig r7477): norbi | 2009-09-01 22:14:25 +0200
r7653 at vger: mendel | 2009-09-01 22:14:11 +0200
Fixed wrong literal SQL + bind examples (missing operator and placeholders).
r7523 at Thesaurus (orig r7520): ribasushi | 2009-09-03 20:42:37 +0200
r7481 at Thesaurus (orig r7478): norbi | 2009-09-01 22:30:48 +0200
r7655 at vger: mendel | 2009-09-01 22:30:35 +0200
Fixed the bind value column names in the SQL literal + bind examples.
r7524 at Thesaurus (orig r7521): ribasushi | 2009-09-03 20:42:45 +0200
r7482 at Thesaurus (orig r7479): norbi | 2009-09-01 22:52:21 +0200
r7657 at vger: mendel | 2009-09-01 22:52:09 +0200
Further improvement in the bind value column names in the SQL literal + bind examples.
r7549 at Thesaurus (orig r7546): ribasushi | 2009-09-04 08:47:19 +0200
Stop connecting to determine dt-parser (test is in pg branch)
r7553 at Thesaurus (orig r7550): ribasushi | 2009-09-04 11:20:48 +0200
Require sqla with bool support
r7560 at Thesaurus (orig r7557): ribasushi | 2009-09-04 19:17:32 +0200
Dumper follies
r7561 at Thesaurus (orig r7558): ribasushi | 2009-09-04 19:27:50 +0200
Even better sqla
r7570 at Thesaurus (orig r7567): ribasushi | 2009-09-04 20:49:53 +0200
r7459 at Thesaurus (orig r7456): rbuels | 2009-09-01 12:46:46 +0200
making another pg_unqualified_schema branch, for real this time
r7460 at Thesaurus (orig r7457): rbuels | 2009-09-01 12:51:31 +0200
reworked tests for pg last_insert_id in presence of un-schema-qualified things. adds some todo tests, including a case for which is does not seem to be possible to correctly guess the sequence to use for the liid
r7461 at Thesaurus (orig r7458): rbuels | 2009-09-01 12:54:34 +0200
in Pg storage, added a warning for case when the nextval sequence is not schema qualified
r7462 at Thesaurus (orig r7459): rbuels | 2009-09-01 13:01:31 +0200
tweak to Pg test, warnings_like -> warnings_exist
r7463 at Thesaurus (orig r7460): ribasushi | 2009-09-01 13:34:59 +0200
Rewrap todo properly
r7490 at Thesaurus (orig r7487): ribasushi | 2009-09-02 14:16:01 +0200
Make pg sequence autodetect deterministic (or throw exceptions). Test needs adjusting
r7491 at Thesaurus (orig r7488): rbuels | 2009-09-02 19:15:01 +0200
some reorganization and cleanup of pg-specific tests
r7492 at Thesaurus (orig r7489): rbuels | 2009-09-02 20:08:31 +0200
more cleanup of 72pg.t
r7495 at Thesaurus (orig r7492): rbuels | 2009-09-02 20:48:12 +0200
more cleanup of pg tests, added cascade to drop function, cleaned up create and drop of schemas to use dbh_do
r7496 at Thesaurus (orig r7493): rbuels | 2009-09-02 20:50:42 +0200
oops, missed something screwed up by the pull
r7525 at Thesaurus (orig r7522): rbuels | 2009-09-03 20:45:53 +0200
added __END__ before pod in Pg storage
r7526 at Thesaurus (orig r7523): rbuels | 2009-09-03 20:46:00 +0200
renamed pg test schemas to be more organized
r7531 at Thesaurus (orig r7528): rbuels | 2009-09-04 00:28:11 +0200
more pg test cleanup
r7532 at Thesaurus (orig r7529): rbuels | 2009-09-04 00:28:17 +0200
more pg test cleanup
r7533 at Thesaurus (orig r7530): rbuels | 2009-09-04 00:28:25 +0200
starting work on extended set of Pg auto-pk tests
r7534 at Thesaurus (orig r7531): rbuels | 2009-09-04 00:28:31 +0200
more work on extended set of Pg auto-pk tests
r7535 at Thesaurus (orig r7532): rbuels | 2009-09-04 00:28:39 +0200
more work on pg tests
r7536 at Thesaurus (orig r7533): rbuels | 2009-09-04 00:28:45 +0200
more work on extended set of Pg auto-pk tests
r7537 at Thesaurus (orig r7534): rbuels | 2009-09-04 00:28:50 +0200
added .gitignore for users of git-svn
r7538 at Thesaurus (orig r7535): rbuels | 2009-09-04 00:28:58 +0200
more work on extended set of Pg auto-pk tests
r7539 at Thesaurus (orig r7536): rbuels | 2009-09-04 00:29:04 +0200
added darcs and git to MANIFEST.SKIP version control skipping section
r7540 at Thesaurus (orig r7537): rbuels | 2009-09-04 00:41:26 +0200
more work on extended set of Pg auto-pk tests
r7541 at Thesaurus (orig r7538): rbuels | 2009-09-04 00:41:32 +0200
more work on extended set of Pg auto-pk tests
r7542 at Thesaurus (orig r7539): rbuels | 2009-09-04 00:41:38 +0200
more work on extended set of Pg auto-pk tests
r7543 at Thesaurus (orig r7540): rbuels | 2009-09-04 02:20:23 +0200
more work on extended set of Pg auto-pk tests
r7544 at Thesaurus (orig r7541): rbuels | 2009-09-04 02:20:32 +0200
rewrote autoinc fetcher as a query into the pg_catalog. all the old tests pass now, but not my new tests. the new tests might be buggy
r7545 at Thesaurus (orig r7542): rbuels | 2009-09-04 02:20:39 +0200
oops, forgot to put the drop for the extended tests back in the pg tests
r7546 at Thesaurus (orig r7543): rbuels | 2009-09-04 02:41:56 +0200
couple of comment/documentation tweaks to pg storage driver
r7547 at Thesaurus (orig r7544): rbuels | 2009-09-04 02:42:02 +0200
fixed my tests
r7548 at Thesaurus (orig r7545): rbuels | 2009-09-04 02:42:09 +0200
clarified the POD in Pg storage driver regarding multi-schema support
r7551 at Thesaurus (orig r7548): ribasushi | 2009-09-04 08:51:30 +0200
Proper unconnected test
r7554 at Thesaurus (orig r7551): ribasushi | 2009-09-04 11:26:12 +0200
Fixes to pg test after review:
- Move the store_column test to 60core.t
- Streamline the select ... for update test
- Disable all exception warnings for normal test runs
r7555 at Thesaurus (orig r7552): ribasushi | 2009-09-04 11:56:00 +0200
Rewrite selector using sqla
r7562 at Thesaurus (orig r7559): rbuels | 2009-09-04 19:42:52 +0200
moved search_path querying function from Pg storage driver into tests
r7563 at Thesaurus (orig r7560): rbuels | 2009-09-04 19:43:00 +0200
refactored how Pg storage driver calls sequence search, made erorror message more informative when query into pg_catalog fails
r7564 at Thesaurus (orig r7561): rbuels | 2009-09-04 19:43:08 +0200
tweaked pg sequence discovery error message a bit more
r7565 at Thesaurus (orig r7562): rbuels | 2009-09-04 19:43:17 +0200
added big block comment explaining Pg sequence discovery strategy
r7566 at Thesaurus (orig r7563): rbuels | 2009-09-04 20:35:10 +0200
added code to use DBD::Pg column_info to fetch column default if recent enough
r7567 at Thesaurus (orig r7564): rbuels | 2009-09-04 20:35:18 +0200
tweaked comment
r7568 at Thesaurus (orig r7565): rbuels | 2009-09-04 20:35:30 +0200
oops, DBD::Pg 2.15.1 should be included in working versions
r7572 at Thesaurus (orig r7569): ribasushi | 2009-09-04 21:32:01 +0200
Stop double-caching datetime_parser - keep it in the storage only
r7573 at Thesaurus (orig r7570): ribasushi | 2009-09-04 21:36:39 +0200
No Serialize::Storable in core
r7574 at Thesaurus (orig r7571): ribasushi | 2009-09-04 21:49:54 +0200
Changes
r7580 at Thesaurus (orig r7577): ribasushi | 2009-09-06 12:28:44 +0200
Add mysterious exception test
r7582 at Thesaurus (orig r7579): ribasushi | 2009-09-06 15:43:10 +0200
No connection - no cleanup
r7583 at Thesaurus (orig r7580): ribasushi | 2009-09-06 15:45:51 +0200
Streamline test
r7584 at Thesaurus (orig r7581): ribasushi | 2009-09-06 17:39:03 +0200
Test cleanup:
Benchmark and Data::Dumper have been in core forever
Make POD testing conditional as shown in http://use.perl.org/~Alias/journal/38822
Remove some dead cdbi test files
Stop openly giving contributors an option to override the authorcheck
r7585 at Thesaurus (orig r7582): ribasushi | 2009-09-06 17:48:32 +0200
Done long time ago
r7586 at Thesaurus (orig r7583): ribasushi | 2009-09-06 17:56:27 +0200
Release 0.08110
r7588 at Thesaurus (orig r7585): ribasushi | 2009-09-06 18:33:46 +0200
Stop eating exceptions in ::Storage::DBI::DESTROY
r7589 at Thesaurus (orig r7586): ribasushi | 2009-09-06 20:35:30 +0200
Centralize identity insert control for mssql (it seems that issuing an OFF is not necessary)
r7590 at Thesaurus (orig r7587): ribasushi | 2009-09-06 20:45:41 +0200
Clearer MSSQL error message
r7591 at Thesaurus (orig r7588): ribasushi | 2009-09-06 23:58:22 +0200
Fix mssql pod
r7592 at Thesaurus (orig r7589): ribasushi | 2009-09-07 09:06:05 +0200
Release 0.08111
r7598 at Thesaurus (orig r7595): wreis | 2009-09-07 15:31:38 +0200
improved warn for Storable hooks in ResultSourceHandle
r7600 at Thesaurus (orig r7597): ribasushi | 2009-09-07 16:26:59 +0200
Whoops - last_insert_id allows for multiple autoinc columns - support it in pg
r7601 at Thesaurus (orig r7598): ribasushi | 2009-09-07 16:46:14 +0200
Prune duplicate constraints from the find() condition
r7606 at Thesaurus (orig r7603): frew | 2009-09-08 20:13:29 +0200
Turn IDENTITY_INSERT back off after inserts
Property changes on: DBIx-Class/0.08/branches/extended_rels
___________________________________________________________________
Name: svk:merge
- 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/branches/resultsetcolumn_custom_columns:5160
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/branches/sqla_1.50_compat:5414
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/trunk:7237
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class:32260
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class-CDBICompat:54993
9c88509d-e914-0410-b01c-b9530614cbfe:/vendor/DBIx-Class:31122
ab17426e-7cd3-4704-a2a2-80b7c0a611bb:/local/dbic_column_attr:10946
ab17426e-7cd3-4704-a2a2-80b7c0a611bb:/local/dbic_trunk:11788
bd5ac9a7-f185-4d95-9186-dbb8b392a572:/local/os/bast/DBIx-Class/0.08/trunk:2798
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/belongs_to_null_col_fix:5244
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/cdbicompat_integration:4160
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/column_attr:5074
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/complex_join_rels:4589
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/count_distinct:6218
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/count_rs:6741
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/diamond_relationships:6310
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/discard_changes_replication_fix:7252
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/file_column:3920
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/fix-update-and-delete-as_query:6162
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/grouped_prefetch:6885
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/joined_count:6323
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_money_type:7096
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_storage_minor_refactor:7210
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_top_fixes:6971
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/multi_stuff:5565
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mysql_ansi:7175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mystery_join:6589
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/new_replication_transaction_fixup:7058
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_connect_call:6854
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle-tweaks:6222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle_sequence:4173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/order_by_refactor:6475
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/parser_fk_index:4485
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch:5699
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch_limit:6724
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch_redux:7206
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/replication_dedux:4600
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/rsrc_in_storage:6577
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/rt_bug_41083:5437
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/savepoints:4223
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/search_related_prefetch:6818
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sqla_1.50_compat:5321
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-ms-access:4142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-tweaks:6262
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/subclassed_rsset:5930
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/subquery:5617
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/syb_connected:6919
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase:5651
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_mssql:6125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/top_limit_altfix:6429
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/type_aware_update:6619
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/unresolvable_prefetch:6949
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioned_enhancements:4125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioning:4578
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/views:5585
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/tags/0.08108_prerelease_please_do_not_pull_into_it:7008
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/trunk:7254
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:3606
fe160bb6-dc1c-0410-9f2b-d64a711b54a5:/local/DBIC-trunk-0.08:10510
+ 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/branches/cookbook_fixes:7657
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/branches/resultsetcolumn_custom_columns:5160
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/branches/sqla_1.50_compat:5414
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/trunk:7237
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class:32260
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class-CDBICompat:54993
9c88509d-e914-0410-b01c-b9530614cbfe:/vendor/DBIx-Class:31122
ab17426e-7cd3-4704-a2a2-80b7c0a611bb:/local/dbic_column_attr:10946
ab17426e-7cd3-4704-a2a2-80b7c0a611bb:/local/dbic_trunk:11788
bd5ac9a7-f185-4d95-9186-dbb8b392a572:/local/os/bast/DBIx-Class/0.08/trunk:2798
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/_abandoned_but_possibly_useful/table_name_ref:7266
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/autocast:7418
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/belongs_to_null_col_fix:5244
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/cdbicompat_integration:4160
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/column_attr:5074
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/complex_join_rels:4589
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/connect_info_hash:7435
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/cookbook_fixes:7479
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/count_distinct:6218
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/count_rs:6741
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/diamond_relationships:6310
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/discard_changes_replication_fix:7252
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/file_column:3920
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/fix-update-and-delete-as_query:6162
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/grouped_has_many_join:7382
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/grouped_prefetch:6885
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/joined_count:6323
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mc_fixes:6645
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_money_type:7096
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_storage_minor_refactor:7210
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_top_fixes:6971
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/multi_stuff:5565
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/multicreate_fixes:7275
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mysql_ansi:7175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mystery_join:6589
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/new_replication_transaction_fixup:7058
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_connect_call:6854
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle-tweaks:6222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle_sequence:4173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/order_by_refactor:6475
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/parser_fk_index:4485
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/pg_unqualified_schema:7566
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch:5699
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch_limit:6724
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch_redux:7206
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/reduce_pings:7261
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/replication_dedux:4600
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/rsrc_in_storage:6577
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/rt_bug_41083:5437
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/savepoints:4223
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/search_related_prefetch:6818
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sqla_1.50_compat:5321
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-ms-access:4142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-tweaks:6262
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/subclassed_rsset:5930
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/subquery:5617
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/syb_connected:6919
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase:5651
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_mssql:6125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/table_name_ref:7132
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/top_limit_altfix:6429
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/type_aware_update:6619
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/unresolvable_prefetch:6949
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioned_enhancements:4125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioning:4578
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/views:5585
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/tags/0.08108_prerelease_please_do_not_pull_into_it:7008
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/tags/pre_0.08109_please_do_not_merge:7336
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/trunk:7603
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:3606
fe160bb6-dc1c-0410-9f2b-d64a711b54a5:/local/DBIC-trunk-0.08:10510
Added: DBIx-Class/0.08/branches/extended_rels/.gitignore
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/.gitignore (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/.gitignore 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,7 @@
+META.yml
+Makefile
+README
+blib/
+inc/
+pm_to_blib
+t/var/
Modified: DBIx-Class/0.08/branches/extended_rels/Changes
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/Changes 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/Changes 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,5 +1,25 @@
Revision history for DBIx::Class
+0.08111 2009-09-06 21:58:00 (UTC)
+ - The hashref to connection_info now accepts a 'dbh_maker'
+ coderef, allowing better intergration with Catalyst
+ - Fixed a complex prefetch + regular join regression introduced
+ in 0.08108
+ - Fixed insert_bulk rebless handling
+ - Fixed Storable roundtrip regression, and general serialization
+ cleanup
+ - SQLT related fixes:
+ - sqlt_type is now called on the correct storage object
+ - hooks can now see the correct producer_type (RT#47891)
+ - optional SQLT requirements for e.g. deploy() bumped to 0.11002
+ - Really fixed (and greatly cleaned up) postgresql autoinc sequence
+ autodetection
+ - Automatically detect MySQL v3 and use INNER JOIN instead of JOIN
+ - POD improvements (including RT#48769)
+ - Test suite tweaks (including fixes for recent CPANTS fails)
+ - Better support for MSSQL IDENTITY_INSERT ON
+
+0.08109 2009-08-18 08:35:00 (UTC)
- Replication updates:
- Improved the replication tests so that they are more reliable
and accurate, and hopefully solve some cross platform issues.
@@ -31,9 +51,16 @@
problems with search_related chaining
- Deal with the distinct => 1 attribute properly when using
prefetch
+ - An extension of the select-hashref syntax, allowing labeling
+ SQL-side aliasing: select => [ { max => 'foo', -as => 'bar' } ]
+ - Massive optimization of the DBI storage layer - reduce the
+ amount of connected() ping-calls
+ - Some fixes of multi-create corner cases
- Multiple POD improvements
+ - Added exception when resultset is called without an argument
+ - Improved support for non-schema-qualified tables under
+ Postgres (fixed last_insert_id sequence name auto-detection)
-
0.08108 2009-07-05 23:15:00 (UTC)
- Fixed the has_many prefetch with limit/group deficiency -
it is now possible to select "top 5 commenters" while
Modified: DBIx-Class/0.08/branches/extended_rels/MANIFEST.SKIP
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/MANIFEST.SKIP 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/MANIFEST.SKIP 2009-09-09 09:39:56 UTC (rev 7609)
@@ -6,6 +6,9 @@
\bCVS\b
,v$
\B\.svn\b
+\B\.git\b
+\B\.gitignore\b
+\b_darcs\b
# Avoid Makemaker generated and utility files.
\bMakefile$
Modified: DBIx-Class/0.08/branches/extended_rels/Makefile.PL
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/Makefile.PL 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/Makefile.PL 2009-09-09 09:39:56 UTC (rev 7609)
@@ -10,103 +10,109 @@
all_from 'lib/DBIx/Class.pm';
-test_requires 'Test::Builder' => 0.33;
-test_requires 'Test::Deep' => 0;
-test_requires 'Test::Exception' => 0;
-test_requires 'Test::More' => 0.92;
-test_requires 'Test::Warn' => 0.11;
+test_requires 'Test::Builder' => '0.33';
+test_requires 'Test::Deep' => '0';
+test_requires 'Test::Exception' => '0';
+test_requires 'Test::More' => '0.92';
+test_requires 'Test::Warn' => '0.21';
-test_requires 'File::Temp' => 0.22;
+test_requires 'File::Temp' => '0.22';
# Core
-requires 'List::Util' => 0;
-requires 'Scalar::Util' => 0;
-requires 'Storable' => 0;
+requires 'List::Util' => '0';
+requires 'Scalar::Util' => '0';
+requires 'Storable' => '0';
# Perl 5.8.0 doesn't have utf8::is_utf8()
-requires 'Encode' => 0 if ($] <= 5.008000);
+requires 'Encode' => '0' if ($] <= 5.008000);
# Dependencies (keep in alphabetical order)
-requires 'Carp::Clan' => 6.0;
-requires 'Class::Accessor::Grouped' => 0.08003;
-requires 'Class::C3::Componentised' => 1.0005;
-requires 'Class::Inspector' => 1.24;
-requires 'Data::Page' => 2.00;
-requires 'DBD::SQLite' => 1.25;
-requires 'DBI' => 1.605;
-requires 'JSON::Any' => 1.18;
-requires 'MRO::Compat' => 0.09;
-requires 'Module::Find' => 0.06;
-requires 'Path::Class' => 0.16;
-requires 'Scope::Guard' => 0.03;
-requires 'SQL::Abstract' => 1.56;
-requires 'SQL::Abstract::Limit' => 0.13;
-requires 'Sub::Name' => 0.04;
+requires 'Carp::Clan' => '6.0';
+requires 'Class::Accessor::Grouped' => '0.09000';
+requires 'Class::C3::Componentised' => '1.0005';
+requires 'Class::Inspector' => '1.24';
+requires 'Data::Page' => '2.00';
+requires 'DBD::SQLite' => '1.25';
+requires 'DBI' => '1.605';
+requires 'JSON::Any' => '1.18';
+requires 'MRO::Compat' => '0.09';
+requires 'Module::Find' => '0.06';
+requires 'Path::Class' => '0.16';
+requires 'Scope::Guard' => '0.03';
+requires 'SQL::Abstract' => '1.58';
+requires 'SQL::Abstract::Limit' => '0.13';
+requires 'Sub::Name' => '0.04';
-recommends 'SQL::Translator' => 0.09004;
-
my %replication_requires = (
- 'Moose', => 0.87,
- 'MooseX::AttributeHelpers' => 0.21,
- 'MooseX::Types', => 0.16,
- 'namespace::clean' => 0.11,
- 'Hash::Merge', => 0.11,
+ 'Moose', => '0.87',
+ 'MooseX::AttributeHelpers' => '0.21',
+ 'MooseX::Types', => '0.16',
+ 'namespace::clean' => '0.11',
+ 'Hash::Merge', => '0.11',
);
+# when changing also adjust $DBIx::Class::minimum_sqlt_version
+my $sqlt_recommends = '0.11002';
+
+recommends 'SQL::Translator' => $sqlt_recommends;
+
my %force_requires_if_author = (
%replication_requires,
-# 'Module::Install::Pod::Inherit' => 0.01,
- 'Test::Pod::Coverage' => 1.04,
- 'SQL::Translator' => 0.09007,
+# 'Module::Install::Pod::Inherit' => '0.01',
+ 'SQL::Translator' => $sqlt_recommends,
+ # when changing also adjust version in t/02pod.t
+ 'Test::Pod' => '1.26',
+
+ # when changing also adjust version in t/03podcoverage.t
+ 'Test::Pod::Coverage' => '1.08',
+ 'Pod::Coverage' => '0.20',
+
# CDBI-compat related
- 'DBIx::ContextualFetch' => 0,
- 'Class::DBI::Plugin::DeepAbstractSearch' => 0,
- 'Class::Trigger' => 0,
- 'Time::Piece::MySQL' => 0,
- 'Clone' => 0,
- 'Date::Simple' => 3.03,
+ 'DBIx::ContextualFetch' => '0',
+ 'Class::DBI::Plugin::DeepAbstractSearch' => '0',
+ 'Class::Trigger' => '0',
+ 'Time::Piece::MySQL' => '0',
+ 'Clone' => '0',
+ 'Date::Simple' => '3.03',
# t/52cycle.t
- 'Test::Memory::Cycle' => 0,
- 'Devel::Cycle' => 1.10,
+ 'Test::Memory::Cycle' => '0',
+ 'Devel::Cycle' => '1.10',
# t/36datetime.t
# t/60core.t
- 'DateTime::Format::SQLite' => 0,
+ 'DateTime::Format::SQLite' => '0',
# t/96_is_deteministic_value.t
- 'DateTime::Format::Strptime'=> 0,
+ 'DateTime::Format::Strptime'=> '0',
# database-dependent reqs
#
$ENV{DBICTEST_PG_DSN}
? (
- 'Sys::SigAction' => 0,
- 'DBD::Pg' => 2.009002,
- 'DateTime::Format::Pg' => 0,
+ 'Sys::SigAction' => '0',
+ 'DBD::Pg' => '2.009002',
+ 'DateTime::Format::Pg' => '0',
) : ()
,
$ENV{DBICTEST_MYSQL_DSN}
? (
- 'DateTime::Format::MySQL' => 0,
+ 'DateTime::Format::MySQL' => '0',
) : ()
,
$ENV{DBICTEST_ORACLE_DSN}
? (
- 'DateTime::Format::Oracle' => 0,
+ 'DateTime::Format::Oracle' => '0',
) : ()
,
);
-feature ('Storage Replication', -default => 0, %replication_requires);
-
-
install_script (qw|
script/dbicadmin
|);
@@ -120,6 +126,12 @@
resources 'repository' => 'http://dev.catalyst.perl.org/svnweb/bast/browse/DBIx-Class/';
resources 'MailingList' => 'http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class';
+no_index 'DBIx::Class::Storage::DBI::Sybase::Base';
+no_index 'DBIx::Class::SQLAHacks';
+no_index 'DBIx::Class::SQLAHacks::MSSQL';
+no_index 'DBIx::Class::Storage::DBI::AmbiguousGlob';
+no_index 'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server';
+no_index 'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars';
# re-build README and require extra modules for testing if we're in a checkout
Modified: DBIx-Class/0.08/branches/extended_rels/TODO
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/TODO 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/TODO 2009-09-09 09:39:56 UTC (rev 7609)
@@ -25,13 +25,6 @@
__PACKAGE__->table(__PACKAGE__->table()); for the result set to
return the correct object type.
-2006-03-27 by mst
- Add the ability for deploy to be given a directory and grab <dbname>.sql
- out of there if available. Try SQL::Translator if not. If none of the above,
- cry (and die()). Then you can have a script that pre-gens for all available
- SQLT modules so an app can do its own deploy without SQLT on the target
- system
-
2006-05-25 by mst (TODOed by bluefeet)
Add the search attributes "limit" and "rows_per_page".
limit: work as expected just like offset does
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Core.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Core.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Core.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -34,8 +34,6 @@
=over 4
-=item L<DBIx::Class::Serialize::Storable>
-
=item L<DBIx::Class::InflateColumn>
=item L<DBIx::Class::Relationship>
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/InflateColumn/DateTime.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/InflateColumn/DateTime.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/InflateColumn/DateTime.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -18,6 +18,7 @@
__PACKAGE__->load_components(qw/InflateColumn::DateTime Core/);
__PACKAGE__->add_columns(
starts_when => { data_type => 'datetime' }
+ create_date => { data_type => 'date' }
);
NOTE: You B<must> load C<InflateColumn::DateTime> B<before> C<Core>. See
@@ -69,14 +70,22 @@
that this feature is new as of 0.07, so it may not be perfect yet - bug
reports to the list very much welcome).
+If the data_type of a field is C<date>, C<datetime> or C<timestamp> (or
+a derivative of these datatypes, e.g. C<timestamp with timezone>), this
+module will automatically call the appropriate parse/format method for
+deflation/inflation as defined in the storage class. For instance, for
+a C<datetime> field the methods C<parse_datetime> and C<format_datetime>
+would be called on deflation/inflation. If the storage class does not
+provide a specialized inflator/deflator, C<[parse|format]_datetime> will
+be used as a fallback. See L<DateTime::Format> for more information on
+date formatting.
+
For more help with using components, see L<DBIx::Class::Manual::Component/USING>.
=cut
__PACKAGE__->load_components(qw/InflateColumn/);
-__PACKAGE__->mk_group_accessors('simple' => '__datetime_parser');
-
=head2 register_column
Chains with the L<DBIx::Class::Row/register_column> method, and sets
@@ -213,12 +222,7 @@
}
sub _datetime_parser {
- my $self = shift;
- if (my $parser = $self->__datetime_parser) {
- return $parser;
- }
- my $parser = $self->result_source->storage->datetime_parser(@_);
- return $self->__datetime_parser($parser);
+ shift->result_source->storage->datetime_parser (@_);
}
1;
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Component.pod
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Component.pod 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Component.pod 2009-09-09 09:39:56 UTC (rev 7609)
@@ -84,6 +84,8 @@
These components provide extra functionality beyond
basic functionality that you can't live without.
+L<DBIx::Class::Serialize::Storable> - Hooks for Storable freeze/thaw.
+
L<DBIx::Class::CDBICompat> - Class::DBI Compatibility layer.
L<DBIx::Class::FormTools> - Build forms with multiple interconnected objects.
@@ -110,10 +112,6 @@
change, they may not work, etc. So, use them if you want, but
be warned.
-L<DBIx::Class::Serialize> - Hooks for Storable freeze/thaw.
-
-L<DBIx::Class::Serialize::Storable> - Hooks for Storable freeze/thaw.
-
L<DBIx::Class::Validation> - Validate all data before submitting to your database.
=head2 Core
@@ -145,4 +143,3 @@
=head1 AUTHOR
Aran Clary Deltac <bluefeet at cpan.org>
-
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Cookbook.pod
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Cookbook.pod 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Cookbook.pod 2009-09-09 09:39:56 UTC (rev 7609)
@@ -37,8 +37,11 @@
This results in something like the following C<WHERE> clause:
- WHERE artist LIKE '%Lamb%' AND title LIKE '%Fear of Fours%'
+ WHERE artist LIKE ? AND title LIKE ?
+And the following bind values for the placeholders: C<'%Lamb%'>, C<'%Fear of
+Fours%'>.
+
Other queries might require slightly more complex logic:
my @albums = $schema->resultset('Album')->search({
@@ -103,8 +106,9 @@
be optimized for your database in a special way, but you still want to
get the results as a L<DBIx::Class::ResultSet>.
-The recommended way to accomplish this is by defining a separate
-L<ResultSource::View|DBIx::Class::ResultSource::View> for your query.
+This is accomplished by defining a
+L<ResultSource::View|DBIx::Class::ResultSource::View> for your query,
+almost like you would define a regular ResultSource.
package My::Schema::Result::UserFriendsComplex;
use strict;
@@ -116,7 +120,9 @@
# ->table, ->add_columns, etc.
+ # do not attempt to deploy() this view
__PACKAGE__->result_source_instance->is_virtual(1);
+
__PACKAGE__->result_source_instance->view_definition(q[
SELECT u.* FROM user u
INNER JOIN user_friends f ON u.id = f.user_id
@@ -141,6 +147,21 @@
Note that you cannot have bind parameters unless is_virtual is set to true.
+=over
+
+=item * NOTE
+
+If you're using the old deprecated C<< $rsrc_instance->name(\'( SELECT ...') >>
+method for custom SQL execution, you are highly encouraged to update your code
+to use a virtual view as above. If you do not want to change your code, and just
+want to suppress the deprecation warning when you call
+L<DBIx::Class::Schema/deploy>, add this line to your source definition, so that
+C<deploy> will exclude this "table":
+
+ sub sqlt_deploy_hook { $_[1]->schema->drop_table ($_[1]) }
+
+=back
+
=head2 Using specific columns
When you only want specific columns from a table, you can use
@@ -181,13 +202,34 @@
# SELECT name name, LENGTH( name )
# FROM artist
-Note that the C< as > attribute has absolutely nothing to with the sql
-syntax C< SELECT foo AS bar > (see the documentation in
-L<DBIx::Class::ResultSet/ATTRIBUTES>). If your alias exists as a
-column in your base class (i.e. it was added with C<add_columns>), you
-just access it as normal. Our C<Artist> class has a C<name> column, so
-we just use the C<name> accessor:
+Note that the C<as> attribute B<has absolutely nothing to do> with the sql
+syntax C< SELECT foo AS bar > (see the documentation in
+L<DBIx::Class::ResultSet/ATTRIBUTES>). You can control the C<AS> part of the
+generated SQL via the C<-as> field attribute as follows:
+ my $rs = $schema->resultset('Artist')->search(
+ {},
+ {
+ join => 'cds',
+ distinct => 1,
+ '+select' => [ { count => 'cds.cdid', -as => 'amount_of_cds' } ],
+ '+as' => [qw/num_cds/],
+ order_by => { -desc => 'amount_of_cds' },
+ }
+ );
+
+ # Equivalent SQL
+ # SELECT me.artistid, me.name, me.rank, me.charfield, COUNT( cds.cdid ) AS amount_of_cds
+ # FROM artist me LEFT JOIN cd cds ON cds.artist = me.artistid
+ # GROUP BY me.artistid, me.name, me.rank, me.charfield
+ # ORDER BY amount_of_cds DESC
+
+
+If your alias exists as a column in your base class (i.e. it was added with
+L<add_columns|DBIx::Class::ResultSource/add_columns>), you just access it as
+normal. Our C<Artist> class has a C<name> column, so we just use the C<name>
+accessor:
+
my $artist = $rs->first();
my $name = $artist->name();
@@ -205,6 +247,8 @@
# Or use DBIx::Class::AccessorGroup:
__PACKAGE__->mk_group_accessors('column' => 'name_length');
+See also L</Using SQL functions on the left hand side of a comparison>.
+
=head2 SELECT DISTINCT with multiple columns
my $rs = $schema->resultset('Artist')->search(
@@ -292,7 +336,7 @@
The following will B<not> work:
my $rs = $schema->resultset('CD')->search({
- artist_id => $inside_rs->get_column('id')->as_query,
+ artist_id => $inside_rs->get_column('id')->as_query, # does NOT work
});
=head3 Support
@@ -365,8 +409,10 @@
=head2 Using SQL functions on the left hand side of a comparison
-Using SQL functions on the left hand side of a comparison is generally
-not a good idea since it requires a scan of the entire table. However,
+Using SQL functions on the left hand side of a comparison is generally not a
+good idea since it requires a scan of the entire table. (Unless your RDBMS
+supports indexes on expressions - including return values of functions -, and
+you create an index on the return value of the function in question.) However,
it can be accomplished with C<DBIx::Class> when necessary.
If you do not have quoting on, simply include the function in your search
@@ -374,25 +420,30 @@
$rs->search({ 'YEAR(date_of_birth)' => 1979 });
-With quoting on, or for a more portable solution, use the C<where>
-attribute:
+With quoting on, or for a more portable solution, use literal SQL values with
+placeholders:
- $rs->search({}, { where => \'YEAR(date_of_birth) = 1979' });
+ $rs->search(\[ 'YEAR(date_of_birth) = ?', [ plain_value => 1979 ] ]);
-=begin hidden
+ # Equivalent SQL:
+ # SELECT * FROM employee WHERE YEAR(date_of_birth) = ?
-(When the bind args ordering bug is fixed, this technique will be better
-and can replace the one above.)
+ $rs->search({
+ name => 'Bob',
+ -nest => \[ 'YEAR(date_of_birth) = ?', [ plain_value => 1979 ] ],
+ });
-With quoting on, or for a more portable solution, use the C<where> and
-C<bind> attributes:
+ # Equivalent SQL:
+ # SELECT * FROM employee WHERE name = ? AND YEAR(date_of_birth) = ?
- $rs->search({}, {
- where => \'YEAR(date_of_birth) = ?',
- bind => [ 1979 ]
- });
+Note: the C<plain_value> string in the C<< [ plain_value => 1979 ] >> part
+should be either the same as the name of the column (do this if the type of the
+return value of the function is the same as the type of the column) or
+otherwise it's essentially a dummy string currently (use C<plain_value> as a
+habit). It is used by L<DBIx::Class> to handle special column types.
-=end hidden
+See also L<SQL::Abstract/Literal SQL with placeholders and bind values
+(subqueries)>.
=head1 JOINS AND PREFETCHING
@@ -883,6 +934,9 @@
### The statement below will print
print "I can do admin stuff\n" if $admin->can('do_admin_stuff');
+Alternatively you can use L<DBIx::Class::DynamicSubclass> that implements
+exactly the above functionality.
+
=head2 Skip row object creation for faster results
DBIx::Class is not built for speed, it's built for convenience and
@@ -1023,7 +1077,7 @@
To order C<< $book->pages >> by descending page_number, create the relation
as follows:
- __PACKAGE__->has_many('pages' => 'Page', 'book', { order_by => \'page_number DESC'} );
+ __PACKAGE__->has_many('pages' => 'Page', 'book', { order_by => { -desc => 'page_number'} } );
=head2 Filtering a relationship result set
@@ -1065,6 +1119,16 @@
$rs = $user->addresses(); # get all addresses for a user
$rs = $address->users(); # get all users for an address
+ my $address = $user->add_to_addresses( # returns a My::Address instance,
+ # NOT a My::UserAddress instance!
+ {
+ country => 'United Kingdom',
+ area_code => 'XYZ',
+ town => 'London',
+ street => 'Sesame',
+ }
+ );
+
=head2 Relationships across DB schemas
Mapping relationships across L<DB schemas|DBIx::Class::Manual::Glossary/DB schema>
@@ -1478,18 +1542,18 @@
Alternatively, you can send the conversion sql scripts to your
customers as above.
-=head2 Setting quoting for the generated SQL.
+=head2 Setting quoting for the generated SQL
If the database contains column names with spaces and/or reserved words, they
need to be quoted in the SQL queries. This is done using:
- __PACKAGE__->storage->sql_maker->quote_char([ qw/[ ]/] );
- __PACKAGE__->storage->sql_maker->name_sep('.');
+ $schema->storage->sql_maker->quote_char([ qw/[ ]/] );
+ $schema->storage->sql_maker->name_sep('.');
The first sets the quote characters. Either a pair of matching
brackets, or a C<"> or C<'>:
- __PACKAGE__->storage->sql_maker->quote_char('"');
+ $schema->storage->sql_maker->quote_char('"');
Check the documentation of your database for the correct quote
characters to use. C<name_sep> needs to be set to allow the SQL
@@ -1508,6 +1572,17 @@
}
)
+In some cases, quoting will be required for all users of a schema. To enforce
+this, you can also overload the C<connection> method for your schema class:
+
+ sub connection {
+ my $self = shift;
+ my $rv = $self->next::method( @_ );
+ $rv->storage->sql_maker->quote_char([ qw/[ ]/ ]);
+ $rv->storage->sql_maker->name_sep('.');
+ return $rv;
+ }
+
=head2 Setting limit dialect for SQL::Abstract::Limit
In some cases, SQL::Abstract::Limit cannot determine the dialect of
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/DocMap.pod
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/DocMap.pod 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/DocMap.pod 2009-09-09 09:39:56 UTC (rev 7609)
@@ -40,8 +40,6 @@
=item L<DBIx::Class::Core> - Set of standard components to load.
-=item L<DBIx::Class::Serialize::Storable> - ?
-
=item L<DBIx::Class::InflateColumn> - Making objects out of your columns.
=item L<DBIx::Class::InflateColumn::DateTime> - Magically turn your datetime or timestamp columns into DateTime objects.
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Example.pod
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Example.pod 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Example.pod 2009-09-09 09:39:56 UTC (rev 7609)
@@ -27,7 +27,7 @@
Install DBIx::Class via CPAN should be sufficient.
-=head3 Create the database/tables.
+=head3 Create the database/tables
First make and change the directory:
@@ -126,7 +126,7 @@
1;
-=head3 Write a script to insert some records.
+=head3 Write a script to insert some records
insertdb.pl
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/FAQ.pod
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/FAQ.pod 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/FAQ.pod 2009-09-09 09:39:56 UTC (rev 7609)
@@ -26,8 +26,7 @@
Next, spend some time defining which data you need to store, and how
it relates to the other data you have. For some help on normalisation,
-go to L<http://b62.tripod.com/doc/dbbase.htm> or
-L<http://209.197.234.36/db/simple.html>.
+go to L<http://b62.tripod.com/doc/dbbase.htm>.
Now, decide whether you want to have the database itself be the
definitive source of information about the data layout, or your
@@ -217,10 +216,10 @@
->search({'created_time' => { '>=', '2006-06-01 00:00:00' } })
-Note that to use a function here you need to make the whole value into
-a scalar reference:
+Note that to use a function here you need to make it a scalar
+reference:
- ->search({'created_time' => \'>= yesterday()' })
+ ->search({'created_time' => { '>=', \'yesterday()' } })
=item .. search in several tables simultaneously?
@@ -244,34 +243,18 @@
query, which can be accessed similarly to a table, see your database
documentation for details.
-=item .. search using greater-than or less-than and database functions?
-
-To use functions or literal SQL with conditions other than equality
-you need to supply the entire condition, for example:
-
- my $interval = "< now() - interval '12 hours'";
- ->search({last_attempt => \$interval})
-
-and not:
-
- my $interval = "now() - interval '12 hours'";
- ->search({last_attempt => { '<' => \$interval } })
-
=item .. search with an SQL function on the left hand side?
To use an SQL function on the left hand side of a comparison:
- ->search({}, { where => \'YEAR(date_of_birth)=1979' });
+ ->search({ -nest => \[ 'YEAR(date_of_birth) = ?', [ plain_value => 1979 ] ] });
-=begin hidden
+Note: the C<plain_value> string in the C<< [ plain_value => 1979 ] >> part
+should be either the same as the name of the column (do this if the type of the
+return value of the function is the same as the type of the column) or
+otherwise it's essentially a dummy string currently (use C<plain_value> as a
+habit). It is used by L<DBIx::Class> to handle special column types.
-(When the bind arg ordering bug is fixed, the previous example can be
-replaced with the following.)
-
- ->search({}, { where => \'YEAR(date_of_birth)=?', bind => [ 1979 ] });
-
-=end hidden
-
Or, if you have quoting off:
->search({ 'YEAR(date_of_birth)' => 1979 });
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Intro.pod
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Intro.pod 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Intro.pod 2009-09-09 09:39:56 UTC (rev 7609)
@@ -200,9 +200,13 @@
=head2 Connecting
-To connect to your Schema, you need to provide the connection details. The
-arguments are the same as for L<DBI/connect>:
+To connect to your Schema, you need to provide the connection details or a
+database handle.
+=head3 Via connection details
+
+The arguments are the same as for L<DBI/connect>:
+
my $schema = My::Schema->connect('dbi:SQLite:/home/me/myapp/my.db');
You can create as many different schema instances as you need. So if you have a
@@ -227,6 +231,16 @@
See L<DBIx::Class::Schema::Storage::DBI/connect_info> for more information about
this and other special C<connect>-time options.
+=head3 Via a database handle
+
+The supplied coderef is expected to return a single connected database handle
+(e.g. a L<DBI> C<$dbh>)
+
+ my $schema = My::Schema->connect (
+ sub { Some::DBH::Factory->connect },
+ \%extra_attrs,
+ );
+
=head2 Basic usage
Once you've defined the basic classes, either manually or using
@@ -253,8 +267,8 @@
$album->set_column('title', 'Presence');
$title = $album->get_column('title');
-Just like with L<Class::DBI>, you call C<update> to commit your changes to the
-database:
+Just like with L<Class::DBI>, you call C<update> to save your changes to the
+database (by executing the actual C<UPDATE> statement):
$album->update;
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Troubleshooting.pod
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Troubleshooting.pod 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Manual/Troubleshooting.pod 2009-09-09 09:39:56 UTC (rev 7609)
@@ -17,11 +17,11 @@
Alternatively use the C<< storage->debug >> class method:-
- $class->storage->debug(1);
+ $schema->storage->debug(1);
To send the output somewhere else set debugfh:-
- $class->storage->debugfh(IO::File->new('/tmp/trace.out', 'w');
+ $schema->storage->debugfh(IO::File->new('/tmp/trace.out', 'w');
Alternatively you can do this with the environment variable too:-
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Ordered.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Ordered.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Ordered.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -362,38 +362,58 @@
my( $self, $to_position ) = @_;
return 0 if ( $to_position < 1 );
- my $from_position = $self->_position;
- return 0 if ( $from_position == $to_position );
-
my $position_column = $self->position_column;
- {
- my $guard = $self->result_source->schema->txn_scope_guard;
+ my $guard;
- my ($direction, @between);
- if ( $from_position < $to_position ) {
- $direction = -1;
- @between = map { $self->_position_value ($_) } ( $from_position + 1, $to_position );
- }
- else {
- $direction = 1;
- @between = map { $self->_position_value ($_) } ( $to_position, $from_position - 1 );
- }
+ if ($self->is_column_changed ($position_column) ) {
+ # something changed our position, we have no idea where we
+ # used to be - requery without using discard_changes
+ # (we need only a specific column back)
- my $new_pos_val = $self->_position_value ($to_position); # record this before the shift
+ $guard = $self->result_source->schema->txn_scope_guard;
- # we need to null-position the moved row if the position column is part of a constraint
- if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $self->result_source->unique_constraints }} ) ) ) {
- $self->_ordered_internal_update({ $position_column => $self->null_position_value });
- }
+ my $cursor = $self->result_source->resultset->search(
+ $self->ident_condition,
+ { select => $position_column },
+ )->cursor;
- $self->_shift_siblings ($direction, @between);
- $self->_ordered_internal_update({ $position_column => $new_pos_val });
+ my ($pos) = $cursor->next;
+ $self->$position_column ($pos);
+ delete $self->{_dirty_columns}{$position_column};
+ }
- $guard->commit;
+ my $from_position = $self->_position;
- return 1;
+ if ( $from_position == $to_position ) { # FIXME this will not work for non-numeric order
+ $guard->commit if $guard;
+ return 0;
}
+
+ $guard ||= $self->result_source->schema->txn_scope_guard;
+
+ my ($direction, @between);
+ if ( $from_position < $to_position ) {
+ $direction = -1;
+ @between = map { $self->_position_value ($_) } ( $from_position + 1, $to_position );
+ }
+ else {
+ $direction = 1;
+ @between = map { $self->_position_value ($_) } ( $to_position, $from_position - 1 );
+ }
+
+ my $new_pos_val = $self->_position_value ($to_position); # record this before the shift
+
+ # we need to null-position the moved row if the position column is part of a constraint
+ if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $self->result_source->unique_constraints }} ) ) ) {
+ $self->_ordered_internal_update({ $position_column => $self->null_position_value });
+ }
+
+ $self->_shift_siblings ($direction, @between);
+ $self->_ordered_internal_update({ $position_column => $new_pos_val });
+
+ $guard->commit;
+ return 1;
}
=head2 move_to_group
@@ -428,43 +448,72 @@
my $position_column = $self->position_column;
return 0 if ( defined($to_position) and $to_position < 1 );
+
+ # check if someone changed the _grouping_columns - this will
+ # prevent _is_in_group working, so we need to requery the db
+ # for the original values
+ my (@dirty_cols, %values, $guard);
+ for ($self->_grouping_columns) {
+ $values{$_} = $self->get_column ($_);
+ push @dirty_cols, $_ if $self->is_column_changed ($_);
+ }
+
+ # re-query only the dirty columns, and restore them on the
+ # object (subsequent code will update them to the correct
+ # after-move values)
+ if (@dirty_cols) {
+ $guard = $self->result_source->schema->txn_scope_guard;
+
+ my $cursor = $self->result_source->resultset->search(
+ $self->ident_condition,
+ { select => \@dirty_cols },
+ )->cursor;
+
+ my @original_values = $cursor->next;
+ $self->set_inflated_columns ({ %values, map { $_ => shift @original_values } (@dirty_cols) });
+ delete $self->{_dirty_columns}{$_} for (@dirty_cols);
+ }
+
if ($self->_is_in_group ($to_group) ) {
- return 0 if not defined $to_position;
- return $self->move_to ($to_position);
+ my $ret;
+ if (defined $to_position) {
+ $ret = $self->move_to ($to_position);
+ }
+
+ $guard->commit if $guard;
+ return $ret||0;
}
- {
- my $guard = $self->result_source->schema->txn_scope_guard;
+ $guard ||= $self->result_source->schema->txn_scope_guard;
- # Move to end of current group to adjust siblings
- $self->move_last;
+ # Move to end of current group to adjust siblings
+ $self->move_last;
- $self->set_inflated_columns({ %$to_group, $position_column => undef });
- my $new_group_last_posval = $self->_last_sibling_posval;
- my $new_group_last_position = $self->_position_from_value (
- $new_group_last_posval
- );
+ $self->set_inflated_columns({ %$to_group, $position_column => undef });
+ my $new_group_last_posval = $self->_last_sibling_posval;
+ my $new_group_last_position = $self->_position_from_value (
+ $new_group_last_posval
+ );
- if ( not defined($to_position) or $to_position > $new_group_last_position) {
- $self->set_column(
- $position_column => $new_group_last_position
- ? $self->_next_position_value ( $new_group_last_posval )
- : $self->_initial_position_value
- );
- }
- else {
- my $bumped_pos_val = $self->_position_value ($to_position);
- my @between = ($to_position, $new_group_last_position);
- $self->_shift_siblings (1, @between); #shift right
- $self->set_column( $position_column => $bumped_pos_val );
- }
+ if ( not defined($to_position) or $to_position > $new_group_last_position) {
+ $self->set_column(
+ $position_column => $new_group_last_position
+ ? $self->_next_position_value ( $new_group_last_posval )
+ : $self->_initial_position_value
+ );
+ }
+ else {
+ my $bumped_pos_val = $self->_position_value ($to_position);
+ my @between = ($to_position, $new_group_last_position);
+ $self->_shift_siblings (1, @between); #shift right
+ $self->set_column( $position_column => $bumped_pos_val );
+ }
- $self->_ordered_internal_update;
+ $self->_ordered_internal_update;
- $guard->commit;
+ $guard->commit;
- return 1;
- }
+ return 1;
}
=head2 insert
@@ -508,16 +557,47 @@
# this is set by _ordered_internal_update()
return $self->next::method(@_) if $self->{_ORDERED_INTERNAL_UPDATE};
- my $upd = shift;
- $self->set_inflated_columns($upd) if $upd;
- my %changes = $self->get_dirty_columns;
- $self->discard_changes;
-
my $position_column = $self->position_column;
+ my @ordering_columns = ($self->_grouping_columns, $position_column);
+
+ # these steps are necessary to keep the external appearance of
+ # ->update($upd) so that other things overloading update() will
+ # work properly
+ my %original_values = $self->get_columns;
+ my %existing_changes = $self->get_dirty_columns;
+
+ # See if any of the *supplied* changes would affect the ordering
+ # The reason this is so contrived, is that we want to leverage
+ # the datatype aware value comparing, while at the same time
+ # keep the original value intact (it will be updated later by the
+ # corresponding routine)
+
+ my %upd = %{shift || {}};
+ my %changes = %existing_changes;
+
+ for (@ordering_columns) {
+ next unless exists $upd{$_};
+
+ # we do not want to keep propagating this to next::method
+ # as it will be a done deal by the time get there
+ my $value = delete $upd{$_};
+ $self->set_inflated_columns ({ $_ => $value });
+
+ # see if an update resulted in a dirty column
+ # it is important to preserve the old value, as it
+ # will be needed to carry on a successfull move()
+ # operation without re-querying the database
+ if ($self->is_column_changed ($_) && not exists $existing_changes{$_}) {
+ $changes{$_} = $value;
+ $self->set_inflated_columns ({ $_ => $original_values{$_} });
+ delete $self->{_dirty_columns}{$_};
+ }
+ }
+
# if nothing group/position related changed - short circuit
- if (not grep { exists $changes{$_} } ($self->_grouping_columns, $position_column) ) {
- return $self->next::method( \%changes, @_ );
+ if (not grep { exists $changes{$_} } ( @ordering_columns ) ) {
+ return $self->next::method( \%upd, @_ );
}
{
@@ -529,37 +609,37 @@
# create new_group by taking the current group and inserting changes
my $new_group = {$self->_grouping_clause};
foreach my $col (keys %$new_group) {
- if (exists $changes{$col}) {
- $new_group->{$col} = delete $changes{$col}; # don't want to pass this on to next::method
- }
+ $new_group->{$col} = $changes{$col} if exists $changes{$col};
}
$self->move_to_group(
$new_group,
(exists $changes{$position_column}
- # The FIXME bit contradicts the documentation: when changing groups without supplying explicit
- # positions in move_to_group(), we push the item to the end of the group.
- # However when I was rewriting this, the position from the old group was clearly passed to the new one
+ # The FIXME bit contradicts the documentation: POD states that
+ # when changing groups without supplying explicit positions in
+ # move_to_group(), we push the item to the end of the group.
+ # However when I was rewriting this, the position from the old
+ # group was clearly passed to the new one
# Probably needs to go away (by ribasushi)
- ? delete $changes{$position_column} # means there was a position change supplied with the update too
- : $self->_position # FIXME!
+ ? $changes{$position_column} # means there was a position change supplied with the update too
+ : $self->_position # FIXME! (replace with undef)
),
);
}
elsif (exists $changes{$position_column}) {
- $self->move_to(delete $changes{$position_column});
+ $self->move_to($changes{$position_column});
}
my @res;
my $want = wantarray();
if (not defined $want) {
- $self->next::method( \%changes, @_ );
+ $self->next::method( \%upd, @_ );
}
elsif ($want) {
- @res = $self->next::method( \%changes, @_ );
+ @res = $self->next::method( \%upd, @_ );
}
else {
- $res[0] = $self->next::method( \%changes, @_ );
+ $res[0] = $self->next::method( \%upd, @_ );
}
$guard->commit;
@@ -790,8 +870,8 @@
=head2 _grouping_clause
This method returns one or more name=>value pairs for limiting a search
-by the grouping column(s). If the grouping column is not
-defined then this will return an empty list.
+by the grouping column(s). If the grouping column is not defined then
+this will return an empty list.
=cut
sub _grouping_clause {
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSet.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSet.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -570,12 +570,16 @@
my $where = $self->_collapse_cond($self->{attrs}{where} || {});
my $num_where = scalar keys %$where;
- my @unique_queries;
+ my (@unique_queries, %seen_column_combinations);
foreach my $name (@constraint_names) {
- my @unique_cols = $self->result_source->unique_constraint_columns($name);
- my $unique_query = $self->_build_unique_query($query, \@unique_cols);
+ my @constraint_cols = $self->result_source->unique_constraint_columns($name);
- my $num_cols = scalar @unique_cols;
+ my $constraint_sig = join "\x00", sort @constraint_cols;
+ next if $seen_column_combinations{$constraint_sig}++;
+
+ my $unique_query = $self->_build_unique_query($query, \@constraint_cols);
+
+ my $num_cols = scalar @constraint_cols;
my $num_query = scalar keys %$unique_query;
my $total = $num_query + $num_where;
@@ -1266,8 +1270,8 @@
# extra selectors do not go in the subquery and there is no point of ordering it
delete $sub_attrs->{$_} for qw/collapse select _prefetch_select as order_by/;
- # if we prefetch, we group_by primary keys only as this is what we would get out of the rs via ->next/->all
- # clobber old group_by regardless
+ # if we prefetch, we group_by primary keys only as this is what we would get out
+ # of the rs via ->next/->all. We DO WANT to clobber old group_by regardless
if ( keys %{$attrs->{collapse}} ) {
$sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->primary_columns) ]
}
@@ -1509,7 +1513,8 @@
if (my $g = $attrs->{group_by}) {
my @current_group_by = map
{ $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" }
- (ref $g eq 'ARRAY' ? @$g : $g );
+ @$g
+ ;
if (
join ("\x00", sort @current_group_by)
@@ -2277,6 +2282,19 @@
}
});
+=over
+
+=item WARNING
+
+When subclassing ResultSet never attempt to override this method. Since
+it is a simple shortcut for C<< $self->new_result($attrs)->insert >>, a
+lot of the internals simply never call it, so your override will be
+bypassed more often than not. Override either L<new|DBIx::Class::Row/new>
+or L<insert|DBIx::Class::Row/insert> depending on how early in the
+L</create> process you need to intervene.
+
+=back
+
=cut
sub create {
@@ -2839,7 +2857,7 @@
if ( $attrs->{join} || $attrs->{prefetch} ) {
- $self->throw_exception ('join/prefetch can not be used with a literal scalarref {from}')
+ $self->throw_exception ('join/prefetch can not be used with a custom {from}')
if ref $attrs->{from} ne 'ARRAY';
my $join = delete $attrs->{join} || {};
@@ -2871,7 +2889,7 @@
);
}
- if ($attrs->{group_by} and ! ref $attrs->{group_by}) {
+ if ($attrs->{group_by} and ref $attrs->{group_by} ne 'ARRAY') {
$attrs->{group_by} = [ $attrs->{group_by} ];
}
@@ -2985,6 +3003,13 @@
sub _calculate_score {
my ($self, $a, $b) = @_;
+ if (defined $a xor defined $b) {
+ return 0;
+ }
+ elsif (not defined $a) {
+ return 1;
+ }
+
if (ref $b eq 'HASH') {
my ($b_key) = keys %{$b};
if (ref $a eq 'HASH') {
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSource.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSource.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSource.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -6,7 +6,6 @@
use DBIx::Class::ResultSet;
use DBIx::Class::ResultSourceHandle;
use Carp::Clan qw/^DBIx::Class/;
-use Storable;
use base qw/DBIx::Class/;
@@ -584,7 +583,10 @@
sub name_unique_constraint {
my ($self, $cols) = @_;
- return join '_', $self->name, @$cols;
+ my $name = $self->name;
+ $name = $$name if (ref $name eq 'SCALAR');
+
+ return join '_', $name, @$cols;
}
=head2 unique_constraints
@@ -1234,10 +1236,11 @@
my $type;
if ($force_left) {
$type = 'left';
- } else {
- $type = $rel_info->{attrs}{join_type} || '';
- $force_left = 1 if lc($type) eq 'left';
}
+ else {
+ $type = $rel_info->{attrs}{join_type};
+ $force_left = 1 if lc($type||'') eq 'left';
+ }
my $rel_src = $self->related_source($join);
return [ { $as => $rel_src->from,
@@ -1262,18 +1265,22 @@
# hashref of columns of the related object.
sub _pk_depends_on {
my ($self, $relname, $rel_data) = @_;
- my $cond = $self->relationship_info($relname)->{cond};
+ my $relinfo = $self->relationship_info($relname);
+
+ # don't assume things if the relationship direction is specified
+ return $relinfo->{attrs}{is_foreign_key_constraint}
+ if exists ($relinfo->{attrs}{is_foreign_key_constraint});
+
+ my $cond = $relinfo->{cond};
return 0 unless ref($cond) eq 'HASH';
# map { foreign.foo => 'self.bar' } to { bar => 'foo' }
-
my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
# assume anything that references our PK probably is dependent on us
# rather than vice versa, unless the far side is (a) defined or (b)
# auto-increment
-
my $rel_source = $self->related_source($relname);
foreach my $p ($self->primary_columns) {
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSourceHandle.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSourceHandle.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSourceHandle.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -78,8 +78,9 @@
my $to_serialize = { %$self };
- my $class = $self->schema->class($self->source_moniker);
- $to_serialize->{schema} = $class;
+ delete $to_serialize->{schema};
+ $to_serialize->{_frozen_from_class} = $self->schema->class($self->source_moniker);
+
return (Storable::freeze($to_serialize));
}
@@ -93,10 +94,10 @@
sub STORABLE_thaw {
- my ($self, $cloning,$ice) = @_;
+ my ($self, $cloning, $ice) = @_;
%$self = %{ Storable::thaw($ice) };
- my $class = delete $self->{schema};
+ my $class = delete $self->{_frozen_from_class};
if( $thaw_schema ) {
$self->{schema} = $thaw_schema;
}
@@ -105,7 +106,8 @@
$self->{schema} = $rs->schema if $rs;
}
- carp "Unable to restore schema" unless $self->{schema};
+ carp "Unable to restore schema. Look at 'freeze' and 'thaw' methods in DBIx::Class::Schema."
+ unless $self->{schema};
}
=head1 AUTHOR
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSourceProxy/Table.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSourceProxy/Table.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/ResultSourceProxy/Table.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -5,6 +5,9 @@
use base qw/DBIx::Class::ResultSourceProxy/;
+use DBIx::Class::ResultSource::Table;
+use Scalar::Util ();
+
__PACKAGE__->mk_classdata(table_class => 'DBIx::Class::ResultSource::Table');
__PACKAGE__->mk_classdata('table_alias'); # FIXME: Doesn't actually do
@@ -76,8 +79,9 @@
sub table {
my ($class, $table) = @_;
return $class->result_source_instance->name unless $table;
- unless (ref $table) {
+ unless (Scalar::Util::blessed($table) && $table->isa($class->table_class)) {
+
my $table_class = $class->table_class;
$class->ensure_class_loaded($table_class);
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Row.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Row.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Row.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -164,8 +164,6 @@
unless ref($attrs) eq 'HASH';
my ($related,$inflated);
- ## Pretend all the rels are actual objects, unset below if not, for insert() to fix
- $new->{_rel_in_storage} = 1;
foreach my $key (keys %$attrs) {
if (ref $attrs->{$key}) {
@@ -181,9 +179,9 @@
}
if ($rel_obj->in_storage) {
+ $new->{_rel_in_storage}{$key} = 1;
$new->set_from_related($key, $rel_obj);
} else {
- $new->{_rel_in_storage} = 0;
MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj\n";
}
@@ -202,13 +200,11 @@
}
if ($rel_obj->in_storage) {
- $new->set_from_related($key, $rel_obj);
+ $rel_obj->throw_exception ('A multi relationship can not be pre-existing when doing multicreate. Something went wrong');
} else {
- $new->{_rel_in_storage} = 0;
MULTICREATE_DEBUG and
warn "MC $new uninserted $key $rel_obj (${\($idx+1)} of $total)\n";
}
- $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
push(@objects, $rel_obj);
}
$related->{$key} = \@objects;
@@ -221,8 +217,10 @@
if(!Scalar::Util::blessed($rel_obj)) {
$rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
}
- unless ($rel_obj->in_storage) {
- $new->{_rel_in_storage} = 0;
+ if ($rel_obj->in_storage) {
+ $new->{_rel_in_storage}{$key} = 1;
+ }
+ else {
MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj";
}
$inflated->{$key} = $rel_obj;
@@ -286,28 +284,22 @@
my %related_stuff = (%{$self->{_relationship_data} || {}},
%{$self->{_inflated_column} || {}});
- if(!$self->{_rel_in_storage}) {
+ # insert what needs to be inserted before us
+ my %pre_insert;
+ for my $relname (keys %related_stuff) {
+ my $rel_obj = $related_stuff{$relname};
- # The guard will save us if we blow out of this scope via die
- $rollback_guard = $source->storage->txn_scope_guard;
+ if (! $self->{_rel_in_storage}{$relname}) {
+ next unless (Scalar::Util::blessed($rel_obj)
+ && $rel_obj->isa('DBIx::Class::Row'));
- ## Should all be in relationship_data, but we need to get rid of the
- ## 'filter' reltype..
- ## These are the FK rels, need their IDs for the insert.
+ next unless $source->_pk_depends_on(
+ $relname, { $rel_obj->get_columns }
+ );
- my @pri = $self->primary_columns;
+ # The guard will save us if we blow out of this scope via die
+ $rollback_guard ||= $source->storage->txn_scope_guard;
- REL: foreach my $relname (keys %related_stuff) {
-
- my $rel_obj = $related_stuff{$relname};
-
- next REL unless (Scalar::Util::blessed($rel_obj)
- && $rel_obj->isa('DBIx::Class::Row'));
-
- next REL unless $source->_pk_depends_on(
- $relname, { $rel_obj->get_columns }
- );
-
MULTICREATE_DEBUG and warn "MC $self pre-reconstructing $relname $rel_obj\n";
my $them = { %{$rel_obj->{_relationship_data} || {} }, $rel_obj->get_inflated_columns };
@@ -315,12 +307,21 @@
->related_source($relname)
->resultset
->find_or_create($them);
+
%{$rel_obj} = %{$re};
- $self->set_from_related($relname, $rel_obj);
- delete $related_stuff{$relname};
+ $self->{_rel_in_storage}{$relname} = 1;
}
+
+ $self->set_from_related($relname, $rel_obj);
+ delete $related_stuff{$relname};
}
+ # start a transaction here if not started yet and there is more stuff
+ # to insert after us
+ if (keys %related_stuff) {
+ $rollback_guard ||= $source->storage->txn_scope_guard
+ }
+
MULTICREATE_DEBUG and do {
no warnings 'uninitialized';
warn "MC $self inserting (".join(', ', $self->get_columns).")\n";
@@ -332,13 +333,12 @@
## PK::Auto
my @auto_pri = grep {
- !defined $self->get_column($_) ||
- ref($self->get_column($_)) eq 'SCALAR'
+ (not defined $self->get_column($_))
+ ||
+ (ref($self->get_column($_)) eq 'SCALAR')
} $self->primary_columns;
if (@auto_pri) {
- #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
- # if defined $too_many;
MULTICREATE_DEBUG and warn "MC $self fetching missing PKs ".join(', ', @auto_pri)."\n";
my $storage = $self->result_source->storage;
$self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
@@ -353,47 +353,47 @@
$self->{_dirty_columns} = {};
$self->{related_resultsets} = {};
- if(!$self->{_rel_in_storage}) {
- ## Now do the relationships that need our ID (has_many etc.)
- foreach my $relname (keys %related_stuff) {
- my $rel_obj = $related_stuff{$relname};
- my @cands;
- if (Scalar::Util::blessed($rel_obj)
- && $rel_obj->isa('DBIx::Class::Row')) {
- @cands = ($rel_obj);
- } elsif (ref $rel_obj eq 'ARRAY') {
- @cands = @$rel_obj;
- }
- if (@cands) {
- my $reverse = $source->reverse_relationship_info($relname);
- foreach my $obj (@cands) {
- $obj->set_from_related($_, $self) for keys %$reverse;
- my $them = { %{$obj->{_relationship_data} || {} }, $obj->get_inflated_columns };
- if ($self->__their_pk_needs_us($relname, $them)) {
- if (exists $self->{_ignore_at_insert}{$relname}) {
- MULTICREATE_DEBUG and warn "MC $self skipping post-insert on $relname";
- } else {
- MULTICREATE_DEBUG and warn "MC $self re-creating $relname $obj";
- my $re = $self->result_source
- ->related_source($relname)
- ->resultset
- ->find_or_create($them);
- %{$obj} = %{$re};
- MULTICREATE_DEBUG and warn "MC $self new $relname $obj";
- }
+ foreach my $relname (keys %related_stuff) {
+ next unless $source->has_relationship ($relname);
+
+ my @cands = ref $related_stuff{$relname} eq 'ARRAY'
+ ? @{$related_stuff{$relname}}
+ : $related_stuff{$relname}
+ ;
+
+ if (@cands
+ && Scalar::Util::blessed($cands[0])
+ && $cands[0]->isa('DBIx::Class::Row')
+ ) {
+ my $reverse = $source->reverse_relationship_info($relname);
+ foreach my $obj (@cands) {
+ $obj->set_from_related($_, $self) for keys %$reverse;
+ my $them = { %{$obj->{_relationship_data} || {} }, $obj->get_inflated_columns };
+ if ($self->__their_pk_needs_us($relname, $them)) {
+ if (exists $self->{_ignore_at_insert}{$relname}) {
+ MULTICREATE_DEBUG and warn "MC $self skipping post-insert on $relname";
} else {
- MULTICREATE_DEBUG and warn "MC $self post-inserting $obj";
- $obj->insert();
+ MULTICREATE_DEBUG and warn "MC $self re-creating $relname $obj";
+ my $re = $self->result_source
+ ->related_source($relname)
+ ->resultset
+ ->create($them);
+ %{$obj} = %{$re};
+ MULTICREATE_DEBUG and warn "MC $self new $relname $obj";
}
+ } else {
+ MULTICREATE_DEBUG and warn "MC $self post-inserting $obj";
+ $obj->insert();
}
}
}
- delete $self->{_ignore_at_insert};
- $rollback_guard->commit;
}
$self->in_storage(1);
- undef $self->{_orig_ident};
+ delete $self->{_orig_ident};
+ delete $self->{_ignore_at_insert};
+ $rollback_guard->commit if $rollback_guard;
+
return $self;
}
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/SQLAHacks/MySQL.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/SQLAHacks/MySQL.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/SQLAHacks/MySQL.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -12,7 +12,7 @@
my $self = shift;
my $table = $_[0];
- $table = $self->_quote($table) unless ref($table);
+ $table = $self->_quote($table);
if (! $_[1] or (ref $_[1] eq 'HASH' and !keys %{$_[1]} ) ) {
return "INSERT INTO ${table} () VALUES ()"
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/SQLAHacks.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/SQLAHacks.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/SQLAHacks.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -329,12 +329,10 @@
$self->{"${_}_bind"} = [] for (qw/having from order/);
- if (ref $table eq 'SCALAR') {
- $table = $$table;
- }
- elsif (not ref $table) {
+ if (not ref($table) or ref($table) eq 'SCALAR') {
$table = $self->_quote($table);
}
+
local $self->{rownum_hack_count} = 1
if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
@rest = (-1) unless defined $rest[0];
@@ -354,7 +352,7 @@
sub insert {
my $self = shift;
my $table = shift;
- $table = $self->_quote($table) unless ref($table);
+ $table = $self->_quote($table);
# SQLA will emit INSERT INTO $table ( ) VALUES ( )
# which is sadly understood only by MySQL. Change default behavior here,
@@ -370,7 +368,7 @@
sub update {
my $self = shift;
my $table = shift;
- $table = $self->_quote($table) unless ref($table);
+ $table = $self->_quote($table);
$self->SUPER::update($table, @_);
}
@@ -378,7 +376,7 @@
sub delete {
my $self = shift;
my $table = shift;
- $table = $self->_quote($table) unless ref($table);
+ $table = $self->_quote($table);
$self->SUPER::delete($table, @_);
}
@@ -407,35 +405,33 @@
}
elsif ($ref eq 'HASH') {
my %hash = %$fields;
- my ($select, $as);
- if ($hash{-select}) {
- $select = $self->_recurse_fields (delete $hash{-select});
- $as = $self->_quote (delete $hash{-as});
- }
- else {
- my ($func, $args) = each %hash;
- delete $hash{$func};
+ my $as = delete $hash{-as}; # if supplied
- if (lc ($func) eq 'distinct' && ref $args eq 'ARRAY' && @$args > 1) {
- croak (
- 'The select => { distinct => ... } syntax is not supported for multiple columns.'
- .' Instead please use { group_by => [ qw/' . (join ' ', @$args) . '/ ] }'
- .' or { select => [ qw/' . (join ' ', @$args) . '/ ], distinct => 1 }'
- );
- }
- $select = sprintf ('%s( %s )',
- $self->_sqlcase($func),
- $self->_recurse_fields($args)
+ my ($func, $args) = each %hash;
+ delete $hash{$func};
+
+ if (lc ($func) eq 'distinct' && ref $args eq 'ARRAY' && @$args > 1) {
+ croak (
+ 'The select => { distinct => ... } syntax is not supported for multiple columns.'
+ .' Instead please use { group_by => [ qw/' . (join ' ', @$args) . '/ ] }'
+ .' or { select => [ qw/' . (join ' ', @$args) . '/ ], distinct => 1 }'
);
}
+ my $select = sprintf ('%s( %s )%s',
+ $self->_sqlcase($func),
+ $self->_recurse_fields($args),
+ $as
+ ? sprintf (' %s %s', $self->_sqlcase('as'), $as)
+ : ''
+ );
+
# there should be nothing left
if (keys %hash) {
croak "Malformed select argument - too many keys in hash: " . join (',', keys %$fields );
}
- $select .= " AS $as" if $as;
return $select;
}
# Is the second check absolutely necessary?
@@ -512,16 +508,22 @@
foreach my $j (@join) {
my ($to, $on) = @$j;
+
# check whether a join type exists
- my $join_clause = '';
my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
- if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
- $join_clause = ' '.uc($to_jt->{-join_type}).' JOIN ';
- } else {
- $join_clause = ' JOIN ';
+ my $join_type;
+ if (ref($to_jt) eq 'HASH' and defined($to_jt->{-join_type})) {
+ $join_type = $to_jt->{-join_type};
+ $join_type =~ s/^\s+ | \s+$//xg;
}
- push(@sqlf, $join_clause);
+ $join_type = $self->{_default_jointype} if not defined $join_type;
+
+ my $join_clause = sprintf ('%s JOIN ',
+ $join_type ? ' ' . uc($join_type) : ''
+ );
+ push @sqlf, $join_clause;
+
if (ref $to eq 'ARRAY') {
push(@sqlf, '(', $self->_recurse_from(@$to), ')');
} else {
@@ -584,6 +586,7 @@
sub _quote {
my ($self, $label) = @_;
return '' unless defined $label;
+ return $$label if ref($label) eq 'SCALAR';
return "*" if $label eq '*';
return $label unless $self->{quote_char};
if(ref $self->{quote_char} eq "ARRAY"){
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Schema/Versioned.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Schema/Versioned.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Schema/Versioned.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -520,10 +520,8 @@
return;
}
- eval 'require SQL::Translator "0.09003"';
- if ($@) {
- $self->throw_exception("SQL::Translator 0.09003 required");
- }
+ $self->throw_exception($self->_sqlt_version_error)
+ if (not $self->_sqlt_version_ok);
my $db_tr = SQL::Translator->new({
add_drop_table => 1,
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Schema.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Schema.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Schema.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -42,7 +42,7 @@
$dsn,
$user,
$password,
- { AutoCommit => 0 },
+ { AutoCommit => 1 },
);
my $schema2 = Library::Schema->connect($coderef_returning_dbh);
@@ -543,6 +543,8 @@
sub resultset {
my ($self, $moniker) = @_;
+ $self->throw_exception('resultset() expects a source name')
+ unless defined $moniker;
return $self->source($moniker)->resultset;
}
@@ -812,7 +814,7 @@
$storage_class = 'DBIx::Class::Storage'.$storage_class
if $storage_class =~ m/^::/;
- eval "require ${storage_class};";
+ eval { $self->ensure_class_loaded ($storage_class) };
$self->throw_exception(
"No arguments to load_classes and couldn't load ${storage_class} ($@)"
) if $@;
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Serialize/Storable.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Serialize/Storable.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Serialize/Storable.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -7,10 +7,13 @@
my ($self, $cloning) = @_;
my $to_serialize = { %$self };
+ # The source is either derived from _source_handle or is
+ # reattached in the thaw handler below
delete $to_serialize->{result_source};
- delete $to_serialize->{related_resultsets};
- delete $to_serialize->{_inflated_column};
+ # Dynamic values, easy to recalculate
+ delete $to_serialize->{$_} for qw/related_resultsets _inflated_column/;
+
return (Storable::freeze($to_serialize));
}
@@ -18,8 +21,10 @@
my ($self, $cloning, $serialized) = @_;
%$self = %{ Storable::thaw($serialized) };
+
+ # if the handle went missing somehow, reattach
$self->result_source($self->result_source_instance)
- if $self->can('result_source_instance');
+ if !$self->_source_handle && $self->can('result_source_instance');
}
1;
Added: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/AutoCast.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/AutoCast.pm (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/AutoCast.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,74 @@
+package DBIx::Class::Storage::DBI::AutoCast;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+
+__PACKAGE__->mk_group_accessors('simple' => 'auto_cast' );
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::AutoCast
+
+=head1 SYNOPSIS
+
+ $schema->storage->auto_cast(1);
+
+=head1 DESCRIPTION
+
+In some combinations of RDBMS and DBD drivers (e.g. FreeTDS and Sybase)
+statements with values bound to columns or conditions that are not strings will
+throw implicit type conversion errors.
+
+As long as a column L<data_type|DBIx::Class::ResultSource/add_columns> is
+defined, and it resolves to a base RDBMS native type via L</_native_data_type> as
+defined in your Storage driver, the placeholder for this column will be
+converted to:
+
+ CAST(? as $mapped_type)
+
+=cut
+
+sub _prep_for_execute {
+ my $self = shift;
+ my ($op, $extra_bind, $ident, $args) = @_;
+
+ my ($sql, $bind) = $self->next::method (@_);
+
+# If we're using ::NoBindVars, there are no binds by this point so this code
+# gets skippeed.
+ if ($self->auto_cast && @$bind) {
+ my $new_sql;
+ my @sql_part = split /\?/, $sql;
+ my $col_info = $self->_resolve_column_info($ident,[ map $_->[0], @$bind ]);
+
+ foreach my $bound (@$bind) {
+ my $col = $bound->[0];
+ my $type = $self->_native_data_type($col_info->{$col}{data_type});
+
+ foreach my $data (@{$bound}[1..$#$bound]) {
+ $new_sql .= shift(@sql_part) .
+ ($type ? "CAST(? AS $type)" : '?');
+ }
+ }
+ $new_sql .= join '', @sql_part;
+ $sql = $new_sql;
+ }
+
+ return ($sql, $bind);
+}
+
+
+=head1 AUTHORS
+
+See L<DBIx::Class/CONTRIBUTORS>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+1;
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/MSSQL.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/MSSQL.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/MSSQL.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -14,30 +14,55 @@
__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MSSQL');
+sub _set_identity_insert {
+ my ($self, $table) = @_;
+
+ my $sql = sprintf (
+ 'SET IDENTITY_INSERT %s ON',
+ $self->sql_maker->_quote ($table),
+ );
+
+ my $dbh = $self->_get_dbh;
+ eval { $dbh->do ($sql) };
+ if ($@) {
+ $self->throw_exception (sprintf "Error executing '%s': %s",
+ $sql,
+ $dbh->errstr,
+ );
+ }
+}
+
+sub _unset_identity_insert {
+ my ($self, $table) = @_;
+
+ my $sql = sprintf (
+ 'SET IDENTITY_INSERT %s OFF',
+ $self->sql_maker->_quote ($table),
+ );
+
+ my $dbh = $self->_get_dbh;
+ $dbh->do ($sql);
+}
+
sub insert_bulk {
my $self = shift;
my ($source, $cols, $data) = @_;
- my $identity_insert = 0;
+ my $is_identity_insert = (List::Util::first
+ { $source->column_info ($_)->{is_auto_increment} }
+ (@{$cols})
+ )
+ ? 1
+ : 0;
- COLUMNS:
- foreach my $col (@{$cols}) {
- if ($source->column_info($col)->{is_auto_increment}) {
- $identity_insert = 1;
- last COLUMNS;
- }
+ if ($is_identity_insert) {
+ $self->_set_identity_insert ($source->name);
}
- if ($identity_insert) {
- my $table = $source->from;
- $self->dbh->do("SET IDENTITY_INSERT $table ON");
- }
-
$self->next::method(@_);
- if ($identity_insert) {
- my $table = $source->from;
- $self->dbh->do("SET IDENTITY_INSERT $table OFF");
+ if ($is_identity_insert) {
+ $self->_unset_identity_insert ($source->name);
}
}
@@ -47,7 +72,7 @@
my $self = shift;
my ($source, $to_insert) = @_;
- my $updated_cols = {};
+ my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert] );
my %guid_cols;
my @pk_cols = $source->primary_columns;
@@ -55,10 +80,14 @@
@pk_cols{@pk_cols} = ();
my @pk_guids = grep {
+ $source->column_info($_)->{data_type}
+ &&
$source->column_info($_)->{data_type} =~ /^uniqueidentifier/i
} @pk_cols;
my @auto_guids = grep {
+ $source->column_info($_)->{data_type}
+ &&
$source->column_info($_)->{data_type} =~ /^uniqueidentifier/i
&&
$source->column_info($_)->{auto_nextval}
@@ -67,13 +96,28 @@
my @get_guids_for =
grep { not exists $to_insert->{$_} } (@pk_guids, @auto_guids);
+ my $updated_cols = {};
+
for my $guid_col (@get_guids_for) {
- my ($new_guid) = $self->dbh->selectrow_array('SELECT NEWID()');
+ my ($new_guid) = $self->_get_dbh->selectrow_array('SELECT NEWID()');
$updated_cols->{$guid_col} = $to_insert->{$guid_col} = $new_guid;
}
+ my $is_identity_insert = (List::Util::first { $_->{is_auto_increment} } (values %$supplied_col_info) )
+ ? 1
+ : 0;
+
+ if ($is_identity_insert) {
+ $self->_set_identity_insert ($source->name);
+ }
+
$updated_cols = { %$updated_cols, %{ $self->next::method(@_) } };
+ if ($is_identity_insert) {
+ $self->_unset_identity_insert ($source->name);
+ }
+
+
return $updated_cols;
}
@@ -87,7 +131,9 @@
for my $col (keys %$fields) {
# $ident is a result source object with INSERT/UPDATE ops
- if ($ident->column_info ($col)->{data_type} =~ /^money\z/i) {
+ if ($ident->column_info ($col)->{data_type}
+ &&
+ $ident->column_info ($col)->{data_type} =~ /^money\z/i) {
my $val = $fields->{$col};
$fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
}
@@ -99,14 +145,6 @@
if ($op eq 'insert') {
$sql .= ';SELECT SCOPE_IDENTITY()';
- my $col_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]);
- if (List::Util::first { $_->{is_auto_increment} } (values %$col_info) ) {
-
- my $table = $ident->from;
- my $identity_insert_on = "SET IDENTITY_INSERT $table ON";
- my $identity_insert_off = "SET IDENTITY_INSERT $table OFF";
- $sql = "$identity_insert_on; $sql; $identity_insert_off";
- }
}
return ($sql, $bind);
@@ -145,7 +183,7 @@
sub _svp_begin {
my ($self, $name) = @_;
- $self->dbh->do("SAVE TRANSACTION $name");
+ $self->_get_dbh->do("SAVE TRANSACTION $name");
}
# A new SAVE TRANSACTION with the same name releases the previous one.
@@ -154,7 +192,7 @@
sub _svp_rollback {
my ($self, $name) = @_;
- $self->dbh->do("ROLLBACK TRANSACTION $name");
+ $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
}
sub build_datetime_parser {
@@ -192,6 +230,8 @@
=head1 IMPLEMENTATION NOTES
+=head2 IDENTITY information
+
Microsoft SQL Server supports three methods of retrieving the IDENTITY
value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
SCOPE_IDENTITY is used here because it is the safest. However, it must
@@ -210,6 +250,16 @@
inserts into another table with an identity will give erroneous results on
recent versions of SQL Server.
+=head2 identity insert
+
+Be aware that we have tried to make things as simple as possible for our users.
+For MSSQL that means that when a user tries to create a row, while supplying an
+explicit value for an autoincrementing column, we will try to issue the
+appropriate database call to make this possible, namely C<SET IDENTITY_INSERT
+$table_name ON>. Unfortunately this operation in MSSQL requires the
+C<db_ddladmin> privilege, which is normally not included in the standard
+write-permissions.
+
=head1 AUTHOR
See L<DBIx::Class/CONTRIBUTORS>.
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -75,16 +75,15 @@
if (not exists $dbi_attrs->{odbc_cursortype}) {
# turn on support for multiple concurrent statements, unless overridden
$dbi_attrs->{odbc_cursortype} = 2;
- my $connected = defined $self->_dbh;
- $self->disconnect;
- $self->ensure_connected if $connected;
+ $self->disconnect; # resetting dbi attrs, so have to reconnect
+ $self->ensure_connected;
$self->_set_dynamic_cursors;
}
}
sub _set_dynamic_cursors {
my $self = shift;
- my $dbh = $self->_dbh;
+ my $dbh = $self->_get_dbh;
eval {
local $dbh->{RaiseError} = 1;
@@ -137,7 +136,7 @@
my $self = shift;
my $sql_rowset_size = shift || 2;
- $self->_dbh->{odbc_SQL_ROWSET_SIZE} = $sql_rowset_size;
+ $self->_get_dbh->{odbc_SQL_ROWSET_SIZE} = $sql_rowset_size;
}
=head2 connect_call_use_MARS
@@ -165,9 +164,9 @@
if ($dsn !~ /MARS_Connection=/) {
$self->_dbi_connect_info->[0] = "$dsn;MARS_Connection=Yes";
- my $connected = defined $self->_dbh;
+ my $was_connected = defined $self->_dbh;
$self->disconnect;
- $self->ensure_connected if $connected;
+ $self->ensure_connected if $was_connected;
}
}
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/ODBC.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/ODBC.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/ODBC.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -8,7 +8,8 @@
sub _rebless {
my ($self) = @_;
- my $dbtype = eval { $self->dbh->get_info(17) };
+ my $dbtype = eval { $self->_get_dbh->get_info(17) };
+
unless ( $@ ) {
# Translate the backend name into a perl identifier
$dbtype =~ s/\W/_/gi;
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -76,7 +76,7 @@
sub _sequence_fetch {
my ( $self, $type, $seq ) = @_;
- my ($id) = $self->dbh->selectrow_array("SELECT ${seq}.${type} FROM DUAL");
+ my ($id) = $self->_get_dbh->selectrow_array("SELECT ${seq}.${type} FROM DUAL");
return $id;
}
@@ -209,7 +209,7 @@
sub _svp_begin {
my ($self, $name) = @_;
- $self->dbh->do("SAVEPOINT $name");
+ $self->_get_dbh->do("SAVEPOINT $name");
}
=head2 source_bind_attributes
@@ -263,7 +263,7 @@
sub _svp_rollback {
my ($self, $name) = @_;
- $self->dbh->do("ROLLBACK TO SAVEPOINT $name")
+ $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
}
=head1 AUTHOR
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Oracle.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Oracle.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Oracle.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -9,7 +9,7 @@
sub _rebless {
my ($self) = @_;
- my $version = eval { $self->dbh->get_info(18); };
+ my $version = eval { $self->_get_dbh->get_info(18); };
if ( !$@ ) {
my ($major, $minor, $patchlevel) = split(/\./, $version);
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Pg.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Pg.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Pg.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -15,49 +15,124 @@
sub with_deferred_fk_checks {
my ($self, $sub) = @_;
- $self->dbh->do('SET CONSTRAINTS ALL DEFERRED');
+ $self->_get_dbh->do('SET CONSTRAINTS ALL DEFERRED');
$sub->();
}
+sub last_insert_id {
+ my ($self,$source, at cols) = @_;
+
+ my @values;
+
+ for my $col (@cols) {
+ my $seq = ( $source->column_info($col)->{sequence} ||= $self->dbh_do('_dbh_get_autoinc_seq', $source, $col) )
+ or $self->throw_exception( "could not determine sequence for "
+ . $source->name
+ . ".$col, please consider adding a "
+ . "schema-qualified sequence to its column info"
+ );
+
+ push @values, $self->_dbh_last_insert_id ($self->_dbh, $seq);
+ }
+
+ return @values;
+}
+
+# there seems to be absolutely no reason to have this as a separate method,
+# but leaving intact in case someone is already overriding it
sub _dbh_last_insert_id {
my ($self, $dbh, $seq) = @_;
$dbh->last_insert_id(undef, undef, undef, undef, {sequence => $seq});
}
-sub last_insert_id {
- my ($self,$source,$col) = @_;
- my $seq = ($source->column_info($col)->{sequence} ||= $self->get_autoinc_seq($source,$col));
- $self->throw_exception("could not fetch primary key for " . $source->name . ", could not "
- . "get autoinc sequence for $col (check that table and column specifications are correct "
- . "and in the correct case)") unless defined $seq;
- $self->dbh_do('_dbh_last_insert_id', $seq);
-}
sub _dbh_get_autoinc_seq {
- my ($self, $dbh, $schema, $table, @pri) = @_;
+ my ($self, $dbh, $source, $col) = @_;
- while (my $col = shift @pri) {
- my $info = $dbh->column_info(undef,$schema,$table,$col)->fetchrow_hashref;
- if(defined $info->{COLUMN_DEF} and
- $info->{COLUMN_DEF} =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/) {
- my $seq = $1;
- # may need to strip quotes -- see if this works
- return $seq =~ /\./ ? $seq : $info->{TABLE_SCHEM} . "." . $seq;
- }
+ my $schema;
+ my $table = $source->name;
+
+ # deref table name if it needs it
+ $table = $$table
+ if ref $table eq 'SCALAR';
+
+ # parse out schema name if present
+ if( $table =~ /^(.+)\.(.+)$/ ) {
+ ( $schema, $table ) = ( $1, $2 );
}
- return;
+
+ # use DBD::Pg to fetch the column info if it is recent enough to
+ # work. otherwise, use custom SQL
+ my $seq_expr = $DBD::Pg::VERSION >= 2.015001
+ ? eval{ $dbh->column_info(undef,$schema,$table,$col)->fetchrow_hashref->{COLUMN_DEF} }
+ : $self->_dbh_get_column_default( $dbh, $schema, $table, $col );
+
+ # if no default value is set on the column, or if we can't parse the
+ # default value as a sequence, throw.
+ unless ( defined $seq_expr and $seq_expr =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i ){
+ $seq_expr = '' unless defined $seq_expr;
+ $schema = "$schema." if defined $schema && length $schema;
+ $self->throw_exception( "no sequence found for $schema$table.$col, check table definition, "
+ . "or explicitly set the 'sequence' for this column in the "
+ . $source->source_name
+ . " class"
+ );
+ }
+
+ return $1;
}
-sub get_autoinc_seq {
- my ($self,$source,$col) = @_;
+# custom method for fetching column default, since column_info has a
+# bug with older versions of DBD::Pg
+sub _dbh_get_column_default {
+ my ( $self, $dbh, $schema, $table, $col ) = @_;
- my @pri = $source->primary_columns;
- my ($schema,$table) = $source->name =~ /^(.+)\.(.+)$/ ? ($1,$2)
- : (undef,$source->name);
+ # Build and execute a query into the pg_catalog to find the Pg
+ # expression for the default value for this column in this table.
+ # If the table name is schema-qualified, query using that specific
+ # schema name.
- $self->dbh_do('_dbh_get_autoinc_seq', $schema, $table, @pri);
+ # Otherwise, find the table in the standard Postgres way, using the
+ # search path. This is done with the pg_catalog.pg_table_is_visible
+ # function, which returns true if a given table is 'visible',
+ # meaning the first table of that name to be found in the search
+ # path.
+
+ # I *think* we can be assured that this query will always find the
+ # correct column according to standard Postgres semantics.
+ #
+ # -- rbuels
+
+ my $sqlmaker = $self->sql_maker;
+ local $sqlmaker->{bindtype} = 'normal';
+
+ my ($where, @bind) = $sqlmaker->where ({
+ 'a.attnum' => {'>', 0},
+ 'c.relname' => $table,
+ 'a.attname' => $col,
+ -not_bool => 'a.attisdropped',
+ (defined $schema && length $schema)
+ ? ( 'n.nspname' => $schema )
+ : ( -bool => \'pg_catalog.pg_table_is_visible(c.oid)' )
+ });
+
+ my ($seq_expr) = $dbh->selectrow_array(<<EOS,undef, at bind);
+
+SELECT
+ (SELECT pg_catalog.pg_get_expr(d.adbin, d.adrelid)
+ FROM pg_catalog.pg_attrdef d
+ WHERE d.adrelid = a.attrelid AND d.adnum = a.attnum AND a.atthasdef)
+FROM pg_catalog.pg_class c
+ LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace
+ JOIN pg_catalog.pg_attribute a ON a.attrelid = c.oid
+$where
+
+EOS
+
+ return $seq_expr;
}
+
sub sqlt_type {
return 'PostgreSQL';
}
@@ -82,30 +157,32 @@
sub _sequence_fetch {
my ( $self, $type, $seq ) = @_;
- my ($id) = $self->dbh->selectrow_array("SELECT nextval('${seq}')");
+ my ($id) = $self->_get_dbh->selectrow_array("SELECT nextval('${seq}')");
return $id;
}
sub _svp_begin {
my ($self, $name) = @_;
- $self->dbh->pg_savepoint($name);
+ $self->_get_dbh->pg_savepoint($name);
}
sub _svp_release {
my ($self, $name) = @_;
- $self->dbh->pg_release($name);
+ $self->_get_dbh->pg_release($name);
}
sub _svp_rollback {
my ($self, $name) = @_;
- $self->dbh->pg_rollback_to($name);
+ $self->_get_dbh->pg_rollback_to($name);
}
1;
+__END__
+
=head1 NAME
DBIx::Class::Storage::DBI::Pg - Automatic primary key class for PostgreSQL
@@ -121,9 +198,30 @@
This class implements autoincrements for PostgreSQL.
+=head1 POSTGRESQL SCHEMA SUPPORT
+
+This driver supports multiple PostgreSQL schemas, with one caveat: for
+performance reasons, data about the search path, sequence names, and
+so forth is queried as needed and CACHED for subsequent uses.
+
+For this reason, once your schema is instantiated, you should not
+change the PostgreSQL schema search path for that schema's database
+connection. If you do, Bad Things may happen.
+
+You should do any necessary manipulation of the search path BEFORE
+instantiating your schema object, or as part of the on_connect_do
+option to connect(), for example:
+
+ my $schema = My::Schema->connect
+ ( $dsn,$user,$pass,
+ { on_connect_do =>
+ [ 'SET search_path TO myschema, foo, public' ],
+ },
+ );
+
=head1 AUTHORS
-Marcus Ramberg <m.ramberg at cpan.org>
+See L<DBIx::Class/CONTRIBUTORS>
=head1 LICENSE
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -5,6 +5,7 @@
use DBIx::Class::Storage::DBI::Replicated::Replicant;
use List::Util 'sum';
use Scalar::Util 'reftype';
+use DBI ();
use Carp::Clan qw/^DBIx::Class/;
use MooseX::Types::Moose qw/Num Int ClassName HashRef/;
@@ -137,6 +138,16 @@
},
);
+has next_unknown_replicant_id => (
+ is => 'rw',
+ metaclass => 'Counter',
+ isa => Int,
+ default => 1,
+ provides => {
+ inc => 'inc_unknown_replicant_id'
+ },
+);
+
=head1 METHODS
This class defines the following methods.
@@ -158,16 +169,45 @@
$connect_info = [ $connect_info ]
if reftype $connect_info ne 'ARRAY';
- croak "coderef replicant connect_info not supported"
- if ref $connect_info->[0] && reftype $connect_info->[0] eq 'CODE';
+ my $connect_coderef =
+ (reftype($connect_info->[0])||'') eq 'CODE' ? $connect_info->[0]
+ : (reftype($connect_info->[0])||'') eq 'HASH' &&
+ $connect_info->[0]->{dbh_maker};
- my $replicant = $self->connect_replicant($schema, $connect_info);
+ my $dsn;
+ my $replicant = do {
+# yes this is evil, but it only usually happens once (for coderefs)
+# this will fail if the coderef does not actually DBI::connect
+ no warnings 'redefine';
+ my $connect = \&DBI::connect;
+ local *DBI::connect = sub {
+ $dsn = $_[1];
+ goto $connect;
+ };
+ $self->connect_replicant($schema, $connect_info);
+ };
- my $key = $connect_info->[0];
- $key = $key->{dsn} if ref $key && reftype $key eq 'HASH';
- ($key) = ($key =~ m/^dbi\:.+\:(.+)$/);
+ my $key;
- $self->set_replicant( $key => $replicant);
+ if (!$dsn) {
+ if (!$connect_coderef) {
+ $dsn = $connect_info->[0];
+ $dsn = $dsn->{dsn} if (reftype($dsn)||'') eq 'HASH';
+ }
+ else {
+ # all attempts to get the DSN failed
+ $key = "UNKNOWN_" . $self->next_unknown_replicant_id;
+ $self->inc_unknown_replicant_id;
+ }
+ }
+ if ($dsn) {
+ $replicant->dsn($dsn);
+ ($key) = ($dsn =~ m/^dbi\:.+\:(.+)$/i);
+ }
+
+ $replicant->id($key);
+ $self->set_replicant($key => $replicant);
+
push @newly_created, $replicant;
}
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -3,7 +3,7 @@
use Moose::Role;
requires qw/_query_start/;
with 'DBIx::Class::Storage::DBI::Replicated::WithDSN';
-use MooseX::Types::Moose 'Bool';
+use MooseX::Types::Moose qw/Bool Str/;
use namespace::clean -except => 'meta';
@@ -52,6 +52,9 @@
default=>1,
);
+has dsn => (is => 'rw', isa => Str);
+has id => (is => 'rw', isa => Str);
+
=head1 METHODS
This class defines the following methods.
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,6 +1,7 @@
package DBIx::Class::Storage::DBI::Replicated::WithDSN;
use Moose::Role;
+use Scalar::Util 'reftype';
requires qw/_query_start/;
use namespace::clean -except => 'meta';
@@ -30,11 +31,25 @@
around '_query_start' => sub {
my ($method, $self, $sql, @bind) = @_;
- my $dsn = $self->_dbi_connect_info->[0];
+
+ my $dsn = eval { $self->dsn } || $self->_dbi_connect_info->[0];
+
my($op, $rest) = (($sql=~m/^(\w+)(.+)$/),'NOP', 'NO SQL');
my $storage_type = $self->can('active') ? 'REPLICANT' : 'MASTER';
- $self->$method("$op [DSN_$storage_type=$dsn]$rest", @bind);
+ my $query = do {
+ if ((reftype($dsn)||'') ne 'CODE') {
+ "$op [DSN_$storage_type=$dsn]$rest";
+ }
+ elsif (my $id = eval { $self->id }) {
+ "$op [$storage_type=$id]$rest";
+ }
+ else {
+ "$op [$storage_type]$rest";
+ }
+ };
+
+ $self->$method($query, @bind);
};
=head1 ALSO SEE
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Replicated.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -518,8 +518,15 @@
# delete them
splice @$r, $i+1, ($#{$r} - $i), ();
+# make sure master/replicants opts don't clash
+ my %master_opts = %{ $self->_master_connect_info_opts };
+ if (exists $opts{dbh_maker}) {
+ delete @master_opts{qw/dsn user password/};
+ }
+ delete $master_opts{dbh_maker};
+
# merge with master
- %opts = %{ merge(\%opts, $self->_master_connect_info_opts) };
+ %opts = %{ merge(\%opts, \%master_opts) };
# update
$r->[$i] = \%opts;
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -29,7 +29,7 @@
sub _placeholders_supported {
my $self = shift;
- my $dbh = $self->_dbh;
+ my $dbh = $self->_get_dbh;
return eval {
# There's also $dbh->{syb_dynamic_supported} but it can be inaccurate for this
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -11,7 +11,7 @@
sub _rebless {
my $self = shift;
- my $dbh = $self->_dbh;
+ my $dbh = $self->_get_dbh;
if (not $self->_placeholders_supported) {
bless $self,
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Sybase.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -12,7 +12,11 @@
sub _rebless {
my $self = shift;
- my $dbtype = eval { @{$self->dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2] };
+ my $dbtype = eval {
+ @{$self->_get_dbh
+ ->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})
+ }[2]
+ };
unless ( $@ ) {
$dbtype =~ s/\W/_/gi;
my $subclass = "DBIx::Class::Storage::DBI::Sybase::${dbtype}";
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/mysql.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/mysql.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI/mysql.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -33,6 +33,21 @@
$dbh->{mysql_insertid};
}
+# we need to figure out what mysql version we're running
+sub sql_maker {
+ my $self = shift;
+
+ unless ($self->_sql_maker) {
+ my $maker = $self->next::method (@_);
+
+ # mysql 3 does not understand a bare JOIN
+ my $mysql_ver = $self->_get_dbh->get_info(18);
+ $maker->{_default_jointype} = 'INNER' if $mysql_ver =~ /^3/;
+ }
+
+ return $self->_sql_maker;
+}
+
sub sqlt_type {
return 'MySQL';
}
@@ -40,28 +55,28 @@
sub _svp_begin {
my ($self, $name) = @_;
- $self->dbh->do("SAVEPOINT $name");
+ $self->_get_dbh->do("SAVEPOINT $name");
}
sub _svp_release {
my ($self, $name) = @_;
- $self->dbh->do("RELEASE SAVEPOINT $name");
+ $self->_get_dbh->do("RELEASE SAVEPOINT $name");
}
sub _svp_rollback {
my ($self, $name) = @_;
- $self->dbh->do("ROLLBACK TO SAVEPOINT $name")
+ $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
}
sub is_replicating {
- my $status = shift->dbh->selectrow_hashref('show slave status');
+ my $status = shift->_get_dbh->selectrow_hashref('show slave status');
return ($status->{Slave_IO_Running} eq 'Yes') && ($status->{Slave_SQL_Running} eq 'Yes');
}
sub lag_behind_master {
- return shift->dbh->selectrow_hashref('show slave status')->{Seconds_Behind_Master};
+ return shift->_get_dbh->selectrow_hashref('show slave status')->{Seconds_Behind_Master};
}
# MySql can not do subquery update/deletes, only way is slow per-row operations.
@@ -81,7 +96,7 @@
Storage::DBI autodetects the underlying MySQL database, and re-blesses the
C<$storage> object into this class.
- my $schema = MyDb::Schema->connect( $dsn, $user, $pass, { set_strict_mode => 1 } );
+ my $schema = MyDb::Schema->connect( $dsn, $user, $pass, { on_connect_call => 'set_strict_mode' } );
=head1 DESCRIPTION
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class/Storage/DBI.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -44,8 +44,15 @@
my $schema = MySchema->connect('dbi:SQLite:my.db');
$schema->storage->debug(1);
- $schema->dbh_do("DROP TABLE authors");
+ my @stuff = $schema->storage->dbh_do(
+ sub {
+ my ($storage, $dbh, @args) = @_;
+ $dbh->do("DROP TABLE authors");
+ },
+ @column_list
+ );
+
$schema->resultset('Book')->search({
written_on => $schema->storage->datetime_parser(DateTime->now)
});
@@ -112,6 +119,12 @@
%extra_attributes,
}];
+ $connect_info_args = [{
+ dbh_maker => sub { DBI->connect (...) },
+ %dbi_attributes,
+ %extra_attributes,
+ }];
+
This is particularly useful for L<Catalyst> based applications, allowing the
following config (L<Config::General> style):
@@ -125,6 +138,10 @@
</connect_info>
</Model::DB>
+The C<dsn>/C<user>/C<password> combination can be substituted by the
+C<dbh_maker> key whose value is a coderef that returns a connected
+L<DBI database handle|DBI/connect>
+
=back
Please note that the L<DBI> docs recommend that you always explicitly
@@ -337,6 +354,12 @@
# Connect via subref
->connect_info([ sub { DBI->connect(...) } ]);
+ # Connect via subref in hashref
+ ->connect_info([{
+ dbh_maker => sub { DBI->connect(...) },
+ on_connect_do => 'alter session ...',
+ }]);
+
# A bit more complicated
->connect_info(
[
@@ -407,9 +430,22 @@
elsif (ref $args[0] eq 'HASH') { # single hashref (i.e. Catalyst config)
%attrs = %{$args[0]};
@args = ();
- for (qw/password user dsn/) {
- unshift @args, delete $attrs{$_};
+ if (my $code = delete $attrs{dbh_maker}) {
+ @args = $code;
+
+ my @ignored = grep { delete $attrs{$_} } (qw/dsn user password/);
+ if (@ignored) {
+ carp sprintf (
+ 'Attribute(s) %s in connect_info were ignored, as they can not be applied '
+ . "to the result of 'dbh_maker'",
+
+ join (', ', map { "'$_'" } (@ignored) ),
+ );
+ }
}
+ else {
+ @args = delete @attrs{qw/dsn user password/};
+ }
}
else { # otherwise assume dsn/user/password + \%attrs + \%extra_attrs
%attrs = (
@@ -437,12 +473,28 @@
}
}
- %attrs = () if (ref $args[0] eq 'CODE'); # _connect() never looks past $args[0] in this case
+ if (ref $args[0] eq 'CODE') {
+ # _connect() never looks past $args[0] in this case
+ %attrs = ()
+ } else {
+ %attrs = (
+ %{ $self->_default_dbi_connect_attributes || {} },
+ %attrs,
+ );
+ }
$self->_dbi_connect_info([@args, keys %attrs ? \%attrs : ()]);
$self->_connect_info;
}
+sub _default_dbi_connect_attributes {
+ return {
+ AutoCommit => 1,
+ RaiseError => 1,
+ PrintError => 0,
+ };
+}
+
=head2 on_connect_do
This method is deprecated in favour of setting via L</connect_info>.
@@ -511,7 +563,7 @@
my $self = shift;
my $code = shift;
- my $dbh = $self->_dbh;
+ my $dbh = $self->_get_dbh;
return $self->$code($dbh, @_) if $self->{_in_dbh_do}
|| $self->{transaction_depth};
@@ -522,11 +574,6 @@
my $want_array = wantarray;
eval {
- $self->_verify_pid if $dbh;
- if(!$self->_dbh) {
- $self->_populate_dbh;
- $dbh = $self->_dbh;
- }
if($want_array) {
@result = $self->$code($dbh, @_);
@@ -539,6 +586,7 @@
}
};
+ # ->connected might unset $@ - copy
my $exception = $@;
if(!$exception) { return $want_array ? @result : $result[0] }
@@ -546,6 +594,8 @@
# We were not connected - reconnect and retry, but let any
# exception fall right through this time
+ carp "Retrying $code after catching disconnected exception: $exception"
+ if $ENV{DBIC_DBIRETRY_DEBUG};
$self->_populate_dbh;
$self->$code($self->_dbh, @_);
}
@@ -570,8 +620,7 @@
my $tried = 0;
while(1) {
eval {
- $self->_verify_pid if $self->_dbh;
- $self->_populate_dbh if !$self->_dbh;
+ $self->_get_dbh;
$self->txn_begin;
if($want_array) {
@@ -586,10 +635,11 @@
$self->txn_commit;
};
+ # ->connected might unset $@ - copy
my $exception = $@;
if(!$exception) { return $want_array ? @result : $result[0] }
- if($tried++ > 0 || $self->connected) {
+ if($tried++ || $self->connected) {
eval { $self->txn_rollback };
my $rollback_exception = $@;
if($rollback_exception) {
@@ -607,6 +657,8 @@
# We were not connected, and was first try - reconnect and retry
# via the while loop
+ carp "Retrying $coderef after catching disconnected exception: $exception"
+ if $ENV{DBIC_DBIRETRY_DEBUG};
$self->_populate_dbh;
}
}
@@ -621,7 +673,7 @@
sub disconnect {
my ($self) = @_;
- if( $self->connected ) {
+ if( $self->_dbh ) {
my @actions;
push @actions, ( $self->on_disconnect_call || () );
@@ -658,23 +710,49 @@
$sub->();
}
+=head2 connected
+
+=over
+
+=item Arguments: none
+
+=item Return Value: 1|0
+
+=back
+
+Verifies that the the current database handle is active and ready to execute
+an SQL statement (i.e. the connection did not get stale, server is still
+answering, etc.) This method is used internally by L</dbh>.
+
+=cut
+
sub connected {
- my ($self) = @_;
+ my $self = shift;
+ return 0 unless $self->_seems_connected;
- if(my $dbh = $self->_dbh) {
- if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
- $self->_dbh(undef);
- $self->{_dbh_gen}++;
- return;
- }
- else {
- $self->_verify_pid;
- return 0 if !$self->_dbh;
- }
- return ($dbh->FETCH('Active') && $self->_ping);
+ #be on the safe side
+ local $self->_dbh->{RaiseError} = 1;
+
+ return $self->_ping;
+}
+
+sub _seems_connected {
+ my $self = shift;
+
+ my $dbh = $self->_dbh
+ or return 0;
+
+ if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
+ $self->_dbh(undef);
+ $self->{_dbh_gen}++;
+ return 0;
}
+ else {
+ $self->_verify_pid;
+ return 0 if !$self->_dbh;
+ }
- return 0;
+ return $dbh->FETCH('Active');
}
sub _ping {
@@ -709,21 +787,42 @@
=head2 dbh
-Returns the dbh - a data base handle of class L<DBI>.
+Returns a C<$dbh> - a data base handle of class L<DBI>. The returned handle
+is guaranteed to be healthy by implicitly calling L</connected>, and if
+necessary performing a reconnection before returning. Keep in mind that this
+is very B<expensive> on some database engines. Consider using L<dbh_do>
+instead.
=cut
sub dbh {
my ($self) = @_;
- $self->ensure_connected;
+ if (not $self->_dbh) {
+ $self->_populate_dbh;
+ } else {
+ $self->ensure_connected;
+ }
return $self->_dbh;
}
+# this is the internal "get dbh or connect (don't check)" method
+sub _get_dbh {
+ my $self = shift;
+ $self->_verify_pid if $self->_dbh;
+ $self->_populate_dbh unless $self->_dbh;
+ return $self->_dbh;
+}
+
sub _sql_maker_args {
my ($self) = @_;
- return ( bindtype=>'columns', array_datatypes => 1, limit_dialect => $self->dbh, %{$self->_sql_maker_opts} );
+ return (
+ bindtype=>'columns',
+ array_datatypes => 1,
+ limit_dialect => $self->_get_dbh,
+ %{$self->_sql_maker_opts}
+ );
}
sub sql_maker {
@@ -740,7 +839,9 @@
sub _populate_dbh {
my ($self) = @_;
+
my @info = @{$self->_dbi_connect_info || []};
+ $self->_dbh(undef); # in case ->connected failed we might get sent here
$self->_dbh($self->_connect(@info));
$self->_conn_pid($$);
@@ -752,6 +853,11 @@
# there is no transaction in progress by definition
$self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
+ $self->_run_connection_actions unless $self->{_in_determine_driver};
+}
+
+sub _run_connection_actions {
+ my $self = shift;
my @actions;
push @actions, ( $self->on_connect_call || () );
@@ -763,16 +869,27 @@
sub _determine_driver {
my ($self) = @_;
- if (not $self->_driver_determined) {
+ if ((not $self->_driver_determined) && (not $self->{_in_determine_driver})) {
+ my $started_unconnected = 0;
+ local $self->{_in_determine_driver} = 1;
+
if (ref($self) eq __PACKAGE__) {
my $driver;
-
if ($self->_dbh) { # we are connected
$driver = $self->_dbh->{Driver}{Name};
} else {
- # try to use dsn to not require being connected, the driver may still
- # force a connection in _rebless to determine version
- ($driver) = $self->_dbi_connect_info->[0] =~ /dbi:([^:]+):/i;
+ # if connect_info is a CODEREF, we have no choice but to connect
+ if (ref $self->_dbi_connect_info->[0] &&
+ Scalar::Util::reftype($self->_dbi_connect_info->[0]) eq 'CODE') {
+ $self->_populate_dbh;
+ $driver = $self->_dbh->{Driver}{Name};
+ }
+ else {
+ # try to use dsn to not require being connected, the driver may still
+ # force a connection in _rebless to determine version
+ ($driver) = $self->_dbi_connect_info->[0] =~ /dbi:([^:]+):/i;
+ $started_unconnected = 1;
+ }
}
my $storage_class = "DBIx::Class::Storage::DBI::${driver}";
@@ -784,6 +901,9 @@
}
$self->_driver_determined(1);
+
+ $self->_run_connection_actions
+ if $started_unconnected && defined $self->_dbh;
}
}
@@ -841,7 +961,7 @@
my @bind = map { [ undef, $_ ] } @do_args;
$self->_query_start($sql, @bind);
- $self->_dbh->do($sql, $attrs, @do_args);
+ $self->_get_dbh->do($sql, $attrs, @do_args);
$self->_query_end($sql, @bind);
}
@@ -983,14 +1103,17 @@
sub txn_begin {
my $self = shift;
- $self->ensure_connected();
if($self->{transaction_depth} == 0) {
$self->debugobj->txn_begin()
if $self->debug;
- # this isn't ->_dbh-> because
- # we should reconnect on begin_work
- # for AutoCommit users
- $self->dbh->begin_work;
+
+ # being here implies we have AutoCommit => 1
+ # if the user is utilizing txn_do - good for
+ # him, otherwise we need to ensure that the
+ # $dbh is healthy on BEGIN
+ my $dbh_method = $self->{_in_dbh_do} ? '_dbh' : 'dbh';
+ $self->$dbh_method->begin_work;
+
} elsif ($self->auto_savepoint) {
$self->svp_begin;
}
@@ -1140,7 +1263,7 @@
sub _execute {
my $self = shift;
- $self->dbh_do('_dbh_execute', @_)
+ $self->dbh_do('_dbh_execute', @_); # retry over disconnects
}
sub insert {
@@ -1162,7 +1285,11 @@
my $col_info = $source->column_info($col);
if ( $col_info->{auto_nextval} ) {
- $updated_cols->{$col} = $to_insert->{$col} = $self->_sequence_fetch( 'nextval', $col_info->{sequence} || $self->_dbh_get_autoinc_seq($self->dbh, $source) );
+ $updated_cols->{$col} = $to_insert->{$col} = $self->_sequence_fetch(
+ 'nextval',
+ $col_info->{sequence} ||
+ $self->_dbh_get_autoinc_seq($self->_get_dbh, $source)
+ );
}
}
}
@@ -1178,6 +1305,13 @@
## only prepped once.
sub insert_bulk {
my ($self, $source, $cols, $data) = @_;
+
+# redispatch to insert_bulk method of storage we reblessed into, if necessary
+ if (not $self->_driver_determined) {
+ $self->_determine_driver;
+ goto $self->can('insert_bulk');
+ }
+
my %colvalues;
my $table = $source->from;
@colvalues{@$cols} = (0..$#$cols);
@@ -1225,6 +1359,7 @@
local $Data::Dumper::Indent = 1;
local $Data::Dumper::Useqq = 1;
local $Data::Dumper::Quotekeys = 0;
+ local $Data::Dumper::Sortkeys = 1;
$self->throw_exception(sprintf "%s for populate slice:\n%s",
$tuple_status->[$i][1],
@@ -1242,6 +1377,7 @@
sub update {
my $self = shift @_;
my $source = shift @_;
+ $self->_determine_driver;
my $bind_attributes = $self->source_bind_attributes($source);
return $self->_execute('update' => [], $source, $bind_attributes, @_);
@@ -1251,7 +1387,7 @@
sub delete {
my $self = shift @_;
my $source = shift @_;
-
+ $self->_determine_driver;
my $bind_attrs = $self->source_bind_attributes($source);
return $self->_execute('delete' => [], $source, $bind_attrs, @_);
@@ -1486,179 +1622,224 @@
sub _adjust_select_args_for_complex_prefetch {
my ($self, $from, $select, $where, $attrs) = @_;
+ $self->throw_exception ('Nothing to prefetch... how did we get here?!')
+ if not @{$attrs->{_prefetch_select}};
+
$self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute')
- if (ref $from ne 'ARRAY');
+ if (ref $from ne 'ARRAY' || ref $from->[0] ne 'HASH' || ref $from->[1] ne 'ARRAY');
- # copies for mangling
- $from = [ @$from ];
- $select = [ @$select ];
- $attrs = { %$attrs };
- # separate attributes
- my $sub_attrs = { %$attrs };
- delete $attrs->{$_} for qw/where bind rows offset group_by having/;
- delete $sub_attrs->{$_} for qw/for collapse _prefetch_select _collapse_order_by select as/;
+ # generate inner/outer attribute lists, remove stuff that doesn't apply
+ my $outer_attrs = { %$attrs };
+ delete $outer_attrs->{$_} for qw/where bind rows offset group_by having/;
- my $select_root_alias = $attrs->{alias};
- my $sql_maker = $self->sql_maker;
+ my $inner_attrs = { %$attrs };
+ delete $inner_attrs->{$_} for qw/for collapse _prefetch_select _collapse_order_by select as/;
- # create subquery select list - consider only stuff *not* brought in by the prefetch
- my $sub_select = [];
- my $sub_group_by;
- for my $i (0 .. @{$attrs->{select}} - @{$attrs->{_prefetch_select}} - 1) {
- my $sel = $attrs->{select}[$i];
- # alias any functions to the dbic-side 'as' label
- # adjust the outer select accordingly
- if (ref $sel eq 'HASH' && !$sel->{-select}) {
- $sel = { -select => $sel, -as => $attrs->{as}[$i] };
- $select->[$i] = join ('.', $attrs->{alias}, ($attrs->{as}[$i] || "select_$i") );
- }
-
- push @$sub_select, $sel;
- }
-
# bring over all non-collapse-induced order_by into the inner query (if any)
# the outer one will have to keep them all
- delete $sub_attrs->{order_by};
- if (my $ord_cnt = @{$attrs->{order_by}} - @{$attrs->{_collapse_order_by}} ) {
- $sub_attrs->{order_by} = [
- @{$attrs->{order_by}}[ 0 .. $ord_cnt - 1]
+ delete $inner_attrs->{order_by};
+ if (my $ord_cnt = @{$outer_attrs->{order_by}} - @{$outer_attrs->{_collapse_order_by}} ) {
+ $inner_attrs->{order_by} = [
+ @{$outer_attrs->{order_by}}[ 0 .. $ord_cnt - 1]
];
}
- # mangle {from}, keep in mind that $from is "headless" from here on
- my $join_root = shift @$from;
- my %inner_joins;
- my %join_info = map { $_->[0]{-alias} => $_->[0] } (@$from);
+ # generate the inner/outer select lists
+ # for inside we consider only stuff *not* brought in by the prefetch
+ # on the outside we substitute any function for its alias
+ my $outer_select = [ @$select ];
+ my $inner_select = [];
+ for my $i (0 .. ( @$outer_select - @{$outer_attrs->{_prefetch_select}} - 1) ) {
+ my $sel = $outer_select->[$i];
- # in complex search_related chains $select_root_alias may *not* be
- # 'me' so always include it in the inner join
- $inner_joins{$select_root_alias} = 1 if ($join_root->{-alias} ne $select_root_alias);
+ if (ref $sel eq 'HASH' ) {
+ $sel->{-as} ||= $attrs->{as}[$i];
+ $outer_select->[$i] = join ('.', $attrs->{alias}, ($sel->{-as} || "inner_column_$i") );
+ }
+ push @$inner_select, $sel;
+ }
- # decide which parts of the join will remain on the inside
+ # normalize a copy of $from, so it will be easier to work with further
+ # down (i.e. promote the initial hashref to an AoH)
+ $from = [ @$from ];
+ $from->[0] = [ $from->[0] ];
+ my %original_join_info = map { $_->[0]{-alias} => $_->[0] } (@$from);
+
+
+ # decide which parts of the join will remain in either part of
+ # the outer/inner query
+
+ # First we compose a list of which aliases are used in restrictions
+ # (i.e. conditions/order/grouping/etc). Since we do not have
+ # introspectable SQLA, we fall back to ugly scanning of raw SQL for
+ # WHERE, and for pieces of ORDER BY in order to determine which aliases
+ # need to appear in the resulting sql.
+ # It may not be very efficient, but it's a reasonable stop-gap
+ # Also unqualified column names will not be considered, but more often
+ # than not this is actually ok
#
- # this is not a very viable optimisation, but it was written
- # before I realised this, so might as well remain. We can throw
- # away _any_ branches of the join tree that are:
- # 1) not mentioned in the condition/order
- # 2) left-join leaves (or left-join leaf chains)
- # Most of the join conditions will not satisfy this, but for real
- # complex queries some might, and we might make some RDBMS happy.
- #
- #
- # since we do not have introspectable SQLA, we fall back to ugly
- # scanning of raw SQL for WHERE, and for pieces of ORDER BY
- # in order to determine what goes into %inner_joins
- # It may not be very efficient, but it's a reasonable stop-gap
+ # In the same loop we enumerate part of the selection aliases, as
+ # it requires the same sqla hack for the time being
+ my ($restrict_aliases, $select_aliases, $prefetch_aliases);
{
# produce stuff unquoted, so it can be scanned
+ my $sql_maker = $self->sql_maker;
local $sql_maker->{quote_char};
my $sep = $self->_sql_maker_opts->{name_sep} || '.';
$sep = "\Q$sep\E";
- my @order_by = (map
+ my $non_prefetch_select_sql = $sql_maker->_recurse_fields ($inner_select);
+ my $prefetch_select_sql = $sql_maker->_recurse_fields ($outer_attrs->{_prefetch_select});
+ my $where_sql = $sql_maker->where ($where);
+ my $group_by_sql = $sql_maker->_order_by({
+ map { $_ => $inner_attrs->{$_} } qw/group_by having/
+ });
+ my @non_prefetch_order_by_chunks = (map
{ ref $_ ? $_->[0] : $_ }
- $sql_maker->_order_by_chunks ($sub_attrs->{order_by})
+ $sql_maker->_order_by_chunks ($inner_attrs->{order_by})
);
- my $where_sql = $sql_maker->where ($where);
- my $select_sql = $sql_maker->_recurse_fields ($sub_select);
- # sort needed joins
- for my $alias (keys %join_info) {
+ for my $alias (keys %original_join_info) {
+ my $seen_re = qr/\b $alias $sep/x;
- # any table alias found on a column name in where or order_by
- # gets included in %inner_joins
- # Also any parent joins that are needed to reach this particular alias
- for my $piece ($select_sql, $where_sql, @order_by ) {
- if ($piece =~ /\b $alias $sep/x) {
- $inner_joins{$alias} = 1;
+ for my $piece ($where_sql, $group_by_sql, @non_prefetch_order_by_chunks ) {
+ if ($piece =~ $seen_re) {
+ $restrict_aliases->{$alias} = 1;
}
}
+
+ if ($non_prefetch_select_sql =~ $seen_re) {
+ $select_aliases->{$alias} = 1;
+ }
+
+ if ($prefetch_select_sql =~ $seen_re) {
+ $prefetch_aliases->{$alias} = 1;
+ }
+
}
}
- # scan for non-leaf/non-left joins and mark as needed
- # also mark all ancestor joins that are needed to reach this particular alias
- # (e.g. join => { cds => 'tracks' } - tracks will bring cds too )
- #
- # traverse by the size of the -join_path i.e. reverse depth first
- for my $alias (sort { @{$join_info{$b}{-join_path}} <=> @{$join_info{$a}{-join_path}} } (keys %join_info) ) {
+ # Add any non-left joins to the restriction list (such joins are indeed restrictions)
+ for my $j (values %original_join_info) {
+ my $alias = $j->{-alias} or next;
+ $restrict_aliases->{$alias} = 1 if (
+ (not $j->{-join_type})
+ or
+ ($j->{-join_type} !~ /^left (?: \s+ outer)? $/xi)
+ );
+ }
- my $j = $join_info{$alias};
- $inner_joins{$alias} = 1 if (! $j->{-join_type} || ($j->{-join_type} !~ /^left$/i) );
-
- if ($inner_joins{$alias}) {
- $inner_joins{$_} = 1 for (@{$j->{-join_path}});
+ # mark all join parents as mentioned
+ # (e.g. join => { cds => 'tracks' } - tracks will need to bring cds too )
+ for my $collection ($restrict_aliases, $select_aliases) {
+ for my $alias (keys %$collection) {
+ $collection->{$_} = 1
+ for (@{ $original_join_info{$alias}{-join_path} || [] });
}
}
# construct the inner $from for the subquery
- my $inner_from = [ $join_root ];
+ my %inner_joins = (map { %{$_ || {}} } ($restrict_aliases, $select_aliases) );
+ my @inner_from;
for my $j (@$from) {
- push @$inner_from, $j if $inner_joins{$j->[0]{-alias}};
+ push @inner_from, $j if $inner_joins{$j->[0]{-alias}};
}
# if a multi-type join was needed in the subquery ("multi" is indicated by
# presence in {collapse}) - add a group_by to simulate the collapse in the subq
- unless ($sub_attrs->{group_by}) {
+ unless ($inner_attrs->{group_by}) {
for my $alias (keys %inner_joins) {
# the dot comes from some weirdness in collapse
# remove after the rewrite
if ($attrs->{collapse}{".$alias"}) {
- $sub_attrs->{group_by} ||= $sub_select;
+ $inner_attrs->{group_by} ||= $inner_select;
last;
}
}
}
+ # demote the inner_from head
+ $inner_from[0] = $inner_from[0][0];
+
# generate the subquery
my $subq = $self->_select_args_to_query (
- $inner_from,
- $sub_select,
+ \@inner_from,
+ $inner_select,
$where,
- $sub_attrs
+ $inner_attrs,
);
+
my $subq_joinspec = {
- -alias => $select_root_alias,
- -source_handle => $join_root->{-source_handle},
- $select_root_alias => $subq,
+ -alias => $attrs->{alias},
+ -source_handle => $inner_from[0]{-source_handle},
+ $attrs->{alias} => $subq,
};
- # Generate a new from (really just replace the join slot with the subquery)
- # Before we would start the outer chain from the subquery itself (i.e.
- # SELECT ... FROM (SELECT ... ) alias JOIN ..., but this turned out to be
- # a bad idea for search_related, as the root of the chain was effectively
- # lost (i.e. $artist_rs->search_related ('cds'... ) would result in alias
- # of 'cds', which would prevent from doing things like order_by artist.*)
- # See t/prefetch/via_search_related.t for a better idea
+ # Generate the outer from - this is relatively easy (really just replace
+ # the join slot with the subquery), with a major caveat - we can not
+ # join anything that is non-selecting (not part of the prefetch), but at
+ # the same time is a multi-type relationship, as it will explode the result.
+ #
+ # There are two possibilities here
+ # - either the join is non-restricting, in which case we simply throw it away
+ # - it is part of the restrictions, in which case we need to collapse the outer
+ # result by tackling yet another group_by to the outside of the query
+
+ # so first generate the outer_from, up to the substitution point
my @outer_from;
- if ($join_root->{-alias} eq $select_root_alias) { # just swap the root part and we're done
- @outer_from = (
- $subq_joinspec,
- @$from,
- )
+ while (my $j = shift @$from) {
+ if ($j->[0]{-alias} eq $attrs->{alias}) { # time to swap
+ push @outer_from, [
+ $subq_joinspec,
+ @{$j}[1 .. $#$j],
+ ];
+ last; # we'll take care of what's left in $from below
+ }
+ else {
+ push @outer_from, $j;
+ }
}
- else { # this is trickier
- @outer_from = ($join_root);
- for my $j (@$from) {
- if ($j->[0]{-alias} eq $select_root_alias) {
- push @outer_from, [
- $subq_joinspec,
- @{$j}[1 .. $#$j],
- ];
- }
- else {
- push @outer_from, $j;
- }
+ # see what's left - throw away if not selecting/restricting
+ # also throw in a group_by if restricting to guard against
+ # cross-join explosions
+ #
+ while (my $j = shift @$from) {
+ my $alias = $j->[0]{-alias};
+
+ if ($select_aliases->{$alias} || $prefetch_aliases->{$alias}) {
+ push @outer_from, $j;
}
+ elsif ($restrict_aliases->{$alias}) {
+ push @outer_from, $j;
+
+ # FIXME - this should be obviated by SQLA2, as I'll be able to
+ # have restrict_inner and restrict_outer... or something to that
+ # effect... I think...
+
+ # FIXME2 - I can't find a clean way to determine if a particular join
+ # is a multi - instead I am just treating everything as a potential
+ # explosive join (ribasushi)
+ #
+ # if (my $handle = $j->[0]{-source_handle}) {
+ # my $rsrc = $handle->resolve;
+ # ... need to bail out of the following if this is not a multi,
+ # as it will be much easier on the db ...
+
+ $outer_attrs->{group_by} ||= $outer_select;
+ # }
+ }
}
+ # demote the outer_from head
+ $outer_from[0] = $outer_from[0][0];
+
# This is totally horrific - the $where ends up in both the inner and outer query
# Unfortunately not much can be done until SQLA2 introspection arrives, and even
# then if where conditions apply to the *right* side of the prefetch, you may have
@@ -1666,7 +1847,7 @@
# the outer select to exclude joins you didin't want in the first place
#
# OTOH it can be seen as a plus: <ash> (notes that this query would make a DBA cry ;)
- return (\@outer_from, $select, $where, $attrs);
+ return (\@outer_from, $outer_select, $where, $outer_attrs);
}
sub _resolve_ident_sources {
@@ -1851,7 +2032,7 @@
sub sth {
my ($self, $sql) = @_;
- $self->dbh_do('_dbh_sth', $sql);
+ $self->dbh_do('_dbh_sth', $sql); # retry over disconnects
}
sub _dbh_columns_info_for {
@@ -1913,7 +2094,7 @@
sub columns_info_for {
my ($self, $table) = @_;
- $self->dbh_do('_dbh_columns_info_for', $table);
+ $self->_dbh_columns_info_for ($self->_get_dbh, $table);
}
=head2 last_insert_id
@@ -1939,17 +2120,57 @@
sub last_insert_id {
my $self = shift;
- $self->dbh_do('_dbh_last_insert_id', @_);
+ $self->_dbh_last_insert_id ($self->_dbh, @_);
}
+=head2 _native_data_type
+
+=over 4
+
+=item Arguments: $type_name
+
+=back
+
+This API is B<EXPERIMENTAL>, will almost definitely change in the future, and
+currently only used by L<::AutoCast|DBIx::Class::Storage::DBI::AutoCast> and
+L<::Sybase|DBIx::Class::Storage::DBI::Sybase>.
+
+The default implementation returns C<undef>, implement in your Storage driver if
+you need this functionality.
+
+Should map types from other databases to the native RDBMS type, for example
+C<VARCHAR2> to C<VARCHAR>.
+
+Types with modifiers should map to the underlying data type. For example,
+C<INTEGER AUTO_INCREMENT> should become C<INTEGER>.
+
+Composite types should map to the container type, for example
+C<ENUM(foo,bar,baz)> becomes C<ENUM>.
+
+=cut
+
+sub _native_data_type {
+ #my ($self, $data_type) = @_;
+ return undef
+}
+
=head2 sqlt_type
Returns the database driver name.
=cut
-sub sqlt_type { shift->dbh->{Driver}->{Name} }
+sub sqlt_type {
+ my ($self) = @_;
+ if (not $self->_driver_determined) {
+ $self->_determine_driver;
+ goto $self->can ('sqlt_type');
+ }
+
+ $self->_get_dbh->{Driver}->{Name};
+}
+
=head2 bind_attribute_by_data_type
Given a datatype from column info, returns a database specific bind
@@ -2064,9 +2285,8 @@
%{$sqltargs || {}}
};
- $self->throw_exception(q{Can't create a ddl file without SQL::Translator 0.09003: '}
- . $self->_check_sqlt_message . q{'})
- if !$self->_check_sqlt_version;
+ $self->throw_exception("Can't create a ddl file without SQL::Translator: " . $self->_sqlt_version_error)
+ if !$self->_sqlt_version_ok;
my $sqlt = SQL::Translator->new( $sqltargs );
@@ -2194,8 +2414,6 @@
sub deployment_statements {
my ($self, $schema, $type, $version, $dir, $sqltargs) = @_;
- # Need to be connected to get the correct sqlt_type
- $self->ensure_connected() unless $type;
$type ||= $self->sqlt_type;
$version ||= $schema->schema_version || '1.x';
$dir ||= './';
@@ -2210,22 +2428,21 @@
return join('', @rows);
}
- $self->throw_exception(q{Can't deploy without SQL::Translator 0.09003: '}
- . $self->_check_sqlt_message . q{'})
- if !$self->_check_sqlt_version;
+ $self->throw_exception("Can't deploy without either SQL::Translator or a ddl_dir: " . $self->_sqlt_version_error )
+ if !$self->_sqlt_version_ok;
- require SQL::Translator::Parser::DBIx::Class;
- eval qq{use SQL::Translator::Producer::${type}};
- $self->throw_exception($@) if $@;
-
# sources needs to be a parser arg, but for simplicty allow at top level
# coming in
$sqltargs->{parser_args}{sources} = delete $sqltargs->{sources}
if exists $sqltargs->{sources};
- my $tr = SQL::Translator->new(%$sqltargs);
- SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema );
- return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
+ my $tr = SQL::Translator->new(
+ producer => "SQL::Translator::Producer::${type}",
+ %$sqltargs,
+ parser => 'SQL::Translator::Parser::DBIx::Class',
+ data => $schema,
+ );
+ return $tr->translate;
}
sub deploy {
@@ -2240,7 +2457,9 @@
return if $line =~ /^\s+$/; # skip whitespace only
$self->_query_start($line);
eval {
- $self->dbh->do($line); # shouldn't be using ->dbh ?
+ # do a dbh_do cycle here, as we need some error checking in
+ # place (even though we will ignore errors)
+ $self->dbh_do (sub { $_[1]->do($line) });
};
if ($@) {
carp qq{$@ (running "${line}")};
@@ -2269,7 +2488,6 @@
sub datetime_parser {
my $self = shift;
return $self->{datetime_parser} ||= do {
- $self->ensure_connected;
$self->build_datetime_parser(@_);
};
}
@@ -2290,29 +2508,18 @@
=cut
sub build_datetime_parser {
+ if (not $_[0]->_driver_determined) {
+ $_[0]->_determine_driver;
+ goto $_[0]->can('build_datetime_parser');
+ }
+
my $self = shift;
my $type = $self->datetime_parser_type(@_);
- eval "use ${type}";
- $self->throw_exception("Couldn't load ${type}: $@") if $@;
+ $self->ensure_class_loaded ($type);
return $type;
}
-{
- my $_check_sqlt_version; # private
- my $_check_sqlt_message; # private
- sub _check_sqlt_version {
- return $_check_sqlt_version if defined $_check_sqlt_version;
- eval 'use SQL::Translator "0.09003"';
- $_check_sqlt_message = $@ || '';
- $_check_sqlt_version = !$@;
- }
- sub _check_sqlt_message {
- _check_sqlt_version if !defined $_check_sqlt_message;
- $_check_sqlt_message;
- }
-}
-
=head2 is_replicating
A boolean that reports if a particular L<DBIx::Class::Storage::DBI> is set to
@@ -2340,8 +2547,15 @@
sub DESTROY {
my $self = shift;
- return if !$self->_dbh;
- $self->_verify_pid;
+
+ $self->_verify_pid if $self->_dbh;
+
+ # some databases need this to stop spewing warnings
+ if (my $dbh = $self->_dbh) {
+ local $@;
+ eval { $dbh->disconnect };
+ }
+
$self->_dbh(undef);
}
@@ -2353,7 +2567,7 @@
DBIx::Class can do some wonderful magic with handling exceptions,
disconnections, and transactions when you use C<< AutoCommit => 1 >>
-combined with C<txn_do> for transaction support.
+(the default) combined with C<txn_do> for transaction support.
If you set C<< AutoCommit => 0 >> in your connect info, then you are always
in an assumed transaction between commits, and you're telling us you'd
@@ -2365,7 +2579,6 @@
be with raw DBI.
-
=head1 AUTHORS
Matt S. Trout <mst at shadowcatsystems.co.uk>
Modified: DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/DBIx/Class.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -25,10 +25,14 @@
# i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports
# brain damage and presumably various other packaging systems too
-$VERSION = '0.08108';
+$VERSION = '0.08111';
$VERSION = eval $VERSION; # numify for warning-free dev releases
+# what version of sqlt do we require if deploy() without a ddl_dir is invoked
+# when changing also adjust $sqlt_recommends in Makefile.PL
+my $minimum_sqlt_version = '0.11002';
+
sub MODIFY_CODE_ATTRIBUTES {
my ($class,$code, at attrs) = @_;
$class->mk_classdata('__attr_cache' => {})
@@ -44,6 +48,34 @@
return $@ ? $cache : { %$cache, %$rest };
}
+# SQLT version handling
+{
+ my $_sqlt_version_ok; # private
+ my $_sqlt_version_error; # private
+
+ sub _sqlt_version_ok {
+ if (!defined $_sqlt_version_ok) {
+ eval "use SQL::Translator $minimum_sqlt_version";
+ if ($@) {
+ $_sqlt_version_ok = 0;
+ $_sqlt_version_error = $@;
+ }
+ else {
+ $_sqlt_version_ok = 1;
+ }
+ }
+ return $_sqlt_version_ok;
+ }
+
+ sub _sqlt_version_error {
+ shift->_sqlt_version_ok unless defined $_sqlt_version_ok;
+ return $_sqlt_version_error;
+ }
+
+ sub _sqlt_minimum_version { $minimum_sqlt_version };
+}
+
+
1;
=head1 NAME
@@ -312,6 +344,8 @@
rafl: Florian Ragwitz <rafl at debian.org>
+rbuels: Robert Buels <rmb32 at cornell.edu>
+
rdj: Ryan D Johnson <ryan at innerfence.com>
ribasushi: Peter Rabbitson <rabbit+dbic at rabbit.us>
@@ -328,6 +362,8 @@
solomon: Jared Johnson <jaredj at nmgi.com>
+spb: Stephen Bennett <stephen at freenode.net>
+
sszabo: Stephan Szabo <sszabo at bigpanda.com>
teejay : Aaron Trevena <teejay at cpan.org>
@@ -348,8 +384,14 @@
zamolxes: Bogdan Lucaciu <bogdan at wiz.ro>
+=head1 COPYRIGHT
+
+Copyright (c) 2005 - 2009 the DBIx::Class L</AUTHOR> and L</CONTRIBUTORS>
+as listed above.
+
=head1 LICENSE
-You may distribute this code under the same terms as Perl itself.
+This library is free software and may be distributed under the same terms
+as perl itself.
=cut
Modified: DBIx-Class/0.08/branches/extended_rels/lib/SQL/Translator/Parser/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/lib/SQL/Translator/Parser/DBIx/Class.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/lib/SQL/Translator/Parser/DBIx/Class.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -82,8 +82,9 @@
my $source = $dbicschema->source($moniker);
my $table_name = $source->name;
- # Skip custom query sources
- next if ref $table_name;
+ # FIXME - this isn't the right way to do it, but sqlt does not
+ # support quoting properly to be signaled about this
+ $table_name = $$table_name if ref $table_name eq 'SCALAR';
# Its possible to have multiple DBIC sources using the same table
next if $tables{$table_name};
@@ -142,6 +143,10 @@
my $othertable = $source->related_source($rel);
my $rel_table = $othertable->name;
+ # FIXME - this isn't the right way to do it, but sqlt does not
+ # support quoting properly to be signaled about this
+ $rel_table = $$rel_table if ref $rel_table eq 'SCALAR';
+
my $reverse_rels = $source->reverse_relationship_info($rel);
my ($otherrelname, $otherrelationship) = each %{$reverse_rels};
@@ -251,15 +256,33 @@
) {
$schema->add_table ($tables{$table}{object});
$tables{$table}{source} -> _invoke_sqlt_deploy_hook( $tables{$table}{object} );
+
+ # the hook might have already removed the table
+ if ($schema->get_table($table) && $table =~ /^ \s* \( \s* SELECT \s+/ix) {
+ warn <<'EOW';
+
+Custom SQL through ->name(\'( SELECT ...') is DEPRECATED, for more details see
+"Arbitrary SQL through a custom ResultSource" in DBIx::Class::Manual::Cookbook
+or http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class/Manual/Cookbook.pod
+
+EOW
+
+ # remove the table as there is no way someone might want to
+ # actually deploy this
+ $schema->drop_table ($table);
+ }
}
-
my %views;
foreach my $moniker (sort @view_monikers)
{
my $source = $dbicschema->source($moniker);
my $view_name = $source->name;
+ # FIXME - this isn't the right way to do it, but sqlt does not
+ # support quoting properly to be signaled about this
+ $view_name = $$view_name if ref $view_name eq 'SCALAR';
+
# Skip custom query sources
next if ref $view_name;
Modified: DBIx-Class/0.08/branches/extended_rels/script/dbicadmin
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/script/dbicadmin 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/script/dbicadmin 2009-09-09 09:39:56 UTC (rev 7609)
@@ -30,7 +30,7 @@
}
pod2usage(1) if ($help);
-$ENV{DBIX_CLASS_STORAGE_DBI_DEBUG} = 1 if ($trace);
+$ENV{DBIC_TRACE} = 1 if ($trace);
die('No op specified') if(!$op);
die('Invalid op') if ($op!~/^insert|update|delete|select$/s);
Modified: DBIx-Class/0.08/branches/extended_rels/t/02pod.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/02pod.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/02pod.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,6 +1,27 @@
+use warnings;
+use strict;
+
use Test::More;
+use lib qw(t/lib);
+use DBICTest;
-eval "use Test::Pod 1.14";
-plan skip_all => 'Test::Pod 1.14 required' if $@;
+my @MODULES = (
+ 'Test::Pod 1.26',
+);
+# Don't run tests for installs
+unless ( DBICTest::AuthorCheck->is_author || $ENV{AUTOMATED_TESTING} || $ENV{RELEASE_TESTING} ) {
+ plan( skip_all => "Author tests not required for installation" );
+}
+
+# Load the testing modules
+foreach my $MODULE ( @MODULES ) {
+ eval "use $MODULE";
+ if ( $@ ) {
+ $ENV{RELEASE_TESTING}
+ ? die( "Failed to load required release-testing module $MODULE" )
+ : plan( skip_all => "$MODULE not available for testing" );
+ }
+}
+
all_pod_files_ok();
Modified: DBIx-Class/0.08/branches/extended_rels/t/03podcoverage.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/03podcoverage.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/03podcoverage.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,20 +1,39 @@
+use warnings;
+use strict;
+
use Test::More;
+use List::Util ();
+use lib qw(t/lib);
+use DBICTest;
-eval "use Pod::Coverage 0.19";
-plan skip_all => 'Pod::Coverage 0.19 required' if $@;
-eval "use Test::Pod::Coverage 1.04";
-plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
+my @MODULES = (
+ 'Test::Pod::Coverage 1.08',
+ 'Pod::Coverage 0.20',
+);
-plan skip_all => 'set TEST_POD to enable this test'
- unless ($ENV{TEST_POD} || -e 'MANIFEST.SKIP');
+# Don't run tests for installs
+unless ( DBICTest::AuthorCheck->is_author || $ENV{AUTOMATED_TESTING} || $ENV{RELEASE_TESTING} ) {
+ plan( skip_all => "Author tests not required for installation" );
+}
-my @modules = sort { $a cmp $b } (Test::Pod::Coverage::all_modules());
-plan tests => scalar(@modules);
+# Load the testing modules
+foreach my $MODULE ( @MODULES ) {
+ eval "use $MODULE";
+ if ( $@ ) {
+ $ENV{RELEASE_TESTING}
+ ? die( "Failed to load required release-testing module $MODULE" )
+ : plan( skip_all => "$MODULE not available for testing" );
+ }
+}
# Since this is about checking documentation, a little documentation
-# of what this is doing might be in order...
+# of what this is doing might be in order.
# The exceptions structure below is a hash keyed by the module
-# name. The value for each is a hash, which contains one or more
+# name. Any * in a name is treated like a wildcard and will behave
+# as expected. Modules are matched by longest string first, so
+# A::B::C will match even if there is A::B*
+
+# The value for each is a hash, which contains one or more
# (although currently more than one makes no sense) of the following
# things:-
# skip => a true value means this module is not checked
@@ -22,131 +41,108 @@
# do not need to be documented.
my $exceptions = {
'DBIx::Class' => {
- ignore => [
- qw/MODIFY_CODE_ATTRIBUTES
- component_base_class
- mk_classdata
- mk_classaccessor/
- ]
+ ignore => [qw/
+ MODIFY_CODE_ATTRIBUTES
+ component_base_class
+ mk_classdata
+ mk_classaccessor
+ /]
},
'DBIx::Class::Row' => {
- ignore => [
- qw( MULTICREATE_DEBUG )
- ],
+ ignore => [qw/
+ MULTICREATE_DEBUG
+ /],
},
'DBIx::Class::ResultSource' => {
ignore => [qw/
- compare_relationship_keys
- pk_depends_on
- resolve_condition
- resolve_join
- resolve_prefetch
+ compare_relationship_keys
+ pk_depends_on
+ resolve_condition
+ resolve_join
+ resolve_prefetch
/],
},
+ 'DBIx::Class::ResultSourceHandle' => {
+ ignore => [qw/
+ schema
+ source_moniker
+ /],
+ },
'DBIx::Class::Storage' => {
- ignore => [
- qw(cursor)
- ]
+ ignore => [qw/
+ schema
+ cursor
+ /]
},
'DBIx::Class::Schema' => {
- ignore => [
- qw(setup_connection_class)
- ]
+ ignore => [qw/
+ setup_connection_class
+ /]
},
- 'DBIx::Class::Storage::DBI::Sybase' => {
- ignore => [
- qw/should_quote_data_type/,
- ]
+
+ 'DBIx::Class::Schema::Versioned' => {
+ ignore => [ qw/
+ connection
+ /]
},
- 'DBIx::Class::CDBICompat::AccessorMapping' => { skip => 1 },
- 'DBIx::Class::CDBICompat::AbstractSearch' => {
- ignore => [qw(search_where)]
- },
- 'DBIx::Class::CDBICompat::AttributeAPI' => { skip => 1 },
- 'DBIx::Class::CDBICompat::AutoUpdate' => { skip => 1 },
- 'DBIx::Class::CDBICompat::ColumnsAsHash' => {
- ignore => [qw(inflate_result new update)]
- },
- 'DBIx::Class::CDBICompat::ColumnCase' => { skip => 1 },
- 'DBIx::Class::CDBICompat::ColumnGroups' => { skip => 1 },
- 'DBIx::Class::CDBICompat::Constraints' => { skip => 1 },
- 'DBIx::Class::CDBICompat::Constructor' => { skip => 1 },
- 'DBIx::Class::CDBICompat::Copy' => {
- ignore => [qw(copy)]
- },
- 'DBIx::Class::CDBICompat::DestroyWarning' => { skip => 1 },
- 'DBIx::Class::CDBICompat::GetSet' => { skip => 1 },
- 'DBIx::Class::CDBICompat::HasA' => { skip => 1 },
- 'DBIx::Class::CDBICompat::HasMany' => { skip => 1 },
- 'DBIx::Class::CDBICompat::ImaDBI' => { skip => 1 },
- 'DBIx::Class::CDBICompat::LazyLoading' => { skip => 1 },
- 'DBIx::Class::CDBICompat::LiveObjectIndex' => { skip => 1 },
- 'DBIx::Class::CDBICompat::MightHave' => { skip => 1 },
- 'DBIx::Class::CDBICompat::NoObjectIndex' => { skip => 1 },
- 'DBIx::Class::CDBICompat::Pager' => { skip => 1 },
- 'DBIx::Class::CDBICompat::ReadOnly' => { skip => 1 },
- 'DBIx::Class::CDBICompat::Relationship' => { skip => 1 },
- 'DBIx::Class::CDBICompat::Relationships' => { skip => 1 },
- 'DBIx::Class::CDBICompat::Retrieve' => { skip => 1 },
- 'DBIx::Class::CDBICompat::SQLTransformer' => { skip => 1 },
- 'DBIx::Class::CDBICompat::Stringify' => { skip => 1 },
- 'DBIx::Class::CDBICompat::TempColumns' => { skip => 1 },
- 'DBIx::Class::CDBICompat::Triggers' => { skip => 1 },
- 'DBIx::Class::ClassResolver::PassThrough' => { skip => 1 },
- 'DBIx::Class::Componentised' => { skip => 1 },
- 'DBIx::Class::Relationship::Accessor' => { skip => 1 },
- 'DBIx::Class::Relationship::BelongsTo' => { skip => 1 },
- 'DBIx::Class::Relationship::CascadeActions' => { skip => 1 },
- 'DBIx::Class::Relationship::HasMany' => { skip => 1 },
- 'DBIx::Class::Relationship::HasOne' => { skip => 1 },
- 'DBIx::Class::Relationship::Helpers' => { skip => 1 },
- 'DBIx::Class::Relationship::ManyToMany' => { skip => 1 },
- 'DBIx::Class::Relationship::ProxyMethods' => { skip => 1 },
- 'DBIx::Class::ResultSetProxy' => { skip => 1 },
- 'DBIx::Class::ResultSetManager' => { skip => 1 },
- 'DBIx::Class::ResultSourceProxy' => { skip => 1 },
- 'DBIx::Class::Storage::DBI' => { skip => 1 },
- 'DBIx::Class::Storage::DBI::Replicated::Types' => { skip => 1 },
- 'DBIx::Class::Storage::DBI::DB2' => { skip => 1 },
- 'DBIx::Class::Storage::DBI::MSSQL' => { skip => 1 },
- 'DBIx::Class::Storage::DBI::Sybase::MSSQL' => { skip => 1 },
- 'DBIx::Class::Storage::DBI::ODBC400' => { skip => 1 },
- 'DBIx::Class::Storage::DBI::ODBC::DB2_400_SQL' => { skip => 1 },
- 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' => { skip => 1 },
- 'DBIx::Class::Storage::DBI::Oracle' => { skip => 1 },
- 'DBIx::Class::Storage::DBI::Pg' => { skip => 1 },
- 'DBIx::Class::Storage::DBI::SQLite' => { skip => 1 },
- 'DBIx::Class::Storage::DBI::mysql' => { skip => 1 },
- 'DBIx::Class::SQLAHacks' => { skip => 1 },
- 'DBIx::Class::SQLAHacks::MySQL' => { skip => 1 },
- 'DBIx::Class::SQLAHacks::MSSQL' => { skip => 1 },
- 'SQL::Translator::Parser::DBIx::Class' => { skip => 1 },
- 'SQL::Translator::Producer::DBIx::Class::File' => { skip => 1 },
-# skipped because the synopsis covers it clearly
+ 'DBIx::Class::ClassResolver::PassThrough' => { skip => 1 },
+ 'DBIx::Class::Componentised' => { skip => 1 },
+ 'DBIx::Class::Relationship::*' => { skip => 1 },
+ 'DBIx::Class::ResultSetProxy' => { skip => 1 },
+ 'DBIx::Class::ResultSourceProxy' => { skip => 1 },
+ 'DBIx::Class::Storage::Statistics' => { skip => 1 },
+ 'DBIx::Class::Storage::DBI::Replicated::Types' => { skip => 1 },
- 'DBIx::Class::InflateColumn::File' => { skip => 1 },
+# test some specific components whose parents are exempt below
+ 'DBIx::Class::Storage::DBI::Replicated*' => {},
+ 'DBIx::Class::Relationship::Base' => {},
-# skip connection since it's just an override
+# internals
+ 'DBIx::Class::SQLAHacks*' => { skip => 1 },
+ 'DBIx::Class::Storage::DBI*' => { skip => 1 },
+ 'SQL::Translator::*' => { skip => 1 },
- 'DBIx::Class::Schema::Versioned' => { ignore => [ qw(connection) ] },
+# deprecated / backcompat stuff
+ 'DBIx::Class::CDBICompat*' => { skip => 1 },
+ 'DBIx::Class::ResultSetManager' => { skip => 1 },
+ 'DBIx::Class::DB' => { skip => 1 },
-# don't bother since it's heavily deprecated
- 'DBIx::Class::ResultSetManager' => { skip => 1 },
+# skipped because the synopsis covers it clearly
+ 'DBIx::Class::InflateColumn::File' => { skip => 1 },
};
+my $ex_lookup = {};
+for my $string (keys %$exceptions) {
+ my $ex = $exceptions->{$string};
+ $string =~ s/\*/'.*?'/ge;
+ my $re = qr/^$string$/;
+ $ex_lookup->{$re} = $ex;
+}
+
+my @modules = sort { $a cmp $b } (Test::Pod::Coverage::all_modules());
+
foreach my $module (@modules) {
- SKIP:
- {
- skip "$module - No real methods", 1 if ($exceptions->{$module}{skip});
+ SKIP: {
- # build parms up from ignore list
- my $parms = {};
- $parms->{trustme} =
- [ map { qr/^$_$/ } @{ $exceptions->{$module}{ignore} } ]
- if exists($exceptions->{$module}{ignore});
+ my ($match) = List::Util::first
+ { $module =~ $_ }
+ (sort { length $b <=> length $a || $b cmp $a } (keys %$ex_lookup) )
+ ;
- # run the test with the potentially modified parm set
- pod_coverage_ok($module, $parms, "$module POD coverage");
- }
+ my $ex = $ex_lookup->{$match} if $match;
+
+ skip ("$module exempt", 1) if ($ex->{skip});
+
+ # build parms up from ignore list
+ my $parms = {};
+ $parms->{trustme} =
+ [ map { qr/^$_$/ } @{ $ex->{ignore} } ]
+ if exists($ex->{ignore});
+
+ # run the test with the potentially modified parm set
+ pod_coverage_ok($module, $parms, "$module POD coverage");
+ }
}
+
+done_testing;
Modified: DBIx-Class/0.08/branches/extended_rels/t/103many_to_many_warning.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/103many_to_many_warning.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/103many_to_many_warning.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -3,7 +3,6 @@
use Test::More;
use lib qw(t/lib);
-use Data::Dumper;
plan tests => 4;
my $exp_warn = qr/The many-to-many relationship 'bars' is trying to create/;
Deleted: DBIx-Class/0.08/branches/extended_rels/t/18inserterror.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/18inserterror.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/18inserterror.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,29 +0,0 @@
-use Class::C3;
-use strict;
-use Test::More;
-use warnings;
-
-BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 4 );
-}
-
-use lib qw(t/lib);
-
-use_ok( 'DBICTest' );
-use_ok( 'DBICTest::Schema' );
-my $schema = DBICTest->init_schema;
-
-{
- my $warnings;
- local $SIG{__WARN__} = sub { $warnings .= $_[0] };
- eval {
- $schema->resultset('CD')
- ->create({ title => 'vacation in antarctica' })
- };
- like $@, qr/NULL/; # as opposed to some other error
- unlike( $warnings, qr/uninitialized value/, "No warning from Storage" );
-}
-
Modified: DBIx-Class/0.08/branches/extended_rels/t/19quotes.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/19quotes.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/19quotes.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -36,7 +36,7 @@
eval { $rs->count };
is_same_sql_bind(
$sql, \@bind,
- "SELECT COUNT( * ) FROM `cd` `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )", ["'Caterwauler McCrae'", "'2001'"],
+ "SELECT COUNT( * ) FROM cd `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )", ["'Caterwauler McCrae'", "'2001'"],
'got correct SQL for count query with quoting'
);
@@ -60,7 +60,7 @@
eval { $rs->count };
is_same_sql_bind(
$sql, \@bind,
- "SELECT COUNT( * ) FROM [cd] [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )", ["'Caterwauler McCrae'", "'2001'"],
+ "SELECT COUNT( * ) FROM cd [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )", ["'Caterwauler McCrae'", "'2001'"],
'got correct SQL for count query with bracket quoting'
);
Modified: DBIx-Class/0.08/branches/extended_rels/t/19quotes_newstyle.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/19quotes_newstyle.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/19quotes_newstyle.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -42,7 +42,7 @@
eval { $rs->count };
is_same_sql_bind(
$sql, \@bind,
- "SELECT COUNT( * ) FROM `cd` `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )", ["'Caterwauler McCrae'", "'2001'"],
+ "SELECT COUNT( * ) FROM cd `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )", ["'Caterwauler McCrae'", "'2001'"],
'got correct SQL for count query with quoting'
);
@@ -73,7 +73,7 @@
eval { $rs->count };
is_same_sql_bind(
$sql, \@bind,
- "SELECT COUNT( * ) FROM [cd] [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )", ["'Caterwauler McCrae'", "'2001'"],
+ "SELECT COUNT( * ) FROM cd [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )", ["'Caterwauler McCrae'", "'2001'"],
'got correct SQL for count query with bracket quoting'
);
Modified: DBIx-Class/0.08/branches/extended_rels/t/26dumper.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/26dumper.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/26dumper.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -6,15 +6,6 @@
$Data::Dumper::Sortkeys = 1;
use lib qw(t/lib);
-
-BEGIN {
- eval "use DBD::SQLite";
- plan $ENV{DATA_DUMPER_TEST}
- ? ( tests => 2 )
- : ( skip_all => 'Set $ENV{DATA_DUMPER_TEST} to run this test' );
-}
-
-
use_ok('DBICTest');
my $schema = DBICTest->init_schema();
@@ -36,4 +27,4 @@
cmp_ok( $rs->count(), '==', 1, "Single record in after death with dumper");
-1;
+done_testing;
Deleted: DBIx-Class/0.08/branches/extended_rels/t/31stats.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/31stats.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/31stats.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,104 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More;
-
-plan tests => 12;
-
-use lib qw(t/lib);
-
-use_ok('DBICTest');
-my $schema = DBICTest->init_schema();
-
-my $cbworks = 0;
-
-$schema->storage->debugcb(sub { $cbworks = 1; });
-$schema->storage->debug(0);
-my $rs = $schema->resultset('CD')->search({});
-$rs->count();
-ok(!$cbworks, 'Callback not called with debug disabled');
-
-$schema->storage->debug(1);
-
-$rs->count();
-ok($cbworks, 'Debug callback worked.');
-
-my $prof = new DBIx::Test::Profiler();
-$schema->storage->debugobj($prof);
-
-# Test non-transaction calls.
-$rs->count();
-ok($prof->{'query_start'}, 'query_start called');
-ok($prof->{'query_end'}, 'query_end called');
-ok(!$prof->{'txn_begin'}, 'txn_begin not called');
-ok(!$prof->{'txn_commit'}, 'txn_commit not called');
-
-$prof->reset();
-
-# Test transaction calls
-$schema->txn_begin();
-ok($prof->{'txn_begin'}, 'txn_begin called');
-
-$rs = $schema->resultset('CD')->search({});
-$rs->count();
-ok($prof->{'query_start'}, 'query_start called');
-ok($prof->{'query_end'}, 'query_end called');
-
-$schema->txn_commit();
-ok($prof->{'txn_commit'}, 'txn_commit called');
-
-$prof->reset();
-
-# Test a rollback
-$schema->txn_begin();
-$rs = $schema->resultset('CD')->search({});
-$rs->count();
-$schema->txn_rollback();
-ok($prof->{'txn_rollback'}, 'txn_rollback called');
-
-$schema->storage->debug(0);
-
-package DBIx::Test::Profiler;
-use strict;
-
-sub new {
- my $self = bless({});
-}
-
-sub query_start {
- my $self = shift();
- $self->{'query_start'} = 1;
-}
-
-sub query_end {
- my $self = shift();
- $self->{'query_end'} = 1;
-}
-
-sub txn_begin {
- my $self = shift();
- $self->{'txn_begin'} = 1;
-}
-
-sub txn_rollback {
- my $self = shift();
- $self->{'txn_rollback'} = 1;
-}
-
-sub txn_commit {
- my $self = shift();
- $self->{'txn_commit'} = 1;
-}
-
-sub reset {
- my $self = shift();
-
- $self->{'query_start'} = 0;
- $self->{'query_end'} = 0;
- $self->{'txn_begin'} = 0;
- $self->{'txn_rollback'} = 0;
- $self->{'txn_end'} = 0;
-}
-
-1;
Deleted: DBIx-Class/0.08/branches/extended_rels/t/32connect_code_ref.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/32connect_code_ref.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/32connect_code_ref.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,24 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use lib qw(t/lib);
-use DBICTest;
-
-plan tests => 1;
-
-# Set up the "usual" sqlite for DBICTest
-my $normal_schema = DBICTest->init_schema( sqlite_use_file => 1 );
-
-# Steal the dsn, which should be like 'dbi:SQLite:t/var/DBIxClass.db'
-my $normal_dsn = $normal_schema->storage->_dbi_connect_info->[0];
-
-# Make sure we have no active connection
-$normal_schema->storage->disconnect;
-
-# Make a new clone with a new connection, using a code reference
-my $code_ref_schema = $normal_schema->connect(sub { DBI->connect($normal_dsn); });
-
-# Stolen from 60core.t - this just verifies things seem to work at all
-my @art = $code_ref_schema->resultset("Artist")->search({ }, { order_by => 'name DESC'});
-cmp_ok(@art, '==', 3, "Three artists returned");
Deleted: DBIx-Class/0.08/branches/extended_rels/t/33storage_reconnect.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/33storage_reconnect.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/33storage_reconnect.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,73 +0,0 @@
-use strict;
-use warnings;
-
-use FindBin;
-use File::Copy;
-use Test::More;
-use lib qw(t/lib);
-use DBICTest;
-
-plan tests => 6;
-
-my $db_orig = "$FindBin::Bin/var/DBIxClass.db";
-my $db_tmp = "$db_orig.tmp";
-
-# Set up the "usual" sqlite for DBICTest
-my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
-
-# Make sure we're connected by doing something
-my @art = $schema->resultset("Artist")->search({ }, { order_by => 'name DESC'});
-cmp_ok(@art, '==', 3, "Three artists returned");
-
-# Disconnect the dbh, and be sneaky about it
-# Also test if DBD::SQLite finaly knows how to ->disconnect properly
-{
- my $w;
- local $SIG{__WARN__} = sub { $w = shift };
- $schema->storage->_dbh->disconnect;
- ok ($w !~ /active statement handles/, 'SQLite can disconnect properly');
-}
-
-# Try the operation again - What should happen here is:
-# 1. S::DBI blindly attempts the SELECT, which throws an exception
-# 2. It catches the exception, checks ->{Active}/->ping, sees the disconnected state...
-# 3. Reconnects, and retries the operation
-# 4. Success!
-my @art_two = $schema->resultset("Artist")->search({ }, { order_by => 'name DESC'});
-cmp_ok(@art_two, '==', 3, "Three artists returned");
-
-### Now, disconnect the dbh, and move the db file;
-# create a new one and chmod 000 to prevent SQLite from connecting.
-$schema->storage->_dbh->disconnect;
-move( $db_orig, $db_tmp );
-open DBFILE, '>', $db_orig;
-print DBFILE 'THIS IS NOT A REAL DATABASE';
-close DBFILE;
-chmod 0000, $db_orig;
-
-### Try the operation again... it should fail, since there's no db
-{
- # Catch the DBI connection error
- local $SIG{__WARN__} = sub {};
- eval {
- my @art_three = $schema->resultset("Artist")->search( {}, { order_by => 'name DESC' } );
- };
- ok( $@, 'The operation failed' );
-}
-
-### Now, move the db file back to the correct name
-unlink($db_orig);
-move( $db_tmp, $db_orig );
-
-SKIP: {
- skip "Cannot reconnect if original connection didn't fail", 2
- if ( $@ =~ /encrypted or is not a database/ );
-
- ### Try the operation again... this time, it should succeed
- my @art_four;
- eval {
- @art_four = $schema->resultset("Artist")->search( {}, { order_by => 'name DESC' } );
- };
- ok( !$@, 'The operation succeeded' );
- cmp_ok( @art_four, '==', 3, "Three artists returned" );
-}
Deleted: DBIx-Class/0.08/branches/extended_rels/t/35disable_sth_caching.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/35disable_sth_caching.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/35disable_sth_caching.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,19 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use lib qw(t/lib);
-use DBICTest;
-
-plan tests => 2;
-
-# Set up the "usual" sqlite for DBICTest
-my $schema = DBICTest->init_schema;
-
-my $sth_one = $schema->storage->sth('SELECT 42');
-my $sth_two = $schema->storage->sth('SELECT 42');
-$schema->storage->disable_sth_caching(1);
-my $sth_three = $schema->storage->sth('SELECT 42');
-
-ok($sth_one == $sth_two, "statement caching works");
-ok($sth_two != $sth_three, "disabling statement caching works");
Deleted: DBIx-Class/0.08/branches/extended_rels/t/36datetime.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/36datetime.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/36datetime.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,28 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use lib qw(t/lib);
-use DBICTest;
-
-eval { require DateTime::Format::SQLite };
-plan $@ ? ( skip_all => 'Requires DateTime::Format::SQLite' )
- : ( tests => 3 );
-
-my $schema = DBICTest->init_schema(
- no_deploy => 1, # Deploying would cause an early rebless
-);
-
-is(
- ref $schema->storage, 'DBIx::Class::Storage::DBI',
- 'Starting with generic storage'
-);
-
-# Calling date_time_parser should cause the storage to be reblessed,
-# so that we can pick up datetime_parser_type from subclasses
-
-my $parser = $schema->storage->datetime_parser();
-
-is($parser, 'DateTime::Format::SQLite', 'Got expected storage-set datetime_parser');
-isa_ok($schema->storage, 'DBIx::Class::Storage::DBI::SQLite', 'storage');
-
Modified: DBIx-Class/0.08/branches/extended_rels/t/46where_attribute.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/46where_attribute.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/46where_attribute.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -2,7 +2,6 @@
use warnings;
use Test::More;
-use Data::Dumper;
use lib qw(t/lib);
use DBICTest;
my $schema = DBICTest->init_schema();
Modified: DBIx-Class/0.08/branches/extended_rels/t/60core.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/60core.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/60core.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -104,6 +104,13 @@
is($new_again->ID, 'DBICTest::Artist|artist|artistid=4', 'unique object id generated correctly');
+# test that store_column is called once for create() for non sequence columns
+{
+ ok(my $artist = $schema->resultset('Artist')->create({name => 'store_column test'}));
+ is($artist->name, 'X store_column test'); # used to be 'X X store...'
+ $artist->delete;
+}
+
# Test backwards compatibility
{
my $warnings = '';
@@ -452,4 +459,6 @@
}
}
+throws_ok { $schema->resultset} qr/resultset\(\) expects a source name/, 'resultset with no argument throws exception';
+
done_testing;
Modified: DBIx-Class/0.08/branches/extended_rels/t/71mysql.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/71mysql.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/71mysql.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -6,6 +6,7 @@
use lib qw(t/lib);
use DBICTest;
use DBI::Const::GetInfoType;
+use DBIC::SqlMakerTest;
my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/};
@@ -14,8 +15,6 @@
plan skip_all => 'Set $ENV{DBICTEST_MYSQL_DSN}, _USER and _PASS to run this test'
unless ($dsn && $user);
-plan tests => 19;
-
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
my $dbh = $schema->storage->dbh;
@@ -46,6 +45,14 @@
#'dbi:mysql:host=localhost;database=dbic_test', 'dbic_test', '');
+# make sure sqlt_type overrides work (::Storage::DBI::mysql does this)
+{
+ my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+
+ ok (!$schema->storage->_dbh, 'definitely not connected');
+ is ($schema->storage->sqlt_type, 'MySQL', 'sqlt_type correct pre-connection');
+}
+
# This is in Core now, but it's here just to test that it doesn't break
$schema->class('Artist')->load_components('PK::Auto');
@@ -153,13 +160,42 @@
my $type_info = $schema->storage->columns_info_for('artist');
is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
+
+
}
my $cd = $schema->resultset ('CD')->create ({});
my $producer = $schema->resultset ('Producer')->create ({});
lives_ok { $cd->set_producers ([ $producer ]) } 'set_relationship doesnt die';
+{
+ my $artist = $schema->resultset('Artist')->next;
+ my $cd = $schema->resultset('CD')->next;
+ $cd->set_from_related ('artist', $artist);
+ $cd->update;
+ my $rs = $schema->resultset('CD')->search ({}, { prefetch => 'artist' });
+
+ lives_ok sub {
+ my $cd = $rs->next;
+ is ($cd->artist->name, $artist->name, 'Prefetched artist');
+ }, 'join does not throw (mysql 3 test)';
+
+ # induce a jointype override, make sure it works even if we don't have mysql3
+ local $schema->storage->sql_maker->{_default_jointype} = 'inner';
+ is_same_sql_bind (
+ $rs->as_query,
+ '(
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
+ artist.artistid, artist.name, artist.rank, artist.charfield
+ FROM cd me
+ INNER JOIN artist artist ON artist.artistid = me.artist
+ )',
+ [],
+ 'overriden default join type works',
+ );
+}
+
## Can we properly deal with the null search problem?
##
## Only way is to do a SET SQL_AUTO_IS_NULL = 0; on connect
@@ -190,3 +226,5 @@
is $artist => undef
=> 'Nothing Found!';
}
+
+done_testing;
Modified: DBIx-Class/0.08/branches/extended_rels/t/72pg.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/72pg.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/72pg.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,107 +1,79 @@
use strict;
-use warnings;
+use warnings;
use Test::More;
use Test::Exception;
use lib qw(t/lib);
use DBICTest;
-{
- package DBICTest::Schema::Casecheck;
- use strict;
- use warnings;
- use base 'DBIx::Class';
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
- __PACKAGE__->load_components(qw/Core/);
- __PACKAGE__->table('testschema.casecheck');
- __PACKAGE__->add_columns(qw/id name NAME uc_name storecolumn/);
- __PACKAGE__->column_info_from_storage(1);
- __PACKAGE__->set_primary_key('id');
+plan skip_all => <<EOM unless $dsn && $user;
+Set \$ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test
+( NOTE: This test drops and creates tables called 'artist', 'casecheck',
+ 'array_test' and 'sequence_test' as well as following sequences:
+ 'pkid1_seq', 'pkid2_seq' and 'nonpkid_seq''. as well as following
+ schemas: 'dbic_t_schema', 'dbic_t_schema_2', 'dbic_t_schema_3',
+ 'dbic_t_schema_4', and 'dbic_t_schema_5'
+)
+EOM
- sub store_column {
- my ($self, $name, $value) = @_;
- $value = '#'.$value if($name eq "storecolumn");
- $self->maybe::next::method($name, $value);
- }
-}
+### load any test classes that are defined further down in the file via BEGIN blocks
-{
- package DBICTest::Schema::ArrayTest;
+our @test_classes; #< array that will be pushed into by test classes defined in this file
+DBICTest::Schema->load_classes( map {s/.+:://;$_} @test_classes ) if @test_classes;
- use strict;
- use warnings;
- use base 'DBIx::Class';
- __PACKAGE__->load_components(qw/Core/);
- __PACKAGE__->table('testschema.array_test');
- __PACKAGE__->add_columns(qw/id arrayfield/);
- __PACKAGE__->column_info_from_storage(1);
- __PACKAGE__->set_primary_key('id');
+### pre-connect tests (keep each test separate as to make sure rebless() runs)
+{
+ my $s = DBICTest::Schema->connect($dsn, $user, $pass);
-}
+ ok (!$s->storage->_dbh, 'definitely not connected');
-my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
+ # Check that datetime_parser returns correctly before we explicitly connect.
+ SKIP: {
+ eval { require DateTime::Format::Pg };
+ skip "DateTime::Format::Pg required", 2 if $@;
-plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test '.
- '(note: This test drops and creates tables called \'artist\', \'casecheck\', \'array_test\' and \'sequence_test\''.
- ' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\''.
- ' as well as following schemas: \'testschema\'!)'
- unless ($dsn && $user);
+ my $store = ref $s->storage;
+ is($store, 'DBIx::Class::Storage::DBI', 'Started with generic storage');
+ my $parser = $s->storage->datetime_parser;
+ is( $parser, 'DateTime::Format::Pg', 'datetime_parser is as expected');
+ }
-plan tests => 39;
-
-DBICTest::Schema->load_classes( 'Casecheck', 'ArrayTest' );
-my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
-
-# Check that datetime_parser returns correctly before we explicitly connect.
-SKIP: {
- eval { require DateTime::Format::Pg };
- skip "DateTime::Format::Pg required", 2 if $@;
-
- my $store = ref $schema->storage;
- is($store, 'DBIx::Class::Storage::DBI', 'Started with generic storage');
-
- my $parser = $schema->storage->datetime_parser;
- is( $parser, 'DateTime::Format::Pg', 'datetime_parser is as expected');
+ ok (!$s->storage->_dbh, 'still not connected');
}
-
-my $dbh = $schema->storage->dbh;
-$schema->source("Artist")->name("testschema.artist");
-$schema->source("SequenceTest")->name("testschema.sequence_test");
{
- local $SIG{__WARN__} = sub {};
- _cleanup ($dbh);
-
- $dbh->do("CREATE SCHEMA testschema;");
- $dbh->do("CREATE TABLE testschema.artist (artistid serial PRIMARY KEY, name VARCHAR(100), rank INTEGER NOT NULL DEFAULT '13', charfield CHAR(10), arrayfield INTEGER[]);");
- $dbh->do("CREATE TABLE testschema.sequence_test (pkid1 integer, pkid2 integer, nonpkid integer, name VARCHAR(100), CONSTRAINT pk PRIMARY KEY(pkid1, pkid2));");
- $dbh->do("CREATE SEQUENCE pkid1_seq START 1 MAXVALUE 999999 MINVALUE 0");
- $dbh->do("CREATE SEQUENCE pkid2_seq START 10 MAXVALUE 999999 MINVALUE 0");
- $dbh->do("CREATE SEQUENCE nonpkid_seq START 20 MAXVALUE 999999 MINVALUE 0");
- ok ( $dbh->do('CREATE TABLE testschema.casecheck (id serial PRIMARY KEY, "name" VARCHAR(1), "NAME" VARCHAR(2), "UC_NAME" VARCHAR(3), "storecolumn" VARCHAR(10));'), 'Creation of casecheck table');
- ok ( $dbh->do('CREATE TABLE testschema.array_test (id serial PRIMARY KEY, arrayfield INTEGER[]);'), 'Creation of array_test table');
+ my $s = DBICTest::Schema->connect($dsn, $user, $pass);
+ # make sure sqlt_type overrides work (::Storage::DBI::Pg does this)
+ ok (!$s->storage->_dbh, 'definitely not connected');
+ is ($s->storage->sqlt_type, 'PostgreSQL', 'sqlt_type correct pre-connection');
+ ok (!$s->storage->_dbh, 'still not connected');
}
-# store_column is called once for create() for non sequence columns
+### connect, create postgres-specific test schema
-ok(my $storecolumn = $schema->resultset('Casecheck')->create({'storecolumn' => 'a'}));
+my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
-is($storecolumn->storecolumn, '#a'); # was '##a'
+drop_test_schema($schema);
+create_test_schema($schema);
+### begin main tests
-# This is in Core now, but it's here just to test that it doesn't break
-$schema->class('Artist')->load_components('PK::Auto');
-my $new = $schema->resultset('Artist')->create({ name => 'foo' });
+# run a BIG bunch of tests for last-insert-id / Auto-PK / sequence
+# discovery
+run_apk_tests($schema); #< older set of auto-pk tests
+run_extended_apk_tests($schema); #< new extended set of auto-pk tests
-is($new->artistid, 1, "Auto-PK worked");
-$new = $schema->resultset('Artist')->create({ name => 'bar' });
-is($new->artistid, 2, "Auto-PK worked");
+
+### type_info tests
+
my $test_type_info = {
'artistid' => {
'data_type' => 'integer',
@@ -135,8 +107,7 @@
},
};
-
-my $type_info = $schema->storage->columns_info_for('testschema.artist');
+my $type_info = $schema->storage->columns_info_for('dbic_t_schema.artist');
my $artistid_defval = delete $type_info->{artistid}->{default_value};
like($artistid_defval,
qr/^nextval\('([^\.]*\.){0,1}artist_artistid_seq'::(?:text|regclass)\)/,
@@ -144,6 +115,26 @@
is_deeply($type_info, $test_type_info,
'columns_info_for - column data types');
+
+
+
+####### Array tests
+
+BEGIN {
+ package DBICTest::Schema::ArrayTest;
+ push @main::test_classes, __PACKAGE__;
+
+ use strict;
+ use warnings;
+ use base 'DBIx::Class';
+
+ __PACKAGE__->load_components(qw/Core/);
+ __PACKAGE__->table('dbic_t_schema.array_test');
+ __PACKAGE__->add_columns(qw/id arrayfield/);
+ __PACKAGE__->column_info_from_storage(1);
+ __PACKAGE__->set_primary_key('id');
+
+}
SKIP: {
skip "Need DBD::Pg 2.9.2 or newer for array tests", 4 if $DBD::Pg::VERSION < 2.009002;
@@ -173,6 +164,24 @@
}
+
+########## Case check
+
+BEGIN {
+ package DBICTest::Schema::Casecheck;
+ push @main::test_classes, __PACKAGE__;
+
+ use strict;
+ use warnings;
+ use base 'DBIx::Class';
+
+ __PACKAGE__->load_components(qw/Core/);
+ __PACKAGE__->table('dbic_t_schema.casecheck');
+ __PACKAGE__->add_columns(qw/id name NAME uc_name/);
+ __PACKAGE__->column_info_from_storage(1);
+ __PACKAGE__->set_primary_key('id');
+}
+
my $name_info = $schema->source('Casecheck')->column_info( 'name' );
is( $name_info->{size}, 1, "Case sensitive matching info for 'name'" );
@@ -182,83 +191,72 @@
my $uc_name_info = $schema->source('Casecheck')->column_info( 'uc_name' );
is( $uc_name_info->{size}, 3, "Case insensitive matching info for 'uc_name'" );
-# Test SELECT ... FOR UPDATE
-my $HaveSysSigAction = eval "require Sys::SigAction" && !$@;
-if ($HaveSysSigAction) {
- Sys::SigAction->import( 'set_sig_handler' );
-}
+
+
+## Test SELECT ... FOR UPDATE
+
SKIP: {
- skip "Sys::SigAction is not available", 3 unless $HaveSysSigAction;
- # create a new schema
- my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass);
- $schema2->source("Artist")->name("testschema.artist");
+ if(eval "require Sys::SigAction" && !$@) {
+ Sys::SigAction->import( 'set_sig_handler' );
+ }
+ else {
+ skip "Sys::SigAction is not available", 6;
+ }
- $schema->txn_do( sub {
- my $artist = $schema->resultset('Artist')->search(
- {
- artistid => 1
- },
- {
- for => 'update'
- }
- )->first;
- is($artist->artistid, 1, "select for update returns artistid = 1");
+ my ($timed_out, $artist2);
- my $artist_from_schema2;
- my $error_ok = 0;
- eval {
- my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } );
- alarm(2);
- $artist_from_schema2 = $schema2->resultset('Artist')->find(1);
- $artist_from_schema2->name('fooey');
- $artist_from_schema2->update;
- alarm(0);
- };
- if (my $e = $@) {
- $error_ok = $e =~ /DBICTestTimeout/;
- }
-
+ for my $t (
+ {
# Make sure that an error was raised, and that the update failed
- ok($error_ok, "update from second schema times out");
- ok($artist_from_schema2->is_column_changed('name'), "'name' column is still dirty from second schema");
- });
-}
+ update_lock => 1,
+ test_sub => sub {
+ ok($timed_out, "update from second schema times out");
+ ok($artist2->is_column_changed('name'), "'name' column is still dirty from second schema");
+ },
+ },
+ {
+ # Make sure that an error was NOT raised, and that the update succeeded
+ update_lock => 0,
+ test_sub => sub {
+ ok(! $timed_out, "update from second schema DOES NOT timeout");
+ ok(! $artist2->is_column_changed('name'), "'name' column is NOT dirty from second schema");
+ },
+ },
+ ) {
+ # create a new schema
+ my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass);
+ $schema2->source("Artist")->name("dbic_t_schema.artist");
-SKIP: {
- skip "Sys::SigAction is not available", 3 unless $HaveSysSigAction;
- # create a new schema
- my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass);
- $schema2->source("Artist")->name("testschema.artist");
-
- $schema->txn_do( sub {
+ $schema->txn_do( sub {
my $artist = $schema->resultset('Artist')->search(
{
artistid => 1
},
+ $t->{update_lock} ? { for => 'update' } : {}
)->first;
- is($artist->artistid, 1, "select for update returns artistid = 1");
+ is($artist->artistid, 1, "select returns artistid = 1");
- my $artist_from_schema2;
- my $error_ok = 0;
+ $timed_out = 0;
eval {
my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } );
alarm(2);
- $artist_from_schema2 = $schema2->resultset('Artist')->find(1);
- $artist_from_schema2->name('fooey');
- $artist_from_schema2->update;
+ $artist2 = $schema2->resultset('Artist')->find(1);
+ $artist2->name('fooey');
+ $artist2->update;
alarm(0);
};
- if (my $e = $@) {
- $error_ok = $e =~ /DBICTestTimeout/;
- }
+ $timed_out = $@ =~ /DBICTestTimeout/;
+ });
- # Make sure that an error was NOT raised, and that the update succeeded
- ok(! $error_ok, "update from second schema DOES NOT timeout");
- ok(! $artist_from_schema2->is_column_changed('name'), "'name' column is NOT dirty from second schema");
- });
+ $t->{test_sub}->();
+ }
}
+
+######## other older Auto-pk tests
+
+$schema->source("SequenceTest")->name("dbic_t_schema.sequence_test");
for (1..5) {
my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' });
is($st->pkid1, $_, "Oracle Auto-PK without trigger: First primary key");
@@ -268,21 +266,404 @@
my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 });
is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually");
-sub _cleanup {
- my $dbh = shift or return;
+done_testing;
- for my $stat (
- 'DROP TABLE testschema.artist',
- 'DROP TABLE testschema.casecheck',
- 'DROP TABLE testschema.sequence_test',
- 'DROP TABLE testschema.array_test',
- 'DROP SEQUENCE pkid1_seq',
- 'DROP SEQUENCE pkid2_seq',
- 'DROP SEQUENCE nonpkid_seq',
- 'DROP SCHEMA testschema',
- ) {
- eval { $dbh->do ($stat) };
- }
+exit;
+
+END {
+ return unless $schema;
+ drop_test_schema($schema);
+ eapk_drop_all( $schema)
+};
+
+
+######### SUBROUTINES
+
+sub create_test_schema {
+ my $schema = shift;
+ $schema->storage->dbh_do(sub {
+ my (undef,$dbh) = @_;
+
+ local $dbh->{Warn} = 0;
+
+ my $std_artist_table = <<EOS;
+(
+ artistid serial PRIMARY KEY
+ , name VARCHAR(100)
+ , rank INTEGER NOT NULL DEFAULT '13'
+ , charfield CHAR(10)
+ , arrayfield INTEGER[]
+)
+EOS
+
+ $dbh->do("CREATE SCHEMA dbic_t_schema");
+ $dbh->do("CREATE TABLE dbic_t_schema.artist $std_artist_table");
+ $dbh->do(<<EOS);
+CREATE TABLE dbic_t_schema.sequence_test (
+ pkid1 integer
+ , pkid2 integer
+ , nonpkid integer
+ , name VARCHAR(100)
+ , CONSTRAINT pk PRIMARY KEY(pkid1, pkid2)
+)
+EOS
+ $dbh->do("CREATE SEQUENCE pkid1_seq START 1 MAXVALUE 999999 MINVALUE 0");
+ $dbh->do("CREATE SEQUENCE pkid2_seq START 10 MAXVALUE 999999 MINVALUE 0");
+ $dbh->do("CREATE SEQUENCE nonpkid_seq START 20 MAXVALUE 999999 MINVALUE 0");
+ $dbh->do(<<EOS);
+CREATE TABLE dbic_t_schema.casecheck (
+ id serial PRIMARY KEY
+ , "name" VARCHAR(1)
+ , "NAME" VARCHAR(2)
+ , "UC_NAME" VARCHAR(3)
+)
+EOS
+ $dbh->do(<<EOS);
+CREATE TABLE dbic_t_schema.array_test (
+ id serial PRIMARY KEY
+ , arrayfield INTEGER[]
+)
+EOS
+ $dbh->do("CREATE SCHEMA dbic_t_schema_2");
+ $dbh->do("CREATE TABLE dbic_t_schema_2.artist $std_artist_table");
+ $dbh->do("CREATE SCHEMA dbic_t_schema_3");
+ $dbh->do("CREATE TABLE dbic_t_schema_3.artist $std_artist_table");
+ $dbh->do('set search_path=dbic_t_schema,public');
+ $dbh->do("CREATE SCHEMA dbic_t_schema_4");
+ $dbh->do("CREATE SCHEMA dbic_t_schema_5");
+ $dbh->do(<<EOS);
+ CREATE TABLE dbic_t_schema_4.artist
+ (
+ artistid integer not null default nextval('artist_artistid_seq'::regclass) PRIMARY KEY
+ , name VARCHAR(100)
+ , rank INTEGER NOT NULL DEFAULT '13'
+ , charfield CHAR(10)
+ , arrayfield INTEGER[]
+ );
+EOS
+ $dbh->do('set search_path=public,dbic_t_schema,dbic_t_schema_3');
+ $dbh->do('create sequence public.artist_artistid_seq'); #< in the public schema
+ $dbh->do(<<EOS);
+ CREATE TABLE dbic_t_schema_5.artist
+ (
+ artistid integer not null default nextval('public.artist_artistid_seq'::regclass) PRIMARY KEY
+ , name VARCHAR(100)
+ , rank INTEGER NOT NULL DEFAULT '13'
+ , charfield CHAR(10)
+ , arrayfield INTEGER[]
+ );
+EOS
+ $dbh->do('set search_path=dbic_t_schema,public');
+ });
}
-END { _cleanup($dbh) }
+
+
+sub drop_test_schema {
+ my ( $schema, $warn_exceptions ) = @_;
+
+ $schema->storage->dbh_do(sub {
+ my (undef,$dbh) = @_;
+
+ local $dbh->{Warn} = 0;
+
+ for my $stat (
+ 'DROP SCHEMA dbic_t_schema_5 CASCADE',
+ 'DROP SEQUENCE public.artist_artistid_seq',
+ 'DROP SCHEMA dbic_t_schema_4 CASCADE',
+ 'DROP SCHEMA dbic_t_schema CASCADE',
+ 'DROP SEQUENCE pkid1_seq',
+ 'DROP SEQUENCE pkid2_seq',
+ 'DROP SEQUENCE nonpkid_seq',
+ 'DROP SCHEMA dbic_t_schema_2 CASCADE',
+ 'DROP SCHEMA dbic_t_schema_3 CASCADE',
+ ) {
+ eval { $dbh->do ($stat) };
+ diag $@ if $@ && $warn_exceptions;
+ }
+ });
+}
+
+
+### auto-pk / last_insert_id / sequence discovery
+sub run_apk_tests {
+ my $schema = shift;
+
+ # This is in Core now, but it's here just to test that it doesn't break
+ $schema->class('Artist')->load_components('PK::Auto');
+ cmp_ok( $schema->resultset('Artist')->count, '==', 0, 'this should start with an empty artist table');
+
+ # test that auto-pk also works with the defined search path by
+ # un-schema-qualifying the table name
+ apk_t_set($schema,'artist');
+
+ my $unq_new;
+ lives_ok {
+ $unq_new = $schema->resultset('Artist')->create({ name => 'baz' });
+ } 'insert into unqualified, shadowed table succeeds';
+
+ is($unq_new && $unq_new->artistid, 1, "and got correct artistid");
+
+ my @test_schemas = ( [qw| dbic_t_schema_2 1 |],
+ [qw| dbic_t_schema_3 1 |],
+ [qw| dbic_t_schema_4 2 |],
+ [qw| dbic_t_schema_5 1 |],
+ );
+ foreach my $t ( @test_schemas ) {
+ my ($sch_name, $start_num) = @$t;
+ #test with dbic_t_schema_2
+ apk_t_set($schema,"$sch_name.artist");
+ my $another_new;
+ lives_ok {
+ $another_new = $schema->resultset('Artist')->create({ name => 'Tollbooth Willy'});
+ is( $another_new->artistid,$start_num, "got correct artistid for $sch_name")
+ or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
+ } "$sch_name liid 1 did not die"
+ or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
+ lives_ok {
+ $another_new = $schema->resultset('Artist')->create({ name => 'Adam Sandler'});
+ is( $another_new->artistid,$start_num+1, "got correct artistid for $sch_name")
+ or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
+ } "$sch_name liid 2 did not die"
+ or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
+
+ }
+
+ lives_ok {
+ apk_t_set($schema,'dbic_t_schema.artist');
+ my $new = $schema->resultset('Artist')->create({ name => 'foo' });
+ is($new->artistid, 4, "Auto-PK worked");
+ $new = $schema->resultset('Artist')->create({ name => 'bar' });
+ is($new->artistid, 5, "Auto-PK worked");
+ } 'old auto-pk tests did not die either';
+}
+
+# sets the artist table name and clears sequence name cache
+sub apk_t_set {
+ my ( $s, $n ) = @_;
+ $s->source("Artist")->name($n);
+ $s->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache
+}
+
+
+######## EXTENDED AUTO-PK TESTS
+
+my @eapk_id_columns;
+BEGIN {
+ package DBICTest::Schema::ExtAPK;
+ push @main::test_classes, __PACKAGE__;
+
+ use strict;
+ use warnings;
+ use base 'DBIx::Class';
+
+ __PACKAGE__->load_components(qw/Core/);
+ __PACKAGE__->table('apk');
+
+ @eapk_id_columns = qw( id1 id2 id3 id4 );
+ __PACKAGE__->add_columns(
+ map { $_ => { data_type => 'integer', is_auto_increment => 1 } }
+ @eapk_id_columns
+ );
+
+ __PACKAGE__->set_primary_key('id2'); #< note the SECOND column is
+ #the primary key
+}
+
+my @eapk_schemas;
+BEGIN{ @eapk_schemas = map "dbic_apk_$_", 0..5 }
+
+sub run_extended_apk_tests {
+ my $schema = shift;
+
+ #save the search path and reset it at the end
+ my $search_path_save = eapk_get_search_path($schema);
+
+ eapk_drop_all($schema);
+
+ # make the test schemas and sequences
+ $schema->storage->dbh_do(sub {
+ my ( undef, $dbh ) = @_;
+
+ $dbh->do("CREATE SCHEMA $_")
+ for @eapk_schemas;
+
+ $dbh->do("CREATE SEQUENCE $eapk_schemas[5].fooseq");
+ $dbh->do("CREATE SEQUENCE $eapk_schemas[4].fooseq");
+ $dbh->do("CREATE SEQUENCE $eapk_schemas[3].fooseq");
+
+ $dbh->do("SET search_path = ".join ',', @eapk_schemas );
+ });
+
+ # clear our search_path cache
+ $schema->storage->{_pg_search_path} = undef;
+
+ eapk_create( $schema,
+ with_search_path => [0,1],
+ );
+ eapk_create( $schema,
+ with_search_path => [1,0,'public'],
+ nextval => "$eapk_schemas[5].fooseq",
+ );
+ eapk_create( $schema,
+ with_search_path => ['public',0,1],
+ qualify_table => 2,
+ );
+ eapk_create( $schema,
+ with_search_path => [3,1,0,'public'],
+ nextval => "$eapk_schemas[4].fooseq",
+ );
+ eapk_create( $schema,
+ with_search_path => [3,1,0,'public'],
+ nextval => "$eapk_schemas[3].fooseq",
+ qualify_table => 4,
+ );
+
+ eapk_poke( $schema, 0 );
+ eapk_poke( $schema, 2 );
+ eapk_poke( $schema, 4 );
+ eapk_poke( $schema, 1 );
+ eapk_poke( $schema, 0 );
+ eapk_poke( $schema, 1 );
+ eapk_poke( $schema, 4 );
+ eapk_poke( $schema, 3 );
+ eapk_poke( $schema, 1 );
+ eapk_poke( $schema, 2 );
+ eapk_poke( $schema, 0 );
+
+ # set our search path back
+ eapk_set_search_path( $schema, @$search_path_save );
+}
+
+# do a DBIC create on the apk table in the given schema number (which is an
+# index of @eapk_schemas)
+
+my %seqs; #< sanity-check hash of schema.table.col => currval of its sequence
+
+sub eapk_poke {
+ my ($s, $schema_num) = @_;
+
+ my $schema_name = defined $schema_num
+ ? $eapk_schemas[$schema_num]
+ : '';
+
+ my $schema_name_actual = $schema_name || eapk_get_search_path($s)->[0];
+
+ $s->source('ExtAPK')->name($schema_name ? $schema_name.'.apk' : 'apk');
+ #< clear sequence name cache
+ $s->source('ExtAPK')->column_info($_)->{sequence} = undef
+ for @eapk_id_columns;
+
+ no warnings 'uninitialized';
+ lives_ok {
+ my $new;
+ for my $inc (1,2,3) {
+ $new = $schema->resultset('ExtAPK')->create({});
+ my $proper_seqval = ++$seqs{"$schema_name_actual.apk.id2"};
+ is( $new->id2, $proper_seqval, "$schema_name_actual.apk.id2 correct inc $inc" )
+ or eapk_seq_diag($s,$schema_name);
+ $new->discard_changes;
+ for my $id (grep $_ ne 'id2', @eapk_id_columns) {
+ my $proper_seqval = ++$seqs{"$schema_name_actual.apk.$id"};
+ is( $new->$id, $proper_seqval, "$schema_name_actual.apk.$id correct inc $inc" )
+ or eapk_seq_diag($s,$schema_name);
+ }
+ }
+ } "create in schema '$schema_name' lives"
+ or eapk_seq_diag($s,$schema_name);
+}
+
+# print diagnostic info on which sequences were found in the ExtAPK
+# class
+sub eapk_seq_diag {
+ my $s = shift;
+ my $schema = shift || eapk_get_search_path($s)->[0];
+
+ diag "$schema.apk sequences: ",
+ join(', ',
+ map "$_:".($s->source('ExtAPK')->column_info($_)->{sequence} || '<none>'),
+ @eapk_id_columns
+ );
+}
+
+# get the postgres search path as an arrayref
+sub eapk_get_search_path {
+ my ( $s ) = @_;
+ # cache the search path as ['schema','schema',...] in the storage
+ # obj
+
+ return $s->storage->dbh_do(sub {
+ my (undef, $dbh) = @_;
+ my @search_path;
+ my ($sp_string) = $dbh->selectrow_array('SHOW search_path');
+ while ( $sp_string =~ s/("[^"]+"|[^,]+),?// ) {
+ unless( defined $1 and length $1 ) {
+ die "search path sanity check failed: '$1'";
+ }
+ push @search_path, $1;
+ }
+ \@search_path
+ });
+}
+sub eapk_set_search_path {
+ my ($s, at sp) = @_;
+ my $sp = join ',', at sp;
+ $s->storage->dbh_do( sub { $_[1]->do("SET search_path = $sp") } );
+}
+
+# create the apk table in the given schema, can set whether the table name is qualified, what the nextval is for the second ID
+sub eapk_create {
+ my ($schema, %a) = @_;
+
+ $schema->storage->dbh_do(sub {
+ my (undef,$dbh) = @_;
+
+ my $searchpath_save;
+ if ( $a{with_search_path} ) {
+ ($searchpath_save) = $dbh->selectrow_array('SHOW search_path');
+
+ my $search_path = join ',',map {/\D/ ? $_ : $eapk_schemas[$_]} @{$a{with_search_path}};
+
+ $dbh->do("SET search_path = $search_path");
+ }
+
+ my $table_name = $a{qualify_table}
+ ? ($eapk_schemas[$a{qualify_table}] || die). ".apk"
+ : 'apk';
+ local $_[1]->{Warn} = 0;
+
+ my $id_def = $a{nextval}
+ ? "integer primary key not null default nextval('$a{nextval}'::regclass)"
+ : 'serial primary key';
+ $dbh->do(<<EOS);
+CREATE TABLE $table_name (
+ id1 serial
+ , id2 $id_def
+ , id3 serial
+ , id4 serial
+)
+EOS
+
+ if( $searchpath_save ) {
+ $dbh->do("SET search_path = $searchpath_save");
+ }
+ });
+}
+
+sub eapk_drop_all {
+ my ( $schema, $warn_exceptions ) = @_;
+
+ $schema->storage->dbh_do(sub {
+ my (undef,$dbh) = @_;
+
+ local $dbh->{Warn} = 0;
+
+ # drop the test schemas
+ for (@eapk_schemas ) {
+ eval{ $dbh->do("DROP SCHEMA $_ CASCADE") };
+ diag $@ if $@ && $warn_exceptions;
+ }
+
+
+ });
+}
Modified: DBIx-Class/0.08/branches/extended_rels/t/745db2.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/745db2.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/745db2.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -85,5 +85,6 @@
# clean up our mess
END {
+ my $dbh = eval { $schema->storage->_dbh };
$dbh->do("DROP TABLE artist") if $dbh;
}
Modified: DBIx-Class/0.08/branches/extended_rels/t/746db2_400.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/746db2_400.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/746db2_400.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -82,6 +82,6 @@
# clean up our mess
END {
+ my $dbh = eval { $schema->storage->_dbh };
$dbh->do("DROP TABLE artist") if $dbh;
}
-
Modified: DBIx-Class/0.08/branches/extended_rels/t/746mssql.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/746mssql.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/746mssql.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -12,8 +12,6 @@
plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test'
unless ($dsn && $user);
-plan tests => 39;
-
DBICTest::Schema->load_classes('ArtistGUID');
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
@@ -198,6 +196,8 @@
});
lives_ok ( sub {
+ # start a new connection, make sure rebless works
+ my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
$schema->populate ('Owners', [
[qw/id name /],
[qw/1 wiggle/],
@@ -218,7 +218,22 @@
]);
}, 'populate with PKs supplied ok' );
+lives_ok (sub {
+ # start a new connection, make sure rebless works
+ # test an insert with a supplied identity, followed by one without
+ my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+ for (1..2) {
+ my $id = $_ * 20 ;
+ $schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" });
+ $schema->resultset ('Owners')->create ({ name => "troglodoogle " . ($id + 1) });
+ }
+}, 'create with/without PKs ok' );
+
+is ($schema->resultset ('Owners')->count, 19, 'owner rows really in db' );
+
lives_ok ( sub {
+ # start a new connection, make sure rebless works
+ my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
$schema->populate ('BooksInLibrary', [
[qw/source owner title /],
[qw/Library 1 secrets0/],
@@ -325,9 +340,10 @@
],
);
}
-
}
+done_testing;
+
# clean up our mess
END {
if (my $dbh = eval { $schema->storage->_dbh }) {
Modified: DBIx-Class/0.08/branches/extended_rels/t/76joins.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/76joins.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/76joins.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -4,7 +4,6 @@
use Test::More;
use lib qw(t/lib);
use DBICTest;
-use Data::Dumper;
use DBIC::SqlMakerTest;
my $schema = DBICTest->init_schema();
Modified: DBIx-Class/0.08/branches/extended_rels/t/76select.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/76select.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/76select.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -64,6 +64,7 @@
cmp_ok ($cds->count, '>', 2, 'Initially populated with more than 2 CDs');
my $table = $cds->result_source->name;
+$table = $$table if ref $table eq 'SCALAR';
my $subsel = $cds->search ({}, {
columns => [qw/cdid title/],
from => \ "(SELECT cdid, title FROM $table LIMIT 2) me",
Modified: DBIx-Class/0.08/branches/extended_rels/t/80unique.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/80unique.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/80unique.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,14 +1,14 @@
use strict;
-use warnings;
+use warnings;
use Test::More;
use lib qw(t/lib);
use DBICTest;
+use DBIC::SqlMakerTest;
+use DBIC::DebugObj;
my $schema = DBICTest->init_schema();
-plan tests => 49;
-
# Check the defined unique constraints
is_deeply(
[ sort $schema->source('CD')->unique_constraint_names ],
@@ -209,4 +209,27 @@
);
ok($cd2->in_storage, 'Updating year using update_or_new was successful');
is($cd2->id, $cd1->id, 'Got the same CD using update_or_new');
-}
\ No newline at end of file
+}
+
+# make sure the ident condition is assembled sanely
+{
+ my $artist = $schema->resultset('Artist')->next;
+
+ my ($sql, @bind);
+ $schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind)),
+ $schema->storage->debug(1);
+
+ $artist->discard_changes;
+
+ is_same_sql_bind (
+ $sql,
+ \@bind,
+ 'SELECT me.artistid, me.name, me.rank, me.charfield FROM artist me WHERE me.artistid = ?',
+ [qw/'1'/],
+ );
+
+ $schema->storage->debug(0);
+ $schema->storage->debugobj(undef);
+}
+
+done_testing;
Modified: DBIx-Class/0.08/branches/extended_rels/t/83cache.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/83cache.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/83cache.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -74,8 +74,6 @@
}
);
-use Data::Dumper; $Data::Dumper::Deparse = 1;
-
# start test for prefetch SELECT count
$queries = 0;
$schema->storage->debug(1);
Modified: DBIx-Class/0.08/branches/extended_rels/t/86sqlt.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/86sqlt.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/86sqlt.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -5,13 +5,37 @@
use lib qw(t/lib);
use DBICTest;
-eval "use SQL::Translator";
-plan skip_all => 'SQL::Translator required' if $@;
+BEGIN {
+ require DBIx::Class;
+ plan skip_all =>
+ 'Test needs SQL::Translator ' . DBIx::Class->_sqlt_minimum_version
+ if not DBIx::Class->_sqlt_version_ok;
+}
-my $schema = DBICTest->init_schema;
+my $schema = DBICTest->init_schema (no_deploy => 1);
-plan tests => 133;
+# replace the sqlt calback with a custom version ading an index
+$schema->source('Track')->sqlt_deploy_callback(sub {
+ my ($self, $sqlt_table) = @_;
+ is (
+ $sqlt_table->schema->translator->producer_type,
+ join ('::', 'SQL::Translator::Producer', $schema->storage->sqlt_type),
+ 'Production type passed to translator object',
+ );
+
+ if ($schema->storage->sqlt_type eq 'SQLite' ) {
+ $sqlt_table->add_index( name => 'track_title', fields => ['title'] )
+ or die $sqlt_table->error;
+ }
+
+ $self->default_sqlt_deploy_hook($sqlt_table);
+});
+
+$schema->deploy; # do not remove, this fires the is() test in the callback above
+
+
+
my $translator = SQL::Translator->new(
parser_args => {
'DBIx::Schema' => $schema,
@@ -26,17 +50,7 @@
my $relinfo = $schema->source('Artist')->relationship_info ('cds');
local $relinfo->{attrs}{on_delete} = 'restrict';
- $schema->source('Track')->sqlt_deploy_callback(sub {
- my ($self, $sqlt_table) = @_;
- if ($schema->storage->sqlt_type eq 'SQLite' ) {
- $sqlt_table->add_index( name => 'track_title', fields => ['title'] )
- or die $sqlt_table->error;
- }
-
- $self->default_sqlt_deploy_hook($sqlt_table);
- });
-
$translator->parser('SQL::Translator::Parser::DBIx::Class');
$translator->producer('SQLite');
@@ -45,6 +59,7 @@
ok($output, "SQLT produced someoutput")
or diag($translator->error);
+
like (
$warn,
qr/SQLT attribute .+? was supplied for relationship .+? which does not appear to be a foreign constraint/,
@@ -443,3 +458,5 @@
is( $got->name, $expected->{name},
"name parameter correct for `$desc'" );
}
+
+done_testing;
Modified: DBIx-Class/0.08/branches/extended_rels/t/87ordered.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/87ordered.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/87ordered.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -10,8 +10,6 @@
my $schema = DBICTest->init_schema();
-plan tests => 1269;
-
my $employees = $schema->resultset('Employee');
$employees->delete();
@@ -42,11 +40,9 @@
my $group_3 = $employees->search({group_id=>3});
my $to_group = 1;
my $to_pos = undef;
-# now that we have transactions we need to work around stupid sqlite
{
my @empl = $group_3->all;
while (my $employee = shift @empl) {
- $employee->discard_changes; # since we are effective shift()ing the $rs while doing this
$employee->move_to_group($to_group, $to_pos);
$to_pos++;
$to_group = $to_group==1 ? 2 : 1;
@@ -54,7 +50,6 @@
}
foreach my $group_id (1..4) {
my $group_employees = $employees->search({group_id=>$group_id});
- $group_employees->all();
ok( check_rs($group_employees), "group positions after move_to_group" );
}
@@ -129,7 +124,6 @@
my $to_group_2 = 1;
$to_pos = undef;
-# now that we have transactions we need to work around stupid sqlite
{
my @empl = $group_3->all;
while (my $employee = shift @empl) {
@@ -143,7 +137,6 @@
foreach my $group_id_2 (1..4) {
foreach my $group_id_3 (1..4) {
my $group_employees = $employees->search({group_id_2=>$group_id_2,group_id_3=>$group_id_3});
- $group_employees->all();
ok( check_rs($group_employees), "group positions after move_to_group" );
}
}
@@ -275,3 +268,4 @@
return 1;
}
+done_testing;
Modified: DBIx-Class/0.08/branches/extended_rels/t/89dbicadmin.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/89dbicadmin.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/89dbicadmin.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -16,7 +16,7 @@
plan skip_all => 'Install Text::CSV_XS or Text::CSV_PP to run this test' if ($@);
}
-my @json_backends = qw/XS JSON DWIW Syck/;
+my @json_backends = qw/XS JSON DWIW/;
my $tests_per_run = 5;
plan tests => $tests_per_run * @json_backends;
Deleted: DBIx-Class/0.08/branches/extended_rels/t/91debug.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/91debug.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/91debug.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,73 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use lib qw(t/lib);
-use DBICTest;
-use DBIC::DebugObj;
-use DBIC::SqlMakerTest;
-
-my $schema = DBICTest->init_schema();
-
-plan tests => 7;
-
-ok ( $schema->storage->debug(1), 'debug' );
-ok ( defined(
- $schema->storage->debugfh(
- IO::File->new('t/var/sql.log', 'w')
- )
- ),
- 'debugfh'
- );
-
-$schema->storage->debugfh->autoflush(1);
-my $rs = $schema->resultset('CD')->search({});
-$rs->count();
-
-my $log = new IO::File('t/var/sql.log', 'r') or die($!);
-my $line = <$log>;
-$log->close();
-ok($line =~ /^SELECT COUNT/, 'Log success');
-
-$schema->storage->debugfh(undef);
-$ENV{'DBIC_TRACE'} = '=t/var/foo.log';
-$rs = $schema->resultset('CD')->search({});
-$rs->count();
-$log = new IO::File('t/var/foo.log', 'r') or die($!);
-$line = <$log>;
-$log->close();
-ok($line =~ /^SELECT COUNT/, 'Log success');
-$schema->storage->debugobj->debugfh(undef);
-delete($ENV{'DBIC_TRACE'});
-open(STDERRCOPY, '>&STDERR');
-stat(STDERRCOPY); # nop to get warnings quiet
-close(STDERR);
-eval {
- $rs = $schema->resultset('CD')->search({});
- $rs->count();
-};
-ok($@, 'Died on closed FH');
-open(STDERR, '>&STDERRCOPY');
-
-# test trace output correctness for bind params
-{
- my ($sql, @bind);
- $schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind));
-
- my @cds = $schema->resultset('CD')->search( { artist => 1, cdid => { -between => [ 1, 3 ] }, } );
- is_same_sql_bind(
- $sql, \@bind,
- "SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE ( artist = ? AND (cdid BETWEEN ? AND ?) ): '1', '1', '3'",
- [qw/'1' '1' '3'/],
- 'got correct SQL with all bind parameters (debugcb)'
- );
-
- @cds = $schema->resultset('CD')->search( { artist => 1, cdid => { -between => [ 1, 3 ] }, } );
- is_same_sql_bind(
- $sql, \@bind,
- "SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE ( artist = ? AND (cdid BETWEEN ? AND ?) )", ["'1'", "'1'", "'3'"],
- 'got correct SQL with all bind parameters (debugobj)'
- );
-}
-
-1;
Deleted: DBIx-Class/0.08/branches/extended_rels/t/92storage.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/92storage.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/92storage.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,170 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use lib qw(t/lib);
-use DBICTest;
-use Data::Dumper;
-
-{
- package DBICTest::ExplodingStorage::Sth;
- use strict;
- use warnings;
-
- sub execute { die "Kablammo!" }
-
- sub bind_param {}
-
- package DBICTest::ExplodingStorage;
- use strict;
- use warnings;
- use base 'DBIx::Class::Storage::DBI::SQLite';
-
- my $count = 0;
- sub sth {
- my ($self, $sql) = @_;
- return bless {}, "DBICTest::ExplodingStorage::Sth" unless $count++;
- return $self->next::method($sql);
- }
-
- sub connected {
- return 0 if $count == 1;
- return shift->next::method(@_);
- }
-}
-
-plan tests => 17;
-
-my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
-
-is( ref($schema->storage), 'DBIx::Class::Storage::DBI::SQLite',
- 'Storage reblessed correctly into DBIx::Class::Storage::DBI::SQLite' );
-
-my $storage = $schema->storage;
-$storage->ensure_connected;
-
-eval {
- $schema->storage->throw_exception('test_exception_42');
-};
-like($@, qr/\btest_exception_42\b/, 'basic exception');
-
-eval {
- $schema->resultset('CD')->search_literal('broken +%$#$1')->all;
-};
-like($@, qr/prepare_cached failed/, 'exception via DBI->HandleError, etc');
-
-bless $storage, "DBICTest::ExplodingStorage";
-$schema->storage($storage);
-
-eval {
- $schema->resultset('Artist')->create({ name => "Exploding Sheep" });
-};
-
-is($@, "", "Exploding \$sth->execute was caught");
-
-is(1, $schema->resultset('Artist')->search({name => "Exploding Sheep" })->count,
- "And the STH was retired");
-
-
-# testing various invocations of connect_info ([ ... ])
-
-my $coderef = sub { 42 };
-my $invocations = {
- 'connect_info ([ $d, $u, $p, \%attr, \%extra_attr])' => {
- args => [
- 'foo',
- 'bar',
- undef,
- {
- on_connect_do => [qw/a b c/],
- PrintError => 0,
- },
- {
- AutoCommit => 1,
- on_disconnect_do => [qw/d e f/],
- },
- {
- unsafe => 1,
- auto_savepoint => 1,
- },
- ],
- dbi_connect_info => [
- 'foo',
- 'bar',
- undef,
- {
- PrintError => 0,
- AutoCommit => 1,
- },
- ],
- },
-
- 'connect_info ([ \%code, \%extra_attr ])' => {
- args => [
- $coderef,
- {
- on_connect_do => [qw/a b c/],
- PrintError => 0,
- AutoCommit => 1,
- on_disconnect_do => [qw/d e f/],
- },
- {
- unsafe => 1,
- auto_savepoint => 1,
- },
- ],
- dbi_connect_info => [
- $coderef,
- ],
- },
-
- 'connect_info ([ \%attr ])' => {
- args => [
- {
- on_connect_do => [qw/a b c/],
- PrintError => 0,
- AutoCommit => 1,
- on_disconnect_do => [qw/d e f/],
- user => 'bar',
- dsn => 'foo',
- },
- {
- unsafe => 1,
- auto_savepoint => 1,
- },
- ],
- dbi_connect_info => [
- 'foo',
- 'bar',
- undef,
- {
- PrintError => 0,
- AutoCommit => 1,
- },
- ],
- },
-};
-
-for my $type (keys %$invocations) {
-
- # we can not use a cloner portably because of the coderef
- # so compare dumps instead
- local $Data::Dumper::Sortkeys = 1;
- my $arg_dump = Dumper ($invocations->{$type}{args});
-
- $storage->connect_info ($invocations->{$type}{args});
-
- is ($arg_dump, Dumper ($invocations->{$type}{args}), "$type didn't modify passed arguments");
-
-
- is_deeply ($storage->_dbi_connect_info, $invocations->{$type}{dbi_connect_info}, "$type produced correct _dbi_connect_info");
- ok ( (not $storage->auto_savepoint and not $storage->unsafe), "$type correctly ignored extra hashref");
-
- is_deeply (
- [$storage->on_connect_do, $storage->on_disconnect_do ],
- [ [qw/a b c/], [qw/d e f/] ],
- "$type correctly parsed DBIC specific on_[dis]connect_do",
- );
-}
-
-1;
Deleted: DBIx-Class/0.08/branches/extended_rels/t/92storage_on_connect_call.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/92storage_on_connect_call.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/92storage_on_connect_call.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,68 +0,0 @@
-use strict;
-use warnings;
-no warnings qw/once redefine/;
-
-use lib qw(t/lib);
-use DBICTest;
-
-use Test::More tests => 9;
-
-my $schema = DBICTest->init_schema(
- no_connect => 1,
- no_deploy => 1,
-);
-
-local *DBIx::Class::Storage::DBI::connect_call_foo = sub {
- isa_ok $_[0], 'DBIx::Class::Storage::DBI',
- 'got storage in connect_call method';
- is $_[1], 'bar', 'got param in connect_call method';
-};
-
-local *DBIx::Class::Storage::DBI::disconnect_call_foo = sub {
- isa_ok $_[0], 'DBIx::Class::Storage::DBI',
- 'got storage in disconnect_call method';
-};
-
-ok $schema->connection(
- DBICTest->_database,
- {
- on_connect_call => [
- [ do_sql => 'create table test1 (id integer)' ],
- [ do_sql => [ 'insert into test1 values (?)', {}, 1 ] ],
- [ do_sql => sub { ['insert into test1 values (2)'] } ],
- [ sub { $_[0]->dbh->do($_[1]) }, 'insert into test1 values (3)' ],
- # this invokes $storage->connect_call_foo('bar') (above)
- [ foo => 'bar' ],
- ],
- on_connect_do => 'insert into test1 values (4)',
- on_disconnect_call => 'foo',
- },
-), 'connection()';
-
-is_deeply (
- $schema->storage->dbh->selectall_arrayref('select * from test1'),
- [ [ 1 ], [ 2 ], [ 3 ], [ 4 ] ],
- 'on_connect_call/do actions worked'
-);
-
-local *DBIx::Class::Storage::DBI::connect_call_foo = sub {
- isa_ok $_[0], 'DBIx::Class::Storage::DBI',
- 'got storage in connect_call method';
-};
-
-local *DBIx::Class::Storage::DBI::connect_call_bar = sub {
- isa_ok $_[0], 'DBIx::Class::Storage::DBI',
- 'got storage in connect_call method';
-};
-
-$schema->storage->disconnect;
-
-ok $schema->connection(
- DBICTest->_database,
- {
- # method list form
- on_connect_call => [ 'foo', sub { ok 1, "coderef in list form" }, 'bar' ],
- },
-), 'connection()';
-
-$schema->storage->ensure_connected;
Deleted: DBIx-Class/0.08/branches/extended_rels/t/92storage_on_connect_do.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/92storage_on_connect_do.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/92storage_on_connect_do.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,88 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More tests => 12;
-
-use lib qw(t/lib);
-use base 'DBICTest';
-
-
-my $schema = DBICTest->init_schema(
- no_connect => 1,
- no_deploy => 1,
-);
-
-ok $schema->connection(
- DBICTest->_database,
- {
- on_connect_do => 'CREATE TABLE TEST_empty (id INTEGER)',
- },
-), 'connection()';
-
-is_deeply (
- $schema->storage->dbh->selectall_arrayref('SELECT * FROM TEST_empty'),
- [],
- 'string version on_connect_do() worked'
-);
-
-$schema->storage->disconnect;
-
-ok $schema->connection(
- DBICTest->_database,
- {
- on_connect_do => [
- 'CREATE TABLE TEST_empty (id INTEGER)',
- [ 'INSERT INTO TEST_empty VALUES (?)', {}, 2 ],
- \&insert_from_subref,
- ],
- on_disconnect_do =>
- [\&check_exists, 'DROP TABLE TEST_empty', \&check_dropped],
- },
-), 'connection()';
-
-is_deeply (
- $schema->storage->dbh->selectall_arrayref('SELECT * FROM TEST_empty'),
- [ [ 2 ], [ 3 ], [ 7 ] ],
- 'on_connect_do() worked'
-);
-eval { $schema->storage->dbh->do('SELECT 1 FROM TEST_nonexistent'); };
-ok $@, 'Searching for nonexistent table dies';
-
-$schema->storage->disconnect();
-
-my($connected, $disconnected, @cb_args);
-ok $schema->connection(
- DBICTest->_database,
- {
- on_connect_do => sub { $connected = 1; @cb_args = @_; },
- on_disconnect_do => sub { $disconnected = 1 },
- },
-), 'second connection()';
-$schema->storage->dbh->do('SELECT 1');
-ok $connected, 'on_connect_do() called after connect()';
-ok ! $disconnected, 'on_disconnect_do() not called after connect()';
-$schema->storage->disconnect();
-ok $disconnected, 'on_disconnect_do() called after disconnect()';
-
-isa_ok($cb_args[0], 'DBIx::Class::Storage', 'first arg to on_connect_do hook');
-
-sub check_exists {
- my $storage = shift;
- ok $storage->dbh->do('SELECT 1 FROM TEST_empty'), 'Table still exists';
- return;
-}
-
-sub check_dropped {
- my $storage = shift;
- eval { $storage->dbh->do('SELECT 1 FROM TEST_empty'); };
- ok $@, 'Reading from dropped table fails';
- return;
-}
-
-sub insert_from_subref {
- my $storage = shift;
- return [
- [ 'INSERT INTO TEST_empty VALUES (?)', {}, 3 ],
- 'INSERT INTO TEST_empty VALUES (7)',
- ];
-}
Added: DBIx-Class/0.08/branches/extended_rels/t/93autocast.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/93autocast.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/93autocast.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,82 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+{ # Fake storage driver for sqlite with autocast
+ package DBICTest::SQLite::AutoCast;
+ use base qw/
+ DBIx::Class::Storage::DBI::AutoCast
+ DBIx::Class::Storage::DBI::SQLite
+ /;
+ use mro 'c3';
+
+ my $type_map = {
+ datetime => 'DateTime',
+ integer => 'INT',
+ int => undef, # no conversion
+ };
+
+ sub _native_data_type {
+ return $type_map->{$_[1]};
+ }
+}
+
+my $schema = DBICTest->init_schema (storage_type => 'DBICTest::SQLite::AutoCast');
+
+# 'me.id' will be cast unlike the unqualified 'id'
+my $rs = $schema->resultset ('CD')->search ({
+ cdid => { '>', 5 },
+ 'tracks.last_updated_at' => { '!=', undef },
+ 'tracks.last_updated_on' => { '<', 2009 },
+ 'tracks.position' => 4,
+ 'tracks.single_track' => \[ '= ?', [ single_track => [1, 2, 3 ] ] ],
+}, { join => 'tracks' });
+
+my $bind = [
+ [ cdid => 5 ],
+ [ 'tracks.last_updated_on' => 2009 ],
+ [ 'tracks.position' => 4 ],
+ [ 'single_track' => [ 1, 2, 3] ],
+];
+
+is_same_sql_bind (
+ $rs->as_query,
+ '(
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+ FROM cd me
+ LEFT JOIN track tracks ON tracks.cd = me.cdid
+ WHERE
+ cdid > ?
+ AND tracks.last_updated_at IS NOT NULL
+ AND tracks.last_updated_on < ?
+ AND tracks.position = ?
+ AND tracks.single_track = ?
+ )',
+ $bind,
+ 'expected sql with casting off',
+);
+
+$schema->storage->auto_cast (1);
+
+is_same_sql_bind (
+ $rs->as_query,
+ '(
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+ FROM cd me
+ LEFT JOIN track tracks ON tracks.cd = me.cdid
+ WHERE
+ cdid > CAST(? AS INT)
+ AND tracks.last_updated_at IS NOT NULL
+ AND tracks.last_updated_on < CAST (? AS yyy)
+ AND tracks.position = ?
+ AND tracks.single_track = CAST(? AS INT)
+ )',
+ $bind,
+ 'expected sql with casting on',
+);
+
+done_testing;
Modified: DBIx-Class/0.08/branches/extended_rels/t/93nobindvars.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/93nobindvars.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/93nobindvars.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -65,5 +65,6 @@
# clean up our mess
END {
+ my $dbh = eval { $schema->storage->_dbh };
$dbh->do("DROP TABLE artist") if $dbh;
}
Deleted: DBIx-Class/0.08/branches/extended_rels/t/93storage_replication.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/93storage_replication.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/93storage_replication.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,853 +0,0 @@
-use strict;
-use warnings;
-use lib qw(t/lib);
-use Test::More;
-use Test::Exception;
-use DBICTest;
-use List::Util 'first';
-use Scalar::Util 'reftype';
-use File::Spec;
-use IO::Handle;
-
-BEGIN {
- eval "use DBIx::Class::Storage::DBI::Replicated; use Test::Moose";
- plan skip_all => "Deps not installed: $@" if $@;
-}
-
-use_ok 'DBIx::Class::Storage::DBI::Replicated::Pool';
-use_ok 'DBIx::Class::Storage::DBI::Replicated::Balancer';
-use_ok 'DBIx::Class::Storage::DBI::Replicated::Replicant';
-use_ok 'DBIx::Class::Storage::DBI::Replicated';
-
-use Moose();
-use MooseX::Types();
-diag "Using Moose version $Moose::VERSION and MooseX::Types version $MooseX::Types::VERSION";
-
-=head1 HOW TO USE
-
- This is a test of the replicated storage system. This will work in one of
- two ways, either it was try to fake replication with a couple of SQLite DBs
- and creative use of copy, or if you define a couple of %ENV vars correctly
- will try to test those. If you do that, it will assume the setup is properly
- replicating. Your results may vary, but I have demonstrated this to work with
- mysql native replication.
-
-=cut
-
-
-## ----------------------------------------------------------------------------
-## Build a class to hold all our required testing data and methods.
-## ----------------------------------------------------------------------------
-
-TESTSCHEMACLASSES: {
-
- ## --------------------------------------------------------------------- ##
- ## Create an object to contain your replicated stuff.
- ## --------------------------------------------------------------------- ##
-
- package DBIx::Class::DBI::Replicated::TestReplication;
-
- use DBICTest;
- use base qw/Class::Accessor::Fast/;
-
- __PACKAGE__->mk_accessors( qw/schema/ );
-
- ## Initialize the object
-
- sub new {
- my ($class, $schema_method) = (shift, shift);
- my $self = $class->SUPER::new(@_);
-
- $self->schema( $self->init_schema($schema_method) );
- return $self;
- }
-
- ## Get the Schema and set the replication storage type
-
- sub init_schema {
- # current SQLT SQLite producer does not handle DROP TABLE IF EXISTS, trap warnings here
- local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /no such table.+DROP TABLE/ };
-
- my ($class, $schema_method) = @_;
-
- my $method = "get_schema_$schema_method";
- my $schema = $class->$method;
-
- return $schema;
- }
-
- sub get_schema_by_storage_type {
- DBICTest->init_schema(
- sqlite_use_file => 1,
- storage_type=>{
- '::DBI::Replicated' => {
- balancer_type=>'::Random',
- balancer_args=>{
- auto_validate_every=>100,
- master_read_weight => 1
- },
- }
- },
- deploy_args=>{
- add_drop_table => 1,
- },
- );
- }
-
- sub get_schema_by_connect_info {
- DBICTest->init_schema(
- sqlite_use_file => 1,
- storage_type=> '::DBI::Replicated',
- balancer_type=>'::Random',
- balancer_args=> {
- auto_validate_every=>100,
- master_read_weight => 1
- },
- deploy_args=>{
- add_drop_table => 1,
- },
- );
- }
-
- sub generate_replicant_connect_info {}
- sub replicate {}
- sub cleanup {}
-
- ## --------------------------------------------------------------------- ##
- ## Add a connect_info option to test option merging.
- ## --------------------------------------------------------------------- ##
- {
- package DBIx::Class::Storage::DBI::Replicated;
-
- use Moose;
-
- __PACKAGE__->meta->make_mutable;
-
- around connect_info => sub {
- my ($next, $self, $info) = @_;
- $info->[3]{master_option} = 1;
- $self->$next($info);
- };
-
- __PACKAGE__->meta->make_immutable;
-
- no Moose;
- }
-
- ## --------------------------------------------------------------------- ##
- ## Subclass for when you are using SQLite for testing, this provides a fake
- ## replication support.
- ## --------------------------------------------------------------------- ##
-
- package DBIx::Class::DBI::Replicated::TestReplication::SQLite;
-
- use DBICTest;
- use File::Copy;
- use base 'DBIx::Class::DBI::Replicated::TestReplication';
-
- __PACKAGE__->mk_accessors(qw/master_path slave_paths/);
-
- ## Set the master path from DBICTest
-
- sub new {
- my $class = shift @_;
- my $self = $class->SUPER::new(@_);
-
- $self->master_path( DBICTest->_sqlite_dbfilename );
- $self->slave_paths([
- File::Spec->catfile(qw/t var DBIxClass_slave1.db/),
- File::Spec->catfile(qw/t var DBIxClass_slave2.db/),
- ]);
-
- return $self;
- }
-
- ## Return an Array of ArrayRefs where each ArrayRef is suitable to use for
- ## $storage->connect_info to be used for connecting replicants.
-
- sub generate_replicant_connect_info {
- my $self = shift @_;
- my @dsn = map {
- "dbi:SQLite:${_}";
- } @{$self->slave_paths};
-
- my @connect_infos = map { [$_,'','',{AutoCommit=>1}] } @dsn;
-
- ## Make sure nothing is left over from a failed test
- $self->cleanup;
-
- ## try a hashref too
- my $c = $connect_infos[0];
- $connect_infos[0] = {
- dsn => $c->[0],
- user => $c->[1],
- password => $c->[2],
- %{ $c->[3] }
- };
-
- @connect_infos
- }
-
- ## Do a 'good enough' replication by copying the master dbfile over each of
- ## the slave dbfiles. If the master is SQLite we do this, otherwise we
- ## just do a one second pause to let the slaves catch up.
-
- sub replicate {
- my $self = shift @_;
- foreach my $slave (@{$self->slave_paths}) {
- copy($self->master_path, $slave);
- }
- }
-
- ## Cleanup after ourselves. Unlink all gthe slave paths.
-
- sub cleanup {
- my $self = shift @_;
- foreach my $slave (@{$self->slave_paths}) {
- if(-e $slave) {
- unlink $slave;
- }
- }
- }
-
- ## --------------------------------------------------------------------- ##
- ## Subclass for when you are setting the databases via custom export vars
- ## This is for when you have a replicating database setup that you are
- ## going to test against. You'll need to define the correct $ENV and have
- ## two slave databases to test against, as well as a replication system
- ## that will replicate in less than 1 second.
- ## --------------------------------------------------------------------- ##
-
- package DBIx::Class::DBI::Replicated::TestReplication::Custom;
- use base 'DBIx::Class::DBI::Replicated::TestReplication';
-
- ## Return an Array of ArrayRefs where each ArrayRef is suitable to use for
- ## $storage->connect_info to be used for connecting replicants.
-
- sub generate_replicant_connect_info {
- return (
- [$ENV{"DBICTEST_SLAVE0_DSN"}, $ENV{"DBICTEST_SLAVE0_DBUSER"}, $ENV{"DBICTEST_SLAVE0_DBPASS"}, {AutoCommit => 1}],
- [$ENV{"DBICTEST_SLAVE1_DSN"}, $ENV{"DBICTEST_SLAVE1_DBUSER"}, $ENV{"DBICTEST_SLAVE1_DBPASS"}, {AutoCommit => 1}],
- );
- }
-
- ## pause a bit to let the replication catch up
-
- sub replicate {
- sleep 1;
- }
-}
-
-## ----------------------------------------------------------------------------
-## Create an object and run some tests
-## ----------------------------------------------------------------------------
-
-## Thi first bunch of tests are basic, just make sure all the bits are behaving
-
-my $replicated_class = DBICTest->has_custom_dsn ?
- 'DBIx::Class::DBI::Replicated::TestReplication::Custom' :
- 'DBIx::Class::DBI::Replicated::TestReplication::SQLite';
-
-my $replicated;
-
-for my $method (qw/by_connect_info by_storage_type/) {
- undef $replicated;
- ok $replicated = $replicated_class->new($method)
- => "Created a replication object $method";
-
- isa_ok $replicated->schema
- => 'DBIx::Class::Schema';
-
- isa_ok $replicated->schema->storage
- => 'DBIx::Class::Storage::DBI::Replicated';
-
- isa_ok $replicated->schema->storage->balancer
- => 'DBIx::Class::Storage::DBI::Replicated::Balancer::Random'
- => 'configured balancer_type';
-}
-
-ok $replicated->schema->storage->meta
- => 'has a meta object';
-
-isa_ok $replicated->schema->storage->master
- => 'DBIx::Class::Storage::DBI';
-
-isa_ok $replicated->schema->storage->pool
- => 'DBIx::Class::Storage::DBI::Replicated::Pool';
-
-does_ok $replicated->schema->storage->balancer
- => 'DBIx::Class::Storage::DBI::Replicated::Balancer';
-
-ok my @replicant_connects = $replicated->generate_replicant_connect_info
- => 'got replication connect information';
-
-ok my @replicated_storages = $replicated->schema->storage->connect_replicants(@replicant_connects)
- => 'Created some storages suitable for replicants';
-
-our %debug;
-$replicated->schema->storage->debug(1);
-$replicated->schema->storage->debugcb(sub {
- my ($op, $info) = @_;
- ##warn "\n$op, $info\n";
- %debug = (
- op => $op,
- info => $info,
- dsn => ($info=~m/\[(.+)\]/)[0],
- storage_type => $info=~m/REPLICANT/ ? 'REPLICANT' : 'MASTER',
- );
-});
-
-ok my @all_storages = $replicated->schema->storage->all_storages
- => '->all_storages';
-
-is scalar @all_storages,
- 3
- => 'correct number of ->all_storages';
-
-is ((grep $_->isa('DBIx::Class::Storage::DBI'), @all_storages),
- 3
- => '->all_storages are correct type');
-
-my @all_storage_opts =
- grep { (reftype($_)||'') eq 'HASH' }
- map @{ $_->_connect_info }, @all_storages;
-
-is ((grep $_->{master_option}, @all_storage_opts),
- 3
- => 'connect_info was merged from master to replicants');
-
-my @replicant_names = keys %{ $replicated->schema->storage->replicants };
-
-ok @replicant_names, "found replicant names @replicant_names";
-
-## Silence warning about not supporting the is_replicating method if using the
-## sqlite dbs.
-$replicated->schema->storage->debugobj->silence(1)
- if first { m{^t/} } @replicant_names;
-
-isa_ok $replicated->schema->storage->balancer->current_replicant
- => 'DBIx::Class::Storage::DBI';
-
-$replicated->schema->storage->debugobj->silence(0);
-
-ok $replicated->schema->storage->pool->has_replicants
- => 'does have replicants';
-
-is $replicated->schema->storage->pool->num_replicants => 2
- => 'has two replicants';
-
-does_ok $replicated_storages[0]
- => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
-
-does_ok $replicated_storages[1]
- => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
-
-does_ok $replicated->schema->storage->replicants->{$replicant_names[0]}
- => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
-
-does_ok $replicated->schema->storage->replicants->{$replicant_names[1]}
- => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
-
-## Add some info to the database
-
-$replicated
- ->schema
- ->populate('Artist', [
- [ qw/artistid name/ ],
- [ 4, "Ozric Tentacles"],
- ]);
-
- is $debug{storage_type}, 'MASTER',
- "got last query from a master: $debug{dsn}";
-
- like $debug{info}, qr/INSERT/, 'Last was an insert';
-
-## Make sure all the slaves have the table definitions
-
-$replicated->replicate;
-$replicated->schema->storage->replicants->{$replicant_names[0]}->active(1);
-$replicated->schema->storage->replicants->{$replicant_names[1]}->active(1);
-
-## Silence warning about not supporting the is_replicating method if using the
-## sqlite dbs.
-$replicated->schema->storage->debugobj->silence(1)
- if first { m{^t/} } @replicant_names;
-
-$replicated->schema->storage->pool->validate_replicants;
-
-$replicated->schema->storage->debugobj->silence(0);
-
-## Make sure we can read the data.
-
-ok my $artist1 = $replicated->schema->resultset('Artist')->find(4)
- => 'Created Result';
-
-## We removed testing here since master read weight is on, so we can't tell in
-## advance what storage to expect. We turn master read weight off a bit lower
-## is $debug{storage_type}, 'REPLICANT'
-## => "got last query from a replicant: $debug{dsn}, $debug{info}";
-
-isa_ok $artist1
- => 'DBICTest::Artist';
-
-is $artist1->name, 'Ozric Tentacles'
- => 'Found expected name for first result';
-
-## Check that master_read_weight is honored
-{
- no warnings qw/once redefine/;
-
- local
- *DBIx::Class::Storage::DBI::Replicated::Balancer::Random::_random_number =
- sub { 999 };
-
- $replicated->schema->storage->balancer->increment_storage;
-
- is $replicated->schema->storage->balancer->current_replicant,
- $replicated->schema->storage->master
- => 'master_read_weight is honored';
-
- ## turn it off for the duration of the test
- $replicated->schema->storage->balancer->master_read_weight(0);
- $replicated->schema->storage->balancer->increment_storage;
-}
-
-## Add some new rows that only the master will have This is because
-## we overload any type of write operation so that is must hit the master
-## database.
-
-$replicated
- ->schema
- ->populate('Artist', [
- [ qw/artistid name/ ],
- [ 5, "Doom's Children"],
- [ 6, "Dead On Arrival"],
- [ 7, "Watergate"],
- ]);
-
- is $debug{storage_type}, 'MASTER',
- "got last query from a master: $debug{dsn}";
-
- like $debug{info}, qr/INSERT/, 'Last was an insert';
-
-## Make sure all the slaves have the table definitions
-$replicated->replicate;
-
-## Should find some data now
-
-ok my $artist2 = $replicated->schema->resultset('Artist')->find(5)
- => 'Sync succeed';
-
-is $debug{storage_type}, 'REPLICANT'
- => "got last query from a replicant: $debug{dsn}";
-
-isa_ok $artist2
- => 'DBICTest::Artist';
-
-is $artist2->name, "Doom's Children"
- => 'Found expected name for first result';
-
-## What happens when we disconnect all the replicants?
-
-is $replicated->schema->storage->pool->connected_replicants => 2
- => "both replicants are connected";
-
-$replicated->schema->storage->replicants->{$replicant_names[0]}->disconnect;
-$replicated->schema->storage->replicants->{$replicant_names[1]}->disconnect;
-
-is $replicated->schema->storage->pool->connected_replicants => 0
- => "both replicants are now disconnected";
-
-## All these should pass, since the database should automatically reconnect
-
-ok my $artist3 = $replicated->schema->resultset('Artist')->find(6)
- => 'Still finding stuff.';
-
-is $debug{storage_type}, 'REPLICANT'
- => "got last query from a replicant: $debug{dsn}";
-
-isa_ok $artist3
- => 'DBICTest::Artist';
-
-is $artist3->name, "Dead On Arrival"
- => 'Found expected name for first result';
-
-is $replicated->schema->storage->pool->connected_replicants => 1
- => "At Least One replicant reconnected to handle the job";
-
-## What happens when we try to select something that doesn't exist?
-
-ok ! $replicated->schema->resultset('Artist')->find(666)
- => 'Correctly failed to find something.';
-
-is $debug{storage_type}, 'REPLICANT'
- => "got last query from a replicant: $debug{dsn}";
-
-## test the reliable option
-
-TESTRELIABLE: {
-
- $replicated->schema->storage->set_reliable_storage;
-
- ok $replicated->schema->resultset('Artist')->find(2)
- => 'Read from master 1';
-
- is $debug{storage_type}, 'MASTER',
- "got last query from a master: $debug{dsn}";
-
- ok $replicated->schema->resultset('Artist')->find(5)
- => 'Read from master 2';
-
- is $debug{storage_type}, 'MASTER',
- "got last query from a master: $debug{dsn}";
-
- $replicated->schema->storage->set_balanced_storage;
-
- ok $replicated->schema->resultset('Artist')->find(3)
- => 'Read from replicant';
-
- is $debug{storage_type}, 'REPLICANT',
- "got last query from a replicant: $debug{dsn}";
-}
-
-## Make sure when reliable goes out of scope, we are using replicants again
-
-ok $replicated->schema->resultset('Artist')->find(1)
- => 'back to replicant 1.';
-
- is $debug{storage_type}, 'REPLICANT',
- "got last query from a replicant: $debug{dsn}";
-
-ok $replicated->schema->resultset('Artist')->find(2)
- => 'back to replicant 2.';
-
- is $debug{storage_type}, 'REPLICANT',
- "got last query from a replicant: $debug{dsn}";
-
-## set all the replicants to inactive, and make sure the balancer falls back to
-## the master.
-
-$replicated->schema->storage->replicants->{$replicant_names[0]}->active(0);
-$replicated->schema->storage->replicants->{$replicant_names[1]}->active(0);
-
-{
- ## catch the fallback to master warning
- open my $debugfh, '>', \my $fallback_warning;
- my $oldfh = $replicated->schema->storage->debugfh;
- $replicated->schema->storage->debugfh($debugfh);
-
- ok $replicated->schema->resultset('Artist')->find(2)
- => 'Fallback to master';
-
- is $debug{storage_type}, 'MASTER',
- "got last query from a master: $debug{dsn}";
-
- like $fallback_warning, qr/falling back to master/
- => 'emits falling back to master warning';
-
- $replicated->schema->storage->debugfh($oldfh);
-}
-
-$replicated->schema->storage->replicants->{$replicant_names[0]}->active(1);
-$replicated->schema->storage->replicants->{$replicant_names[1]}->active(1);
-
-## Silence warning about not supporting the is_replicating method if using the
-## sqlite dbs.
-$replicated->schema->storage->debugobj->silence(1)
- if first { m{^t/} } @replicant_names;
-
-$replicated->schema->storage->pool->validate_replicants;
-
-$replicated->schema->storage->debugobj->silence(0);
-
-ok $replicated->schema->resultset('Artist')->find(2)
- => 'Returned to replicates';
-
-is $debug{storage_type}, 'REPLICANT',
- "got last query from a replicant: $debug{dsn}";
-
-## Getting slave status tests
-
-SKIP: {
- ## We skip this tests unless you have a custom replicants, since the default
- ## sqlite based replication tests don't support these functions.
-
- skip 'Cannot Test Replicant Status on Non Replicating Database', 10
- unless DBICTest->has_custom_dsn && $ENV{"DBICTEST_SLAVE0_DSN"};
-
- $replicated->replicate; ## Give the slaves a chance to catchup.
-
- ok $replicated->schema->storage->replicants->{$replicant_names[0]}->is_replicating
- => 'Replicants are replicating';
-
- is $replicated->schema->storage->replicants->{$replicant_names[0]}->lag_behind_master, 0
- => 'Replicant is zero seconds behind master';
-
- ## Test the validate replicants
-
- $replicated->schema->storage->pool->validate_replicants;
-
- is $replicated->schema->storage->pool->active_replicants, 2
- => 'Still have 2 replicants after validation';
-
- ## Force the replicants to fail the validate test by required their lag to
- ## be negative (ie ahead of the master!)
-
- $replicated->schema->storage->pool->maximum_lag(-10);
- $replicated->schema->storage->pool->validate_replicants;
-
- is $replicated->schema->storage->pool->active_replicants, 0
- => 'No way a replicant be be ahead of the master';
-
- ## Let's be fair to the replicants again. Let them lag up to 5
-
- $replicated->schema->storage->pool->maximum_lag(5);
- $replicated->schema->storage->pool->validate_replicants;
-
- is $replicated->schema->storage->pool->active_replicants, 2
- => 'Both replicants in good standing again';
-
- ## Check auto validate
-
- is $replicated->schema->storage->balancer->auto_validate_every, 100
- => "Got the expected value for auto validate";
-
- ## This will make sure we auto validatge everytime
- $replicated->schema->storage->balancer->auto_validate_every(0);
-
- ## set all the replicants to inactive, and make sure the balancer falls back to
- ## the master.
-
- $replicated->schema->storage->replicants->{$replicant_names[0]}->active(0);
- $replicated->schema->storage->replicants->{$replicant_names[1]}->active(0);
-
- ## Ok, now when we go to run a query, autovalidate SHOULD reconnect
-
- is $replicated->schema->storage->pool->active_replicants => 0
- => "both replicants turned off";
-
- ok $replicated->schema->resultset('Artist')->find(5)
- => 'replicant reactivated';
-
- is $debug{storage_type}, 'REPLICANT',
- "got last query from a replicant: $debug{dsn}";
-
- is $replicated->schema->storage->pool->active_replicants => 2
- => "both replicants reactivated";
-}
-
-## Test the reliably callback
-
-ok my $reliably = sub {
-
- ok $replicated->schema->resultset('Artist')->find(5)
- => 'replicant reactivated';
-
- is $debug{storage_type}, 'MASTER',
- "got last query from a master: $debug{dsn}";
-
-} => 'created coderef properly';
-
-$replicated->schema->storage->execute_reliably($reliably);
-
-## Try something with an error
-
-ok my $unreliably = sub {
-
- ok $replicated->schema->resultset('ArtistXX')->find(5)
- => 'replicant reactivated';
-
-} => 'created coderef properly';
-
-throws_ok {$replicated->schema->storage->execute_reliably($unreliably)}
- qr/Can't find source for ArtistXX/
- => 'Bad coderef throws proper error';
-
-## Make sure replication came back
-
-ok $replicated->schema->resultset('Artist')->find(3)
- => 'replicant reactivated';
-
-is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
-
-## make sure transactions are set to execute_reliably
-
-ok my $transaction = sub {
-
- my $id = shift @_;
-
- $replicated
- ->schema
- ->populate('Artist', [
- [ qw/artistid name/ ],
- [ $id, "Children of the Grave"],
- ]);
-
- ok my $result = $replicated->schema->resultset('Artist')->find($id)
- => "Found expected artist for $id";
-
- is $debug{storage_type}, 'MASTER',
- "got last query from a master: $debug{dsn}";
-
- ok my $more = $replicated->schema->resultset('Artist')->find(1)
- => 'Found expected artist again for 1';
-
- is $debug{storage_type}, 'MASTER',
- "got last query from a master: $debug{dsn}";
-
- return ($result, $more);
-
-} => 'Created a coderef properly';
-
-## Test the transaction with multi return
-{
- ok my @return = $replicated->schema->txn_do($transaction, 666)
- => 'did transaction';
-
- is $return[0]->id, 666
- => 'first returned value is correct';
-
- is $debug{storage_type}, 'MASTER',
- "got last query from a master: $debug{dsn}";
-
- is $return[1]->id, 1
- => 'second returned value is correct';
-
- is $debug{storage_type}, 'MASTER',
- "got last query from a master: $debug{dsn}";
-
-}
-
-## Test that asking for single return works
-{
- ok my @return = $replicated->schema->txn_do($transaction, 777)
- => 'did transaction';
-
- is $return[0]->id, 777
- => 'first returned value is correct';
-
- is $return[1]->id, 1
- => 'second returned value is correct';
-}
-
-## Test transaction returning a single value
-
-{
- ok my $result = $replicated->schema->txn_do(sub {
- ok my $more = $replicated->schema->resultset('Artist')->find(1)
- => 'found inside a transaction';
- is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
- return $more;
- }) => 'successfully processed transaction';
-
- is $result->id, 1
- => 'Got expected single result from transaction';
-}
-
-## Make sure replication came back
-
-ok $replicated->schema->resultset('Artist')->find(1)
- => 'replicant reactivated';
-
-is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
-
-## Test Discard changes
-
-{
- ok my $artist = $replicated->schema->resultset('Artist')->find(2)
- => 'got an artist to test discard changes';
-
- is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
-
- ok $artist->get_from_storage({force_pool=>'master'})
- => 'properly discard changes';
-
- is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
-
- ok $artist->discard_changes({force_pool=>'master'})
- => 'properly called discard_changes against master (manual attrs)';
-
- is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
-
- ok $artist->discard_changes()
- => 'properly called discard_changes against master (default attrs)';
-
- is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
-
- ok $artist->discard_changes({force_pool=>$replicant_names[0]})
- => 'properly able to override the default attributes';
-
- is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}"
-}
-
-## Test some edge cases, like trying to do a transaction inside a transaction, etc
-
-{
- ok my $result = $replicated->schema->txn_do(sub {
- return $replicated->schema->txn_do(sub {
- ok my $more = $replicated->schema->resultset('Artist')->find(1)
- => 'found inside a transaction inside a transaction';
- is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
- return $more;
- });
- }) => 'successfully processed transaction';
-
- is $result->id, 1
- => 'Got expected single result from transaction';
-}
-
-{
- ok my $result = $replicated->schema->txn_do(sub {
- return $replicated->schema->storage->execute_reliably(sub {
- return $replicated->schema->txn_do(sub {
- return $replicated->schema->storage->execute_reliably(sub {
- ok my $more = $replicated->schema->resultset('Artist')->find(1)
- => 'found inside crazy deep transactions and execute_reliably';
- is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
- return $more;
- });
- });
- });
- }) => 'successfully processed transaction';
-
- is $result->id, 1
- => 'Got expected single result from transaction';
-}
-
-## Test the force_pool resultset attribute.
-
-{
- ok my $artist_rs = $replicated->schema->resultset('Artist')
- => 'got artist resultset';
-
- ## Turn on Forced Pool Storage
- ok my $reliable_artist_rs = $artist_rs->search(undef, {force_pool=>'master'})
- => 'Created a resultset using force_pool storage';
-
- ok my $artist = $reliable_artist_rs->find(2)
- => 'got an artist result via force_pool storage';
-
- is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
-}
-
-## Test the force_pool resultset attribute part two.
-
-{
- ok my $artist_rs = $replicated->schema->resultset('Artist')
- => 'got artist resultset';
-
- ## Turn on Forced Pool Storage
- ok my $reliable_artist_rs = $artist_rs->search(undef, {force_pool=>$replicant_names[0]})
- => 'Created a resultset using force_pool storage';
-
- ok my $artist = $reliable_artist_rs->find(2)
- => 'got an artist result via force_pool storage';
-
- is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
-}
-## Delete the old database files
-$replicated->cleanup;
-
-done_testing;
-
-# vim: sw=4 sts=4 :
Modified: DBIx-Class/0.08/branches/extended_rels/t/94versioning.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/94versioning.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/94versioning.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,4 +1,5 @@
#!/usr/bin/perl
+
use strict;
use warnings;
use Test::More;
@@ -15,11 +16,10 @@
plan skip_all => 'Set $ENV{DBICTEST_MYSQL_DSN}, _USER and _PASS to run this test'
unless ($dsn);
-
- eval "use DBD::mysql; use SQL::Translator 0.09003;";
- plan $@
- ? ( skip_all => 'needs DBD::mysql and SQL::Translator 0.09003 for testing' )
- : ( tests => 22 );
+ require DBIx::Class;
+ plan skip_all =>
+ 'Test needs SQL::Translator ' . DBIx::Class->_sqlt_minimum_version
+ if not DBIx::Class->_sqlt_version_ok;
}
my $version_table_name = 'dbix_class_schema_versions';
@@ -182,3 +182,5 @@
unless ($ENV{DBICTEST_KEEP_VERSIONING_DDL}) {
unlink $_ for (values %$fn);
}
+
+done_testing;
Modified: DBIx-Class/0.08/branches/extended_rels/t/95sql_maker.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/95sql_maker.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/95sql_maker.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -7,11 +7,9 @@
use lib qw(t/lib);
use DBIC::SqlMakerTest;
-plan tests => 4;
-
use_ok('DBICTest');
-my $schema = DBICTest->init_schema();
+my $schema = DBICTest->init_schema(no_deploy => 1);
my $sql_maker = $schema->storage->sql_maker;
@@ -49,9 +47,33 @@
);
}
+# make sure the cookbook caveat of { $op, \'...' } no longer applies
+{
+ my ($sql, @bind) = $sql_maker->where({
+ last_attempt => \ '< now() - interval "12 hours"',
+ next_attempt => { '<', \ 'now() - interval "12 hours"' },
+ created => [
+ { '<=', \ '1969' },
+ \ '> 1984',
+ ],
+ });
+ is_same_sql_bind(
+ $sql,
+ \@bind,
+ 'WHERE
+ (created <= 1969 OR created > 1984 )
+ AND last_attempt < now() - interval "12 hours"
+ AND next_attempt < now() - interval "12 hours"
+ ',
+ [],
+ );
+}
+
# Make sure the carp/croak override in SQLA works (via SQLAHacks)
my $file = __FILE__;
$file = "\Q$file\E";
throws_ok (sub {
$schema->resultset ('Artist')->search ({}, { order_by => { -asc => 'stuff', -desc => 'staff' } } )->as_query;
}, qr/$file/, 'Exception correctly croak()ed');
+
+done_testing;
Modified: DBIx-Class/0.08/branches/extended_rels/t/95sql_maker_quote.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/95sql_maker_quote.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/95sql_maker_quote.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -49,9 +49,7 @@
[
'me.cdid',
{ count => 'tracks.cd' },
- { -select => 'me.artist' },
- { -select => 'me.title', -as => 'name' },
- { -select => { min => 'me.year' }, -as => 'me.minyear' },
+ { min => 'me.year', -as => 'me.minyear' },
],
{
'artist.name' => 'Caterwauler McCrae',
@@ -65,7 +63,7 @@
is_same_sql_bind(
$sql, \@bind,
q/
- SELECT `me`.`cdid`, COUNT( `tracks`.`cd` ), `me`.`artist`, `me`.`title` AS `name`, MIN( `me`.`year` ) AS `me`.`minyear`
+ SELECT `me`.`cdid`, COUNT( `tracks`.`cd` ), MIN( `me`.`year` ) AS `me`.`minyear`
FROM `cd` `me`
JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` )
LEFT JOIN `tracks` `tracks` ON ( `tracks`.`cd` = `me`.`cdid` )
@@ -294,7 +292,13 @@
],
[
{
- 'count' => '*'
+ max => 'rank',
+ -as => 'max_rank',
+ },
+ 'rank',
+ {
+ 'count' => '*',
+ -as => 'cnt',
}
],
{
@@ -308,7 +312,7 @@
is_same_sql_bind(
$sql, \@bind,
- q/SELECT COUNT( * ) FROM [cd] [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )/, [ ['artist.name' => 'Caterwauler McCrae'], ['me.year' => 2001] ],
+ q/SELECT MAX ( [rank] ) AS [max_rank], [rank], COUNT( * ) AS [cnt] FROM [cd] [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )/, [ ['artist.name' => 'Caterwauler McCrae'], ['me.year' => 2001] ],
'got correct SQL and bind parameters for count query with bracket quoting'
);
Modified: DBIx-Class/0.08/branches/extended_rels/t/99dbic_sqlt_parser.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/99dbic_sqlt_parser.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/99dbic_sqlt_parser.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -5,12 +5,11 @@
use lib qw(t/lib);
use DBICTest;
-
BEGIN {
- eval "use SQL::Translator 0.09003;";
- if ($@) {
- plan skip_all => 'needs SQL::Translator 0.09003 for testing';
- }
+ require DBIx::Class;
+ plan skip_all =>
+ 'Test needs SQL::Translator ' . DBIx::Class->_sqlt_minimum_version
+ if not DBIx::Class->_sqlt_version_ok;
}
my $schema = DBICTest->init_schema();
@@ -23,13 +22,11 @@
$schema->sources
;
-plan tests => ( @sources * 3);
-
{
my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { } } });
foreach my $source (@sources) {
- my $table = $sqlt_schema->get_table($schema->source($source)->from);
+ my $table = get_table($sqlt_schema, $schema, $source);
my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints);
my @indices = $table->get_indices;
@@ -43,7 +40,7 @@
my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 1 } } });
foreach my $source (@sources) {
- my $table = $sqlt_schema->get_table($schema->source($source)->from);
+ my $table = get_table($sqlt_schema, $schema, $source);
my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints);
my @indices = $table->get_indices;
@@ -57,7 +54,7 @@
my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 0 } } });
foreach my $source (@sources) {
- my $table = $sqlt_schema->get_table($schema->source($source)->from);
+ my $table = get_table($sqlt_schema, $schema, $source);
my @indices = $table->get_indices;
my $index_count = scalar(@indices);
@@ -65,6 +62,8 @@
}
}
+done_testing;
+
sub create_schema {
my $args = shift;
@@ -83,3 +82,12 @@
$sqlt->parser('SQL::Translator::Parser::DBIx::Class');
return $sqlt->translate({ data => $schema }) or die $sqlt->error;
}
+
+sub get_table {
+ my ($sqlt_schema, $schema, $source) = @_;
+
+ my $table_name = $schema->source($source)->from;
+ $table_name = $$table_name if ref $table_name;
+
+ return $sqlt_schema->get_table($table_name);
+}
Deleted: DBIx-Class/0.08/branches/extended_rels/t/cdbi/testlib/Binary.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/cdbi/testlib/Binary.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/cdbi/testlib/Binary.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,16 +0,0 @@
-package # hide from PAUSE
- Binary;
-
-use strict;
-use base 'PgBase';
-
-__PACKAGE__->table(cdbibintest => 'cdbibintest');
-__PACKAGE__->sequence('binseq');
-__PACKAGE__->columns(All => qw(id bin));
-
-# __PACKAGE__->data_type(bin => DBI::SQL_BINARY);
-
-sub schema { "id INTEGER, bin BYTEA" }
-
-1;
-
Deleted: DBIx-Class/0.08/branches/extended_rels/t/cdbi/testlib/PgBase.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/cdbi/testlib/PgBase.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/cdbi/testlib/PgBase.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,23 +0,0 @@
-package # hide from PAUSE
- PgBase;
-
-use strict;
-use base 'DBIx::Class::CDBICompat';
-
-my $db = $ENV{DBD_PG_DBNAME} || 'template1';
-my $user = $ENV{DBD_PG_USER} || 'postgres';
-my $pass = $ENV{DBD_PG_PASSWD} || '';
-
-__PACKAGE__->connection("dbi:Pg:dbname=$db", $user, $pass,
- { AutoCommit => 1 });
-
-sub CONSTRUCT {
- my $class = shift;
- my ($table, $sequence) = ($class->table, $class->sequence || "");
- my $schema = $class->schema;
- $class->db_Main->do("CREATE TEMPORARY SEQUENCE $sequence") if $sequence;
- $class->db_Main->do("CREATE TEMPORARY TABLE $table ( $schema )");
-}
-
-1;
-
Modified: DBIx-Class/0.08/branches/extended_rels/t/count/distinct.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/count/distinct.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/count/distinct.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -11,8 +11,6 @@
my $schema = DBICTest->init_schema();
-plan tests => 56;
-
# The tag Blue is assigned to cds 1 2 3 and 5
# The tag Cheesy is assigned to cds 2 4 and 5
#
@@ -86,5 +84,34 @@
'throw on unsupported syntax'
);
+# make sure distinct+func works
+{
+ my $rs = $schema->resultset('Artist')->search(
+ {},
+ {
+ join => 'cds',
+ distinct => 1,
+ '+select' => [ { count => 'cds.cdid', -as => 'amount_of_cds' } ],
+ '+as' => [qw/num_cds/],
+ order_by => { -desc => 'amount_of_cds' },
+ }
+ );
+
+ is_same_sql_bind (
+ $rs->as_query,
+ '(
+ SELECT me.artistid, me.name, me.rank, me.charfield, COUNT( cds.cdid ) AS amount_of_cds
+ FROM artist me LEFT JOIN cd cds ON cds.artist = me.artistid
+ GROUP BY me.artistid, me.name, me.rank, me.charfield
+ ORDER BY amount_of_cds DESC
+ )',
+ [],
+ );
+
+ is ($rs->next->get_column ('num_cds'), 3, 'Function aliased correctly');
+}
+
# These two rely on the database to throw an exception. This might not be the case one day. Please revise.
dies_ok(sub { my $count = $schema->resultset('Tag')->search({}, { '+select' => \'tagid AS tag_id', distinct => 1 })->count }, 'expecting to die');
+
+done_testing;
Modified: DBIx-Class/0.08/branches/extended_rels/t/count/grouped_pager.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/count/grouped_pager.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/count/grouped_pager.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -11,8 +11,6 @@
my $schema = DBICTest->init_schema();
-use Data::Dumper;
-
# add 2 extra artists
$schema->populate ('Artist', [
[qw/name/],
Modified: DBIx-Class/0.08/branches/extended_rels/t/count/in_subquery.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/count/in_subquery.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/count/in_subquery.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -3,8 +3,6 @@
use strict;
use warnings;
-use Data::Dumper;
-
use Test::More;
plan ( tests => 1 );
Deleted: DBIx-Class/0.08/branches/extended_rels/t/dbh_do.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/dbh_do.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/dbh_do.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,33 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 8;
-use lib qw(t/lib);
-use DBICTest;
-
-
-my $schema = DBICTest->init_schema();
-my $storage = $schema->storage;
-
-my $test_func = sub {
- is $_[0], $storage;
- is $_[1], $storage->dbh;
- is $_[2], "foo";
- is $_[3], "bar";
-};
-
-$storage->dbh_do(
- $test_func,
- "foo", "bar"
-);
-
-my $storage_class = ref $storage;
-{
- no strict 'refs';
- *{$storage_class .'::__test_method'} = $test_func;
-}
-$storage->dbh_do("__test_method", "foo", "bar");
-
-
\ No newline at end of file
Modified: DBIx-Class/0.08/branches/extended_rels/t/inflate/core.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/inflate/core.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/inflate/core.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,7 +1,8 @@
use strict;
-use warnings;
+use warnings;
use Test::More;
+use Test::Exception;
use lib qw(t/lib);
use DBICTest;
@@ -10,8 +11,6 @@
eval { require DateTime };
plan skip_all => "Need DateTime for inflation tests" if $@;
-plan tests => 22;
-
$schema->class('CD') ->inflate_column( 'year',
{ inflate => sub { DateTime->new( year => shift ) },
deflate => sub { shift->year } }
@@ -54,10 +53,10 @@
ok(!$@, 'set_inflated_column with DateTime object');
$cd->update;
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
is( $cd->year->year, $now->year, 'deflate ok' );
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
my $before_year = $cd->year->year;
eval { $cd->set_inflated_column('year', \'year + 1') };
ok(!$@, 'set_inflated_column to "year + 1"');
@@ -66,18 +65,17 @@
TODO: {
local $TODO = 'this was left in without a TODO - should it work?';
- eval {
+ lives_ok (sub {
$cd->store_inflated_column('year', \'year + 1');
is_deeply( $cd->year, \'year + 1', 'deflate ok' );
- };
- ok(!$@, 'store_inflated_column to "year + 1"');
+ }, 'store_inflated_column to "year + 1"');
}
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
is( $cd->year->year, $before_year+1, 'deflate ok' );
# store_inflated_column test
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
eval { $cd->store_inflated_column('year', $now) };
ok(!$@, 'store_inflated_column with DateTime object');
$cd->update;
@@ -85,21 +83,21 @@
is( $cd->year->year, $now->year, 'deflate ok' );
# update tests
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
eval { $cd->update({'year' => $now}) };
ok(!$@, 'update using DateTime object ok');
is($cd->year->year, $now->year, 'deflate ok');
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
$before_year = $cd->year->year;
eval { $cd->update({'year' => \'year + 1'}) };
ok(!$@, 'update using scalarref ok');
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
is($cd->year->year, $before_year + 1, 'deflate ok');
# discard_changes test
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
# inflate the year
$before_year = $cd->year->year;
$cd->update({ year => \'year + 1'});
@@ -110,4 +108,5 @@
my $copy = $cd->copy({ year => $now, title => "zemoose" });
isnt( $copy->year->year, $before_year, "copy" );
-
+
+done_testing;
Copied: DBIx-Class/0.08/branches/extended_rels/t/inflate/datetime_determine_parser.t (from rev 6886, DBIx-Class/0.08/branches/extended_rels/t/36datetime.t)
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/inflate/datetime_determine_parser.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/inflate/datetime_determine_parser.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,28 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+eval { require DateTime::Format::SQLite };
+plan $@ ? ( skip_all => 'Requires DateTime::Format::SQLite' )
+ : ( tests => 3 );
+
+my $schema = DBICTest->init_schema(
+ no_deploy => 1, # Deploying would cause an early rebless
+);
+
+is(
+ ref $schema->storage, 'DBIx::Class::Storage::DBI',
+ 'Starting with generic storage'
+);
+
+# Calling date_time_parser should cause the storage to be reblessed,
+# so that we can pick up datetime_parser_type from subclasses
+
+my $parser = $schema->storage->datetime_parser();
+
+is($parser, 'DateTime::Format::SQLite', 'Got expected storage-set datetime_parser');
+isa_ok($schema->storage, 'DBIx::Class::Storage::DBI::SQLite', 'storage');
+
Modified: DBIx-Class/0.08/branches/extended_rels/t/inflate/serialize.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/inflate/serialize.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/inflate/serialize.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -7,16 +7,14 @@
my $schema = DBICTest->init_schema();
-use Data::Dumper;
-
my @serializers = (
- { module => 'YAML.pm',
- inflater => sub { YAML::Load (shift) },
- deflater => sub { die "Expecting a reference" unless (ref $_[0]); YAML::Dump (shift) },
+ { module => 'YAML.pm',
+ inflater => sub { YAML::Load (shift) },
+ deflater => sub { die "Expecting a reference" unless (ref $_[0]); YAML::Dump (shift) },
},
- { module => 'Storable.pm',
- inflater => sub { Storable::thaw (shift) },
- deflater => sub { die "Expecting a reference" unless (ref $_[0]); Storable::nfreeze (shift) },
+ { module => 'Storable.pm',
+ inflater => sub { Storable::thaw (shift) },
+ deflater => sub { die "Expecting a reference" unless (ref $_[0]); Storable::nfreeze (shift) },
},
);
@@ -25,14 +23,13 @@
foreach my $serializer (@serializers) {
eval { require $serializer->{module} };
unless ($@) {
- $selected = $serializer;
- last;
+ $selected = $serializer;
+ last;
}
}
plan (skip_all => "No suitable serializer found") unless $selected;
-plan (tests => 11);
DBICTest::Schema::Serialized->inflate_column( 'serialized',
{ inflate => $selected->{inflater},
deflate => $selected->{deflater},
@@ -42,17 +39,17 @@
my $struct_hash = {
a => 1,
- b => [
+ b => [
{ c => 2 },
],
d => 3,
};
my $struct_array = [
- 'a',
- {
- b => 1,
- c => 2
+ 'a',
+ {
+ b => 1,
+ c => 2,
},
'd',
];
@@ -63,7 +60,6 @@
#======= testing hashref serialization
my $object = $rs->create( {
- id => 1,
serialized => '',
} );
ok($object->update( { serialized => $struct_hash } ), 'hashref deflation');
@@ -71,13 +67,19 @@
is_deeply($inflated, $struct_hash, 'inflated hash matches original');
$object = $rs->create( {
- id => 2,
serialized => '',
} );
-eval { $object->set_inflated_column('serialized', $struct_hash) };
-ok(!$@, 'set_inflated_column to a hashref');
+$object->set_inflated_column('serialized', $struct_hash);
is_deeply($object->serialized, $struct_hash, 'inflated hash matches original');
+$object = $rs->new({});
+$object->serialized ($struct_hash);
+$object->insert;
+is_deeply (
+ $rs->find ({id => $object->id})->serialized,
+ $struct_hash,
+ 'new/insert works',
+);
#====== testing arrayref serialization
@@ -85,8 +87,16 @@
ok($inflated = $object->serialized, 'arrayref inflation');
is_deeply($inflated, $struct_array, 'inflated array matches original');
+$object = $rs->new({});
+$object->serialized ($struct_array);
+$object->insert;
+is_deeply (
+ $rs->find ({id => $object->id})->serialized,
+ $struct_array,
+ 'new/insert works',
+);
-#===== make sure make_column_dirty ineracts reasonably with inflation
+#===== make sure make_column_dirty interacts reasonably with inflation
$object = $rs->first;
$object->update ({serialized => { x => 'y'}});
@@ -98,3 +108,5 @@
$object->update;
is_deeply ($rs->first->serialized, { x => 'z' }, 'changes made it to the db' );
+
+done_testing;
Modified: DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/AuthorCheck.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/AuthorCheck.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/AuthorCheck.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -54,21 +54,17 @@
We have a number of reasons to believe that this is a development
checkout and that you, the user, did not run `perl Makefile.PL`
before using this code. You absolutely _must_ perform this step,
-as not doing so often results in a lot of wasted time for other
-contributors trying to assit you with "it broke!" problems.
+and ensure you have all required dependencies present. Not doing
+so often results in a lot of wasted time for other contributors
+trying to assit you with spurious "its broken!" problems.
If you are seeing this message unexpectedly (i.e. you are in fact
-attempting a regular installation be it through CPAN or manually,
-set the variable DBICTEST_NO_MAKEFILE_VERIFICATION to a true value
-so you can continue. Also _make_absolutely_sure_ to report this to
-either the mailing list or to the irc channel as described in
+attempting a regular installation be it through CPAN or manually),
+please report the situation to either the mailing list or to the
+irc channel as described in
http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class.pm#GETTING_HELP/SUPPORT
-Failure to do this will make us believe that all these checks are
-indeed foolproof and we will remove the ability to override this
-entirely.
-
The DBIC team
@@ -79,6 +75,19 @@
}
}
+# Mimic $Module::Install::AUTHOR
+sub is_author {
+
+ my $root = _find_co_root()
+ or return undef;
+
+ return (
+ ( not -d $root->subdir ('inc') )
+ or
+ ( -e $root->subdir ('inc')->file ($^O eq 'VMS' ? '_author' : '.author') )
+ );
+}
+
# Try to determine the root of a checkout/untar if possible
# or return undef
sub _find_co_root {
Modified: DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/Artist.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/Artist.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/Artist.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -30,6 +30,7 @@
},
);
__PACKAGE__->set_primary_key('artistid');
+__PACKAGE__->add_unique_constraint(['artistid']); # do not remove, part of a test
__PACKAGE__->mk_classdata('field_name_for', {
artistid => 'primary key',
@@ -83,4 +84,11 @@
}
}
+sub store_column {
+ my ($self, $name, $value) = @_;
+ $value = 'X '.$value if ($name eq 'name' && $value && $value =~ /store_column test/);
+ $self->next::method($name, $value);
+}
+
+
1;
Modified: DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/CD.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/CD.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/CD.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -3,7 +3,10 @@
use base qw/DBICTest::BaseResult/;
-__PACKAGE__->table('cd');
+# this tests table name as scalar ref
+# DO NOT REMOVE THE \
+__PACKAGE__->table(\'cd');
+
__PACKAGE__->add_columns(
'cdid' => {
data_type => 'integer',
Modified: DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/CustomSql.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/CustomSql.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/CustomSql.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -12,4 +12,6 @@
WHERE cd.year = ?)
SQL
+sub sqlt_deploy_hook { $_[1]->schema->drop_table($_[1]) }
+
1;
Modified: DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/Serialized.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/Serialized.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/Serialized.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -5,7 +5,7 @@
__PACKAGE__->table('serialized');
__PACKAGE__->add_columns(
- 'id' => { data_type => 'integer' },
+ 'id' => { data_type => 'integer', is_auto_increment => 1 },
'serialized' => { data_type => 'text' },
);
__PACKAGE__->set_primary_key('id');
Modified: DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/Track.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/Track.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest/Schema/Track.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -14,7 +14,7 @@
data_type => 'integer',
},
'position' => {
- data_type => 'integer',
+ data_type => 'int',
accessor => 'pos',
},
'title' => {
Modified: DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest.pm
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest.pm 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/lib/DBICTest.pm 2009-09-09 09:39:56 UTC (rev 7609)
@@ -135,7 +135,7 @@
close IN;
for my $chunk ( split (/;\s*\n+/, $sql) ) {
if ( $chunk =~ / ^ (?! --\s* ) \S /xm ) { # there is some real sql in the chunk - a non-space at the start of the string which is not a comment
- $schema->storage->dbh->do($chunk) or print "Error on SQL: $chunk\n";
+ $schema->storage->dbh_do(sub { $_[1]->do($chunk) }) or print "Error on SQL: $chunk\n";
}
}
}
Modified: DBIx-Class/0.08/branches/extended_rels/t/lib/sqlite.sql
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/lib/sqlite.sql 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/lib/sqlite.sql 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,6 +1,6 @@
--
-- Created by SQL::Translator::Producer::SQLite
--- Created on Thu Jul 30 09:37:43 2009
+-- Created on Tue Aug 25 12:34:34 2009
--
@@ -16,6 +16,8 @@
charfield char(10)
);
+CREATE INDEX artist_name_hookidx ON artist (name);
+
--
-- Table: bindtype_test
--
@@ -281,7 +283,7 @@
CREATE TABLE track (
trackid INTEGER PRIMARY KEY NOT NULL,
cd integer NOT NULL,
- position integer NOT NULL,
+ position int NOT NULL,
title varchar(100) NOT NULL,
last_updated_on datetime,
last_updated_at datetime,
Added: DBIx-Class/0.08/branches/extended_rels/t/multi_create/diamond.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/multi_create/diamond.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/multi_create/diamond.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,52 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+sub mc_diag { diag (@_) if $ENV{DBIC_MULTICREATE_DEBUG} };
+
+my $schema = DBICTest->init_schema();
+
+mc_diag (<<'DG');
+* Try a diamond multicreate
+
+Artist -> has_many -> Artwork_to_Artist -> belongs_to
+ /
+ belongs_to <- CD <- belongs_to <- Artwork <-/
+ \
+ \-> Artist2
+
+DG
+
+lives_ok (sub {
+ $schema->resultset ('Artist')->create ({
+ name => 'The wooled wolf',
+ artwork_to_artist => [{
+ artwork => {
+ cd => {
+ title => 'Wool explosive',
+ year => 1999,
+ artist => { name => 'The black exploding sheep' },
+ }
+ }
+ }],
+ });
+
+ my $art2 = $schema->resultset ('Artist')->find ({ name => 'The black exploding sheep' });
+ ok ($art2, 'Second artist exists');
+
+ my $cd = $art2->cds->single;
+ is ($cd->title, 'Wool explosive', 'correctly created CD');
+
+ is_deeply (
+ [ $cd->artwork->artists->get_column ('name')->all ],
+ [ 'The wooled wolf' ],
+ 'Artist correctly attached to artwork',
+ );
+
+}, 'Diamond chain creation ok');
+
+done_testing;
Property changes on: DBIx-Class/0.08/branches/extended_rels/t/multi_create/diamond.t
___________________________________________________________________
Name: svn:eol-style
+ native
Added: DBIx-Class/0.08/branches/extended_rels/t/multi_create/existing_in_chain.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/multi_create/existing_in_chain.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/multi_create/existing_in_chain.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,105 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+# For fully intuitive multicreate any relationships in a chain
+# that do not exist for one reason or another should be created,
+# even if the preceeding relationship already exists.
+#
+# To get this to work a minor rewrite of find() is necessary, and
+# more importantly some sort of recursive_insert() call needs to
+# be available. The way things will work then is:
+# *) while traversing the hierarchy code calls find_or_create()
+# *) this in turn calls find(%\nested_dataset)
+# *) this should return not only the existing object, but must
+# also attach all non-existing (in fact maybe existing) related
+# bits of data to it, with in_storage => 0
+# *) then before returning the result of the succesful find(), we
+# simply call $obj->recursive_insert and all is dandy
+#
+# Since this will not be a very clean solution, todoifying for the
+# time being until an actual need arises
+#
+# ribasushi
+
+TODO: { my $f = __FILE__; local $TODO = "See comment at top of $f for discussion of the TODO";
+
+{
+ my $counts;
+ $counts->{$_} = $schema->resultset($_)->count for qw/Track CD Genre/;
+
+ lives_ok (sub {
+ my $existing_nogen_cd = $schema->resultset('CD')->search (
+ { 'genre.genreid' => undef },
+ { join => 'genre' },
+ )->first;
+
+ $schema->resultset('Track')->create ({
+ title => 'Sugar-coated',
+ cd => {
+ title => $existing_nogen_cd->title,
+ genre => {
+ name => 'sugar genre',
+ }
+ }
+ });
+
+ is ($schema->resultset('Track')->count, $counts->{Track} + 1, '1 new track');
+ is ($schema->resultset('CD')->count, $counts->{CD}, 'No new cds');
+ is ($schema->resultset('Genre')->count, $counts->{Genre} + 1, '1 new genre');
+
+ is ($existing_nogen_cd->genre->title, 'sugar genre', 'Correct genre assigned to CD');
+ }, 'create() did not throw');
+}
+{
+ my $counts;
+ $counts->{$_} = $schema->resultset($_)->count for qw/Artist CD Producer/;
+
+ lives_ok (sub {
+ my $artist = $schema->resultset('Artist')->first;
+ my $producer = $schema->resultset('Producer')->create ({ name => 'the queen of england' });
+
+ $schema->resultset('CD')->create ({
+ artist => $artist,
+ title => 'queen1',
+ year => 2007,
+ cd_to_producer => [
+ {
+ producer => {
+ name => $producer->name,
+ producer_to_cd => [
+ {
+ cd => {
+ title => 'queen2',
+ year => 2008,
+ artist => $artist,
+ },
+ },
+ ],
+ },
+ },
+ ],
+ });
+
+ is ($schema->resultset('Artist')->count, $counts->{Artist}, 'No new artists');
+ is ($schema->resultset('Producer')->count, $counts->{Producer} + 1, '1 new producers');
+ is ($schema->resultset('CD')->count, $counts->{CD} + 2, '2 new cds');
+
+ is ($producer->cds->count, 2, 'CDs assigned to correct producer');
+ is_deeply (
+ [ $producer->cds->search ({}, { order_by => 'title' })->get_column('title')->all],
+ [ qw/queen1 queen2/ ],
+ 'Correct cd names',
+ );
+ }, 'create() did not throw');
+}
+
+}
+
+done_testing;
Added: DBIx-Class/0.08/branches/extended_rels/t/multi_create/has_many.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/multi_create/has_many.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/multi_create/has_many.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+plan tests => 2;
+
+my $schema = DBICTest->init_schema();
+
+my $track_no_lyrics = $schema->resultset ('Track')
+ ->search ({ 'lyrics.lyric_id' => undef }, { join => 'lyrics' })
+ ->first;
+
+my $lyric = $track_no_lyrics->create_related ('lyrics', {
+ lyric_versions => [
+ { text => 'english doubled' },
+ { text => 'english doubled' },
+ ],
+});
+is ($lyric->lyric_versions->count, 2, "Two identical has_many's created");
+
+
+my $link = $schema->resultset ('Link')->create ({
+ url => 'lolcats!',
+ bookmarks => [
+ {},
+ {},
+ ]
+});
+is ($link->bookmarks->count, 2, "Two identical default-insert has_many's created");
Modified: DBIx-Class/0.08/branches/extended_rels/t/multi_create/multilev_single_PKeqFK.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/multi_create/multilev_single_PKeqFK.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/multi_create/multilev_single_PKeqFK.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -8,8 +8,6 @@
sub mc_diag { diag (@_) if $ENV{DBIC_MULTICREATE_DEBUG} };
-plan tests => 26;
-
my $schema = DBICTest->init_schema();
mc_diag (<<'DG');
@@ -102,4 +100,4 @@
}, "multilevel $type with a PK == FK in the $type/has_many table ok");
}
-1;
+done_testing;
Modified: DBIx-Class/0.08/branches/extended_rels/t/multi_create/standard.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/multi_create/standard.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/multi_create/standard.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -6,7 +6,7 @@
use lib qw(t/lib);
use DBICTest;
-plan tests => 93;
+plan tests => 91;
my $schema = DBICTest->init_schema();
@@ -329,26 +329,6 @@
}, 'Nested find_or_create');
lives_ok ( sub {
- my $artist2 = $schema->resultset('Artist')->create({
- name => 'Fred 4',
- cds => [
- {
- title => 'Music to code by',
- year => 2007,
- },
- ],
- cds_unordered => [
- {
- title => 'Music to code by',
- year => 2007,
- },
- ]
- });
-
- is($artist2->in_storage, 1, 'artist with duplicate rels inserted okay');
-}, 'Multiple same level has_many create');
-
-lives_ok ( sub {
my $artist = $schema->resultset('Artist')->first;
my $cd_result = $artist->create_related('cds', {
Modified: DBIx-Class/0.08/branches/extended_rels/t/prefetch/attrs_untouched.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/prefetch/attrs_untouched.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/prefetch/attrs_untouched.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -4,7 +4,9 @@
use Test::Exception;
use lib qw(t/lib);
use DBICTest;
+
use Data::Dumper;
+$Data::Dumper::Sortkeys = 1;
my $schema = DBICTest->init_schema();
Modified: DBIx-Class/0.08/branches/extended_rels/t/prefetch/grouped.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/prefetch/grouped.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/prefetch/grouped.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -133,10 +133,10 @@
},
{
prefetch => [qw/tracks liner_notes/],
- select => ['me.cdid', { count => 'tracks.trackid' } ],
- as => [qw/cdid track_count/],
+ select => ['me.cdid', { count => 'tracks.trackid' }, { max => 'tracks.trackid', -as => 'maxtr'} ],
+ as => [qw/cdid track_count max_track_id/],
group_by => 'me.cdid',
- order_by => { -desc => 'track_count' },
+ order_by => [ { -desc => 'track_count' }, { -asc => 'maxtr' } ],
rows => 2,
}
);
@@ -162,22 +162,22 @@
is_same_sql_bind (
$most_tracks_rs->as_query,
'(
- SELECT me.cdid, me.track_count,
+ SELECT me.cdid, me.track_count, me.maxtr,
tracks.trackid, tracks.cd, tracks.position, tracks.title, tracks.last_updated_on, tracks.last_updated_at, tracks.small_dt,
liner_notes.liner_id, liner_notes.notes
FROM (
- SELECT me.cdid, COUNT( tracks.trackid ) AS track_count
+ SELECT me.cdid, COUNT( tracks.trackid ) AS track_count, MAX( tracks.trackid ) AS maxtr,
FROM cd me
LEFT JOIN track tracks ON tracks.cd = me.cdid
WHERE ( me.cdid IS NOT NULL )
GROUP BY me.cdid
- ORDER BY track_count DESC
+ ORDER BY track_count DESC, maxtr ASC
LIMIT 2
) me
LEFT JOIN track tracks ON tracks.cd = me.cdid
LEFT JOIN liner_notes liner_notes ON liner_notes.liner_id = me.cdid
WHERE ( me.cdid IS NOT NULL )
- ORDER BY track_count DESC, tracks.cd
+ ORDER BY track_count DESC, maxtr ASC, tracks.cd
)',
[],
'next() query generated expected SQL',
@@ -235,4 +235,98 @@
is ($rs->count, 5, 'Correct count of CDs');
}
+# RT 47779, test group_by as a scalar ref
+{
+ my $track_rs = $schema->resultset ('Track')->search (
+ { 'me.cd' => { -in => [ $cd_rs->get_column ('cdid')->all ] } },
+ {
+ select => [
+ 'me.cd',
+ { count => 'me.trackid' },
+ ],
+ as => [qw/
+ cd
+ track_count
+ /],
+ group_by => \'SUBSTR(me.cd, 1, 1)',
+ prefetch => 'cd',
+ },
+ );
+
+ is_same_sql_bind (
+ $track_rs->count_rs->as_query,
+ '(
+ SELECT COUNT( * )
+ FROM (
+ SELECT SUBSTR(me.cd, 1, 1)
+ FROM track me
+ JOIN cd cd ON cd.cdid = me.cd
+ WHERE ( me.cd IN ( ?, ?, ?, ?, ? ) )
+ GROUP BY SUBSTR(me.cd, 1, 1)
+ )
+ count_subq
+ )',
+ [ map { [ 'me.cd' => $_] } ($cd_rs->get_column ('cdid')->all) ],
+ 'count() query generated expected SQL',
+ );
+}
+
+{
+ my $cd_rs = $schema->resultset('CD')->search({}, {
+ distinct => 1,
+ join => [qw/ tracks /],
+ prefetch => [qw/ artist /],
+ });
+ is($cd_rs->count, 5, 'complex prefetch + non-prefetching has_many join count correct');
+ is($cd_rs->all, 5, 'complex prefetch + non-prefetching has_many join number of objects correct');
+
+ # make sure join tracks was thrown out
+ is_same_sql_bind (
+ $cd_rs->as_query,
+ '(
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
+ artist.artistid, artist.name, artist.rank, artist.charfield
+ FROM (
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+ FROM cd me
+ JOIN artist artist ON artist.artistid = me.artist
+ GROUP BY me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+ ) me
+ JOIN artist artist ON artist.artistid = me.artist
+ )',
+ [],
+ );
+
+
+
+ # try the same as above, but add a condition so the tracks join can not be thrown away
+ my $cd_rs2 = $cd_rs->search ({ 'tracks.title' => { '!=' => 'ugabuganoexist' } });
+ is($cd_rs2->count, 5, 'complex prefetch + non-prefetching restricted has_many join count correct');
+ is($cd_rs2->all, 5, 'complex prefetch + non-prefetching restricted has_many join number of objects correct');
+
+ # the outer group_by seems like a necessary evil, if someone can figure out how to take it away
+ # without breaking compat - be my guest
+ is_same_sql_bind (
+ $cd_rs2->as_query,
+ '(
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
+ artist.artistid, artist.name, artist.rank, artist.charfield
+ FROM (
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+ FROM cd me
+ LEFT JOIN track tracks ON tracks.cd = me.cdid
+ JOIN artist artist ON artist.artistid = me.artist
+ WHERE ( tracks.title != ? )
+ GROUP BY me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+ ) me
+ LEFT JOIN track tracks ON tracks.cd = me.cdid
+ JOIN artist artist ON artist.artistid = me.artist
+ WHERE ( tracks.title != ? )
+ GROUP BY me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
+ artist.artistid, artist.name, artist.rank, artist.charfield
+ )',
+ [ map { [ 'tracks.title' => 'ugabuganoexist' ] } (1 .. 2) ],
+ );
+}
+
done_testing;
Modified: DBIx-Class/0.08/branches/extended_rels/t/prefetch/multiple_hasmany.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/prefetch/multiple_hasmany.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/prefetch/multiple_hasmany.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -48,18 +48,13 @@
$schema->storage->debug ($sdebug);
is($pr_tracks_count, $tracks_count, 'equal count of prefetched relations over several same level has_many\'s (1 -> M + M)');
+ is ($pr_tracks_rs->all, $tracks_rs->all, 'equal amount of objects returned with and without prefetch over several same level has_many\'s (1 -> M + M)');
- for ($pr_tracks_rs, $tracks_rs) {
- $_->result_class ('DBIx::Class::ResultClass::HashRefInflator');
- }
-
- is_deeply ([$pr_tracks_rs->all], [$tracks_rs->all], 'same structure returned with and without prefetch over several same level has_many\'s (1 -> M + M)');
-
#( M -> 1 -> M + M )
my $note_rs = $schema->resultset('LinerNotes')->search ({ notes => 'Buy Whiskey!' });
my $pr_note_rs = $note_rs->search ({}, {
prefetch => {
- cd => [qw/tags tracks/]
+ cd => [qw/tracks tags/]
},
});
@@ -86,12 +81,7 @@
$schema->storage->debug ($sdebug);
is($pr_tags_count, $tags_count, 'equal count of prefetched relations over several same level has_many\'s (M -> 1 -> M + M)');
-
- for ($pr_tags_rs, $tags_rs) {
- $_->result_class ('DBIx::Class::ResultClass::HashRefInflator');
- }
-
- is_deeply ([$pr_tags_rs->all], [$tags_rs->all], 'same structure returned with and without prefetch over several same level has_many\'s (M -> 1 -> M + M)');
+ is($pr_tags_rs->all, $tags_rs->all, 'equal amount of objects with and without prefetch over several same level has_many\'s (M -> 1 -> M + M)');
}
# remove this closure once the TODO above is working
Modified: DBIx-Class/0.08/branches/extended_rels/t/prefetch/standard.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/prefetch/standard.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/prefetch/standard.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -5,7 +5,6 @@
use Test::Exception;
use lib qw(t/lib);
use DBICTest;
-use Data::Dumper;
use IO::File;
my $schema = DBICTest->init_schema();
@@ -20,8 +19,6 @@
my $search = { 'artist.name' => 'Caterwauler McCrae' };
my $attr = { prefetch => [ qw/artist liner_notes/ ],
order_by => 'me.cdid' };
-my $search_str = Dumper($search);
-my $attr_str = Dumper($attr);
my $rs = $schema->resultset("CD")->search($search, $attr);
my @cd = $rs->all;
Modified: DBIx-Class/0.08/branches/extended_rels/t/resultset/as_query.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/resultset/as_query.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/resultset/as_query.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -3,8 +3,6 @@
use strict;
use warnings FATAL => 'all';
-use Data::Dumper;
-
use Test::More;
plan ( tests => 5 );
Modified: DBIx-Class/0.08/branches/extended_rels/t/search/preserve_original_rs.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/search/preserve_original_rs.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/search/preserve_original_rs.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -8,7 +8,10 @@
use DBIC::SqlMakerTest;
use DBIC::DebugObj;
use DBICTest;
+
+# use Data::Dumper comparisons to avoid mesing with coderefs
use Data::Dumper;
+$Data::Dumper::Sortkeys = 1;
my $schema = DBICTest->init_schema();
Modified: DBIx-Class/0.08/branches/extended_rels/t/search/subquery.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/search/subquery.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/search/subquery.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -3,11 +3,8 @@
use strict;
use warnings;
-use Data::Dumper;
-
use Test::More;
-
use lib qw(t/lib);
use DBICTest;
use DBIC::SqlMakerTest;
@@ -19,6 +16,17 @@
my @tests = (
{
rs => $cdrs,
+ search => \[ "title = ? AND year LIKE ?", 'buahaha', '20%' ],
+ attrs => { rows => 5 },
+ sqlbind => \[
+ "( SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE (title = ? AND year LIKE ?) LIMIT 5)",
+ 'buahaha',
+ '20%',
+ ],
+ },
+
+ {
+ rs => $cdrs,
search => {
artist_id => { 'in' => $art_rs->search({}, { rows => 1 })->get_column( 'id' )->as_query },
},
Copied: DBIx-Class/0.08/branches/extended_rels/t/storage/base.t (from rev 6886, DBIx-Class/0.08/branches/extended_rels/t/92storage.t)
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/storage/base.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/storage/base.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,189 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Warn;
+use lib qw(t/lib);
+use DBICTest;
+use Data::Dumper;
+
+{
+ package DBICTest::ExplodingStorage::Sth;
+ use strict;
+ use warnings;
+
+ sub execute { die "Kablammo!" }
+
+ sub bind_param {}
+
+ package DBICTest::ExplodingStorage;
+ use strict;
+ use warnings;
+ use base 'DBIx::Class::Storage::DBI::SQLite';
+
+ my $count = 0;
+ sub sth {
+ my ($self, $sql) = @_;
+ return bless {}, "DBICTest::ExplodingStorage::Sth" unless $count++;
+ return $self->next::method($sql);
+ }
+
+ sub connected {
+ return 0 if $count == 1;
+ return shift->next::method(@_);
+ }
+}
+
+my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
+
+is( ref($schema->storage), 'DBIx::Class::Storage::DBI::SQLite',
+ 'Storage reblessed correctly into DBIx::Class::Storage::DBI::SQLite' );
+
+my $storage = $schema->storage;
+$storage->ensure_connected;
+
+eval {
+ $schema->storage->throw_exception('test_exception_42');
+};
+like($@, qr/\btest_exception_42\b/, 'basic exception');
+
+eval {
+ $schema->resultset('CD')->search_literal('broken +%$#$1')->all;
+};
+like($@, qr/prepare_cached failed/, 'exception via DBI->HandleError, etc');
+
+bless $storage, "DBICTest::ExplodingStorage";
+$schema->storage($storage);
+
+eval {
+ $schema->resultset('Artist')->create({ name => "Exploding Sheep" });
+};
+
+is($@, "", "Exploding \$sth->execute was caught");
+
+is(1, $schema->resultset('Artist')->search({name => "Exploding Sheep" })->count,
+ "And the STH was retired");
+
+
+# testing various invocations of connect_info ([ ... ])
+
+my $coderef = sub { 42 };
+my $invocations = {
+ 'connect_info ([ $d, $u, $p, \%attr, \%extra_attr])' => {
+ args => [
+ 'foo',
+ 'bar',
+ undef,
+ {
+ on_connect_do => [qw/a b c/],
+ PrintError => 0,
+ },
+ {
+ AutoCommit => 1,
+ on_disconnect_do => [qw/d e f/],
+ },
+ {
+ unsafe => 1,
+ auto_savepoint => 1,
+ },
+ ],
+ dbi_connect_info => [
+ 'foo',
+ 'bar',
+ undef,
+ {
+ %{$storage->_default_dbi_connect_attributes || {} },
+ PrintError => 0,
+ AutoCommit => 1,
+ },
+ ],
+ },
+
+ 'connect_info ([ \%code, \%extra_attr ])' => {
+ args => [
+ $coderef,
+ {
+ on_connect_do => [qw/a b c/],
+ PrintError => 0,
+ AutoCommit => 1,
+ on_disconnect_do => [qw/d e f/],
+ },
+ {
+ unsafe => 1,
+ auto_savepoint => 1,
+ },
+ ],
+ dbi_connect_info => [
+ $coderef,
+ ],
+ },
+
+ 'connect_info ([ \%attr ])' => {
+ args => [
+ {
+ on_connect_do => [qw/a b c/],
+ PrintError => 1,
+ AutoCommit => 0,
+ on_disconnect_do => [qw/d e f/],
+ user => 'bar',
+ dsn => 'foo',
+ },
+ {
+ unsafe => 1,
+ auto_savepoint => 1,
+ },
+ ],
+ dbi_connect_info => [
+ 'foo',
+ 'bar',
+ undef,
+ {
+ %{$storage->_default_dbi_connect_attributes || {} },
+ PrintError => 1,
+ AutoCommit => 0,
+ },
+ ],
+ },
+ 'connect_info ([ \%attr_with_coderef ])' => {
+ args => [ {
+ dbh_maker => $coderef,
+ dsn => 'blah',
+ user => 'bleh',
+ on_connect_do => [qw/a b c/],
+ on_disconnect_do => [qw/d e f/],
+ } ],
+ dbi_connect_info => [
+ $coderef
+ ],
+ warn => qr/Attribute\(s\) 'dsn', 'user' in connect_info were ignored/,
+ },
+};
+
+for my $type (keys %$invocations) {
+
+ # we can not use a cloner portably because of the coderef
+ # so compare dumps instead
+ local $Data::Dumper::Sortkeys = 1;
+ my $arg_dump = Dumper ($invocations->{$type}{args});
+
+ warnings_exist (
+ sub { $storage->connect_info ($invocations->{$type}{args}) },
+ $invocations->{$type}{warn} || (),
+ 'Warned about ignored attributes',
+ );
+
+ is ($arg_dump, Dumper ($invocations->{$type}{args}), "$type didn't modify passed arguments");
+
+ is_deeply ($storage->_dbi_connect_info, $invocations->{$type}{dbi_connect_info}, "$type produced correct _dbi_connect_info");
+ ok ( (not $storage->auto_savepoint and not $storage->unsafe), "$type correctly ignored extra hashref");
+
+ is_deeply (
+ [$storage->on_connect_do, $storage->on_disconnect_do ],
+ [ [qw/a b c/], [qw/d e f/] ],
+ "$type correctly parsed DBIC specific on_[dis]connect_do",
+ );
+}
+
+done_testing;
+
+1;
Copied: DBIx-Class/0.08/branches/extended_rels/t/storage/dbh_do.t (from rev 6886, DBIx-Class/0.08/branches/extended_rels/t/dbh_do.t)
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/storage/dbh_do.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/storage/dbh_do.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+use lib qw(t/lib);
+use DBICTest;
+
+
+my $schema = DBICTest->init_schema();
+my $storage = $schema->storage;
+
+my $test_func = sub {
+ is $_[0], $storage;
+ is $_[1], $storage->dbh;
+ is $_[2], "foo";
+ is $_[3], "bar";
+};
+
+$storage->dbh_do(
+ $test_func,
+ "foo", "bar"
+);
+
+my $storage_class = ref $storage;
+{
+ no strict 'refs';
+ *{$storage_class .'::__test_method'} = $test_func;
+}
+$storage->dbh_do("__test_method", "foo", "bar");
+
+
\ No newline at end of file
Copied: DBIx-Class/0.08/branches/extended_rels/t/storage/dbi_coderef.t (from rev 6886, DBIx-Class/0.08/branches/extended_rels/t/32connect_code_ref.t)
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/storage/dbi_coderef.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/storage/dbi_coderef.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,24 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+plan tests => 1;
+
+# Set up the "usual" sqlite for DBICTest
+my $normal_schema = DBICTest->init_schema( sqlite_use_file => 1 );
+
+# Steal the dsn, which should be like 'dbi:SQLite:t/var/DBIxClass.db'
+my $normal_dsn = $normal_schema->storage->_dbi_connect_info->[0];
+
+# Make sure we have no active connection
+$normal_schema->storage->disconnect;
+
+# Make a new clone with a new connection, using a code reference
+my $code_ref_schema = $normal_schema->connect(sub { DBI->connect($normal_dsn); });
+
+# Stolen from 60core.t - this just verifies things seem to work at all
+my @art = $code_ref_schema->resultset("Artist")->search({ }, { order_by => 'name DESC'});
+cmp_ok(@art, '==', 3, "Three artists returned");
Copied: DBIx-Class/0.08/branches/extended_rels/t/storage/debug.t (from rev 6886, DBIx-Class/0.08/branches/extended_rels/t/91debug.t)
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/storage/debug.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/storage/debug.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,73 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::DebugObj;
+use DBIC::SqlMakerTest;
+
+my $schema = DBICTest->init_schema();
+
+plan tests => 7;
+
+ok ( $schema->storage->debug(1), 'debug' );
+ok ( defined(
+ $schema->storage->debugfh(
+ IO::File->new('t/var/sql.log', 'w')
+ )
+ ),
+ 'debugfh'
+ );
+
+$schema->storage->debugfh->autoflush(1);
+my $rs = $schema->resultset('CD')->search({});
+$rs->count();
+
+my $log = new IO::File('t/var/sql.log', 'r') or die($!);
+my $line = <$log>;
+$log->close();
+ok($line =~ /^SELECT COUNT/, 'Log success');
+
+$schema->storage->debugfh(undef);
+$ENV{'DBIC_TRACE'} = '=t/var/foo.log';
+$rs = $schema->resultset('CD')->search({});
+$rs->count();
+$log = new IO::File('t/var/foo.log', 'r') or die($!);
+$line = <$log>;
+$log->close();
+ok($line =~ /^SELECT COUNT/, 'Log success');
+$schema->storage->debugobj->debugfh(undef);
+delete($ENV{'DBIC_TRACE'});
+open(STDERRCOPY, '>&STDERR');
+stat(STDERRCOPY); # nop to get warnings quiet
+close(STDERR);
+eval {
+ $rs = $schema->resultset('CD')->search({});
+ $rs->count();
+};
+ok($@, 'Died on closed FH');
+open(STDERR, '>&STDERRCOPY');
+
+# test trace output correctness for bind params
+{
+ my ($sql, @bind);
+ $schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind));
+
+ my @cds = $schema->resultset('CD')->search( { artist => 1, cdid => { -between => [ 1, 3 ] }, } );
+ is_same_sql_bind(
+ $sql, \@bind,
+ "SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE ( artist = ? AND (cdid BETWEEN ? AND ?) ): '1', '1', '3'",
+ [qw/'1' '1' '3'/],
+ 'got correct SQL with all bind parameters (debugcb)'
+ );
+
+ @cds = $schema->resultset('CD')->search( { artist => 1, cdid => { -between => [ 1, 3 ] }, } );
+ is_same_sql_bind(
+ $sql, \@bind,
+ "SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE ( artist = ? AND (cdid BETWEEN ? AND ?) )", ["'1'", "'1'", "'3'"],
+ 'got correct SQL with all bind parameters (debugobj)'
+ );
+}
+
+1;
Copied: DBIx-Class/0.08/branches/extended_rels/t/storage/disable_sth_caching.t (from rev 6886, DBIx-Class/0.08/branches/extended_rels/t/35disable_sth_caching.t)
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/storage/disable_sth_caching.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/storage/disable_sth_caching.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+plan tests => 2;
+
+# Set up the "usual" sqlite for DBICTest
+my $schema = DBICTest->init_schema;
+
+my $sth_one = $schema->storage->sth('SELECT 42');
+my $sth_two = $schema->storage->sth('SELECT 42');
+$schema->storage->disable_sth_caching(1);
+my $sth_three = $schema->storage->sth('SELECT 42');
+
+ok($sth_one == $sth_two, "statement caching works");
+ok($sth_two != $sth_three, "disabling statement caching works");
Copied: DBIx-Class/0.08/branches/extended_rels/t/storage/error.t (from rev 6886, DBIx-Class/0.08/branches/extended_rels/t/18inserterror.t)
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/storage/error.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/storage/error.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,29 @@
+use Class::C3;
+use strict;
+use Test::More;
+use warnings;
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@
+ ? ( skip_all => 'needs DBD::SQLite for testing' )
+ : ( tests => 4 );
+}
+
+use lib qw(t/lib);
+
+use_ok( 'DBICTest' );
+use_ok( 'DBICTest::Schema' );
+my $schema = DBICTest->init_schema;
+
+{
+ my $warnings;
+ local $SIG{__WARN__} = sub { $warnings .= $_[0] };
+ eval {
+ $schema->resultset('CD')
+ ->create({ title => 'vacation in antarctica' })
+ };
+ like $@, qr/NULL/; # as opposed to some other error
+ unlike( $warnings, qr/uninitialized value/, "No warning from Storage" );
+}
+
Added: DBIx-Class/0.08/branches/extended_rels/t/storage/exception.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/storage/exception.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/storage/exception.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::Schema;
+
+# make sure nothing eats the exceptions (an unchecked eval in Storage::DESTROY used to be a problem)
+
+{
+ package Dying::Storage;
+
+ use warnings;
+ use strict;
+
+ use base 'DBIx::Class::Storage::DBI';
+
+ sub _populate_dbh {
+ my $self = shift;
+ my $death = $self->_dbi_connect_info->[3]{die};
+
+ die "storage test died: $death" if $death eq 'before_populate';
+ my $ret = $self->next::method (@_);
+ die "storage test died: $death" if $death eq 'after_populate';
+
+ return $ret;
+ }
+}
+
+for (qw/before_populate after_populate/) {
+ dies_ok (sub {
+ my $schema = DBICTest::Schema->clone;
+ $schema->storage_type ('Dying::Storage');
+ $schema->connection (DBICTest->_database, { die => $_ });
+ $schema->storage->ensure_connected;
+ }, "$_ exception found");
+}
+
+done_testing;
Copied: DBIx-Class/0.08/branches/extended_rels/t/storage/on_connect_call.t (from rev 6886, DBIx-Class/0.08/branches/extended_rels/t/92storage_on_connect_call.t)
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/storage/on_connect_call.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/storage/on_connect_call.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,69 @@
+use strict;
+use warnings;
+no warnings qw/once redefine/;
+
+use lib qw(t/lib);
+use DBICTest;
+
+use Test::More tests => 9;
+
+use DBIx::Class::Storage::DBI;
+my $schema = DBICTest->init_schema(
+ no_connect => 1,
+ no_deploy => 1,
+);
+
+local *DBIx::Class::Storage::DBI::connect_call_foo = sub {
+ isa_ok $_[0], 'DBIx::Class::Storage::DBI',
+ 'got storage in connect_call method';
+ is $_[1], 'bar', 'got param in connect_call method';
+};
+
+local *DBIx::Class::Storage::DBI::disconnect_call_foo = sub {
+ isa_ok $_[0], 'DBIx::Class::Storage::DBI',
+ 'got storage in disconnect_call method';
+};
+
+ok $schema->connection(
+ DBICTest->_database,
+ {
+ on_connect_call => [
+ [ do_sql => 'create table test1 (id integer)' ],
+ [ do_sql => [ 'insert into test1 values (?)', {}, 1 ] ],
+ [ do_sql => sub { ['insert into test1 values (2)'] } ],
+ [ sub { $_[0]->dbh->do($_[1]) }, 'insert into test1 values (3)' ],
+ # this invokes $storage->connect_call_foo('bar') (above)
+ [ foo => 'bar' ],
+ ],
+ on_connect_do => 'insert into test1 values (4)',
+ on_disconnect_call => 'foo',
+ },
+), 'connection()';
+
+is_deeply (
+ $schema->storage->dbh->selectall_arrayref('select * from test1'),
+ [ [ 1 ], [ 2 ], [ 3 ], [ 4 ] ],
+ 'on_connect_call/do actions worked'
+);
+
+local *DBIx::Class::Storage::DBI::connect_call_foo = sub {
+ isa_ok $_[0], 'DBIx::Class::Storage::DBI',
+ 'got storage in connect_call method';
+};
+
+local *DBIx::Class::Storage::DBI::connect_call_bar = sub {
+ isa_ok $_[0], 'DBIx::Class::Storage::DBI',
+ 'got storage in connect_call method';
+};
+
+$schema->storage->disconnect;
+
+ok $schema->connection(
+ DBICTest->_database,
+ {
+ # method list form
+ on_connect_call => [ 'foo', sub { ok 1, "coderef in list form" }, 'bar' ],
+ },
+), 'connection()';
+
+$schema->storage->ensure_connected;
Copied: DBIx-Class/0.08/branches/extended_rels/t/storage/on_connect_do.t (from rev 6886, DBIx-Class/0.08/branches/extended_rels/t/92storage_on_connect_do.t)
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/storage/on_connect_do.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/storage/on_connect_do.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,88 @@
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+
+use lib qw(t/lib);
+use base 'DBICTest';
+
+
+my $schema = DBICTest->init_schema(
+ no_connect => 1,
+ no_deploy => 1,
+);
+
+ok $schema->connection(
+ DBICTest->_database,
+ {
+ on_connect_do => 'CREATE TABLE TEST_empty (id INTEGER)',
+ },
+), 'connection()';
+
+is_deeply (
+ $schema->storage->dbh->selectall_arrayref('SELECT * FROM TEST_empty'),
+ [],
+ 'string version on_connect_do() worked'
+);
+
+$schema->storage->disconnect;
+
+ok $schema->connection(
+ DBICTest->_database,
+ {
+ on_connect_do => [
+ 'CREATE TABLE TEST_empty (id INTEGER)',
+ [ 'INSERT INTO TEST_empty VALUES (?)', {}, 2 ],
+ \&insert_from_subref,
+ ],
+ on_disconnect_do =>
+ [\&check_exists, 'DROP TABLE TEST_empty', \&check_dropped],
+ },
+), 'connection()';
+
+is_deeply (
+ $schema->storage->dbh->selectall_arrayref('SELECT * FROM TEST_empty'),
+ [ [ 2 ], [ 3 ], [ 7 ] ],
+ 'on_connect_do() worked'
+);
+eval { $schema->storage->dbh->do('SELECT 1 FROM TEST_nonexistent'); };
+ok $@, 'Searching for nonexistent table dies';
+
+$schema->storage->disconnect();
+
+my($connected, $disconnected, @cb_args);
+ok $schema->connection(
+ DBICTest->_database,
+ {
+ on_connect_do => sub { $connected = 1; @cb_args = @_; },
+ on_disconnect_do => sub { $disconnected = 1 },
+ },
+), 'second connection()';
+$schema->storage->dbh->do('SELECT 1');
+ok $connected, 'on_connect_do() called after connect()';
+ok ! $disconnected, 'on_disconnect_do() not called after connect()';
+$schema->storage->disconnect();
+ok $disconnected, 'on_disconnect_do() called after disconnect()';
+
+isa_ok($cb_args[0], 'DBIx::Class::Storage', 'first arg to on_connect_do hook');
+
+sub check_exists {
+ my $storage = shift;
+ ok $storage->dbh->do('SELECT 1 FROM TEST_empty'), 'Table still exists';
+ return;
+}
+
+sub check_dropped {
+ my $storage = shift;
+ eval { $storage->dbh->do('SELECT 1 FROM TEST_empty'); };
+ ok $@, 'Reading from dropped table fails';
+ return;
+}
+
+sub insert_from_subref {
+ my $storage = shift;
+ return [
+ [ 'INSERT INTO TEST_empty VALUES (?)', {}, 3 ],
+ 'INSERT INTO TEST_empty VALUES (7)',
+ ];
+}
Added: DBIx-Class/0.08/branches/extended_rels/t/storage/ping_count.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/storage/ping_count.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/storage/ping_count.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,60 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+my $ping_count = 0;
+
+{
+ local $SIG{__WARN__} = sub {};
+ require DBIx::Class::Storage::DBI;
+
+ my $ping = \&DBIx::Class::Storage::DBI::_ping;
+
+ *DBIx::Class::Storage::DBI::_ping = sub {
+ $ping_count++;
+ goto &$ping;
+ };
+}
+
+
+# measure pings around deploy() separately
+my $schema = DBICTest->init_schema( sqlite_use_file => 1, no_populate => 1 );
+
+is ($ping_count, 0, 'no _ping() calls during deploy');
+$ping_count = 0;
+
+
+
+DBICTest->populate_schema ($schema);
+
+# perform some operations and make sure they don't ping
+
+$schema->resultset('CD')->create({
+ cdid => 6, artist => 3, title => 'mtfnpy', year => 2009
+});
+
+$schema->resultset('CD')->create({
+ cdid => 7, artist => 3, title => 'mtfnpy2', year => 2009
+});
+
+$schema->storage->_dbh->disconnect;
+
+$schema->resultset('CD')->create({
+ cdid => 8, artist => 3, title => 'mtfnpy3', year => 2009
+});
+
+$schema->storage->_dbh->disconnect;
+
+$schema->txn_do(sub {
+ $schema->resultset('CD')->create({
+ cdid => 9, artist => 3, title => 'mtfnpy4', year => 2009
+ });
+});
+
+is $ping_count, 0, 'no _ping() calls';
+
+done_testing;
Copied: DBIx-Class/0.08/branches/extended_rels/t/storage/reconnect.t (from rev 6886, DBIx-Class/0.08/branches/extended_rels/t/33storage_reconnect.t)
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/storage/reconnect.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/storage/reconnect.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,73 @@
+use strict;
+use warnings;
+
+use FindBin;
+use File::Copy;
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+plan tests => 6;
+
+my $db_orig = "$FindBin::Bin/../var/DBIxClass.db";
+my $db_tmp = "$db_orig.tmp";
+
+# Set up the "usual" sqlite for DBICTest
+my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
+
+# Make sure we're connected by doing something
+my @art = $schema->resultset("Artist")->search({ }, { order_by => 'name DESC'});
+cmp_ok(@art, '==', 3, "Three artists returned");
+
+# Disconnect the dbh, and be sneaky about it
+# Also test if DBD::SQLite finaly knows how to ->disconnect properly
+{
+ my $w;
+ local $SIG{__WARN__} = sub { $w = shift };
+ $schema->storage->_dbh->disconnect;
+ ok ($w !~ /active statement handles/, 'SQLite can disconnect properly');
+}
+
+# Try the operation again - What should happen here is:
+# 1. S::DBI blindly attempts the SELECT, which throws an exception
+# 2. It catches the exception, checks ->{Active}/->ping, sees the disconnected state...
+# 3. Reconnects, and retries the operation
+# 4. Success!
+my @art_two = $schema->resultset("Artist")->search({ }, { order_by => 'name DESC'});
+cmp_ok(@art_two, '==', 3, "Three artists returned");
+
+### Now, disconnect the dbh, and move the db file;
+# create a new one and chmod 000 to prevent SQLite from connecting.
+$schema->storage->_dbh->disconnect;
+move( $db_orig, $db_tmp );
+open DBFILE, '>', $db_orig;
+print DBFILE 'THIS IS NOT A REAL DATABASE';
+close DBFILE;
+chmod 0000, $db_orig;
+
+### Try the operation again... it should fail, since there's no db
+{
+ # Catch the DBI connection error
+ local $SIG{__WARN__} = sub {};
+ eval {
+ my @art_three = $schema->resultset("Artist")->search( {}, { order_by => 'name DESC' } );
+ };
+ ok( $@, 'The operation failed' );
+}
+
+### Now, move the db file back to the correct name
+unlink($db_orig);
+move( $db_tmp, $db_orig );
+
+SKIP: {
+ skip "Cannot reconnect if original connection didn't fail", 2
+ if ( $@ =~ /encrypted or is not a database/ );
+
+ ### Try the operation again... this time, it should succeed
+ my @art_four;
+ eval {
+ @art_four = $schema->resultset("Artist")->search( {}, { order_by => 'name DESC' } );
+ };
+ ok( !$@, 'The operation succeeded' );
+ cmp_ok( @art_four, '==', 3, "Three artists returned" );
+}
Copied: DBIx-Class/0.08/branches/extended_rels/t/storage/replication.t (from rev 7255, DBIx-Class/0.08/branches/extended_rels/t/93storage_replication.t)
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/storage/replication.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/storage/replication.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,853 @@
+use strict;
+use warnings;
+use lib qw(t/lib);
+use Test::More;
+use Test::Exception;
+use DBICTest;
+use List::Util 'first';
+use Scalar::Util 'reftype';
+use File::Spec;
+use IO::Handle;
+
+BEGIN {
+ eval "use DBIx::Class::Storage::DBI::Replicated; use Test::Moose";
+ plan skip_all => "Deps not installed: $@" if $@;
+}
+
+use_ok 'DBIx::Class::Storage::DBI::Replicated::Pool';
+use_ok 'DBIx::Class::Storage::DBI::Replicated::Balancer';
+use_ok 'DBIx::Class::Storage::DBI::Replicated::Replicant';
+use_ok 'DBIx::Class::Storage::DBI::Replicated';
+
+use Moose();
+use MooseX::Types();
+diag "Using Moose version $Moose::VERSION and MooseX::Types version $MooseX::Types::VERSION";
+
+=head1 HOW TO USE
+
+ This is a test of the replicated storage system. This will work in one of
+ two ways, either it was try to fake replication with a couple of SQLite DBs
+ and creative use of copy, or if you define a couple of %ENV vars correctly
+ will try to test those. If you do that, it will assume the setup is properly
+ replicating. Your results may vary, but I have demonstrated this to work with
+ mysql native replication.
+
+=cut
+
+
+## ----------------------------------------------------------------------------
+## Build a class to hold all our required testing data and methods.
+## ----------------------------------------------------------------------------
+
+TESTSCHEMACLASSES: {
+
+ ## --------------------------------------------------------------------- ##
+ ## Create an object to contain your replicated stuff.
+ ## --------------------------------------------------------------------- ##
+
+ package DBIx::Class::DBI::Replicated::TestReplication;
+
+ use DBICTest;
+ use base qw/Class::Accessor::Fast/;
+
+ __PACKAGE__->mk_accessors( qw/schema/ );
+
+ ## Initialize the object
+
+ sub new {
+ my ($class, $schema_method) = (shift, shift);
+ my $self = $class->SUPER::new(@_);
+
+ $self->schema( $self->init_schema($schema_method) );
+ return $self;
+ }
+
+ ## Get the Schema and set the replication storage type
+
+ sub init_schema {
+ # current SQLT SQLite producer does not handle DROP TABLE IF EXISTS, trap warnings here
+ local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /no such table.+DROP TABLE/ };
+
+ my ($class, $schema_method) = @_;
+
+ my $method = "get_schema_$schema_method";
+ my $schema = $class->$method;
+
+ return $schema;
+ }
+
+ sub get_schema_by_storage_type {
+ DBICTest->init_schema(
+ sqlite_use_file => 1,
+ storage_type=>{
+ '::DBI::Replicated' => {
+ balancer_type=>'::Random',
+ balancer_args=>{
+ auto_validate_every=>100,
+ master_read_weight => 1
+ },
+ }
+ },
+ deploy_args=>{
+ add_drop_table => 1,
+ },
+ );
+ }
+
+ sub get_schema_by_connect_info {
+ DBICTest->init_schema(
+ sqlite_use_file => 1,
+ storage_type=> '::DBI::Replicated',
+ balancer_type=>'::Random',
+ balancer_args=> {
+ auto_validate_every=>100,
+ master_read_weight => 1
+ },
+ deploy_args=>{
+ add_drop_table => 1,
+ },
+ );
+ }
+
+ sub generate_replicant_connect_info {}
+ sub replicate {}
+ sub cleanup {}
+
+ ## --------------------------------------------------------------------- ##
+ ## Add a connect_info option to test option merging.
+ ## --------------------------------------------------------------------- ##
+ {
+ package DBIx::Class::Storage::DBI::Replicated;
+
+ use Moose;
+
+ __PACKAGE__->meta->make_mutable;
+
+ around connect_info => sub {
+ my ($next, $self, $info) = @_;
+ $info->[3]{master_option} = 1;
+ $self->$next($info);
+ };
+
+ __PACKAGE__->meta->make_immutable;
+
+ no Moose;
+ }
+
+ ## --------------------------------------------------------------------- ##
+ ## Subclass for when you are using SQLite for testing, this provides a fake
+ ## replication support.
+ ## --------------------------------------------------------------------- ##
+
+ package DBIx::Class::DBI::Replicated::TestReplication::SQLite;
+
+ use DBICTest;
+ use File::Copy;
+ use base 'DBIx::Class::DBI::Replicated::TestReplication';
+
+ __PACKAGE__->mk_accessors(qw/master_path slave_paths/);
+
+ ## Set the master path from DBICTest
+
+ sub new {
+ my $class = shift @_;
+ my $self = $class->SUPER::new(@_);
+
+ $self->master_path( DBICTest->_sqlite_dbfilename );
+ $self->slave_paths([
+ File::Spec->catfile(qw/t var DBIxClass_slave1.db/),
+ File::Spec->catfile(qw/t var DBIxClass_slave2.db/),
+ ]);
+
+ return $self;
+ }
+
+ ## Return an Array of ArrayRefs where each ArrayRef is suitable to use for
+ ## $storage->connect_info to be used for connecting replicants.
+
+ sub generate_replicant_connect_info {
+ my $self = shift @_;
+ my @dsn = map {
+ "dbi:SQLite:${_}";
+ } @{$self->slave_paths};
+
+ my @connect_infos = map { [$_,'','',{AutoCommit=>1}] } @dsn;
+
+ ## Make sure nothing is left over from a failed test
+ $self->cleanup;
+
+ ## try a hashref too
+ my $c = $connect_infos[0];
+ $connect_infos[0] = {
+ dsn => $c->[0],
+ user => $c->[1],
+ password => $c->[2],
+ %{ $c->[3] }
+ };
+
+ @connect_infos
+ }
+
+ ## Do a 'good enough' replication by copying the master dbfile over each of
+ ## the slave dbfiles. If the master is SQLite we do this, otherwise we
+ ## just do a one second pause to let the slaves catch up.
+
+ sub replicate {
+ my $self = shift @_;
+ foreach my $slave (@{$self->slave_paths}) {
+ copy($self->master_path, $slave);
+ }
+ }
+
+ ## Cleanup after ourselves. Unlink all gthe slave paths.
+
+ sub cleanup {
+ my $self = shift @_;
+ foreach my $slave (@{$self->slave_paths}) {
+ if(-e $slave) {
+ unlink $slave;
+ }
+ }
+ }
+
+ ## --------------------------------------------------------------------- ##
+ ## Subclass for when you are setting the databases via custom export vars
+ ## This is for when you have a replicating database setup that you are
+ ## going to test against. You'll need to define the correct $ENV and have
+ ## two slave databases to test against, as well as a replication system
+ ## that will replicate in less than 1 second.
+ ## --------------------------------------------------------------------- ##
+
+ package DBIx::Class::DBI::Replicated::TestReplication::Custom;
+ use base 'DBIx::Class::DBI::Replicated::TestReplication';
+
+ ## Return an Array of ArrayRefs where each ArrayRef is suitable to use for
+ ## $storage->connect_info to be used for connecting replicants.
+
+ sub generate_replicant_connect_info {
+ return (
+ [$ENV{"DBICTEST_SLAVE0_DSN"}, $ENV{"DBICTEST_SLAVE0_DBUSER"}, $ENV{"DBICTEST_SLAVE0_DBPASS"}, {AutoCommit => 1}],
+ [$ENV{"DBICTEST_SLAVE1_DSN"}, $ENV{"DBICTEST_SLAVE1_DBUSER"}, $ENV{"DBICTEST_SLAVE1_DBPASS"}, {AutoCommit => 1}],
+ );
+ }
+
+ ## pause a bit to let the replication catch up
+
+ sub replicate {
+ sleep 1;
+ }
+}
+
+## ----------------------------------------------------------------------------
+## Create an object and run some tests
+## ----------------------------------------------------------------------------
+
+## Thi first bunch of tests are basic, just make sure all the bits are behaving
+
+my $replicated_class = DBICTest->has_custom_dsn ?
+ 'DBIx::Class::DBI::Replicated::TestReplication::Custom' :
+ 'DBIx::Class::DBI::Replicated::TestReplication::SQLite';
+
+my $replicated;
+
+for my $method (qw/by_connect_info by_storage_type/) {
+ undef $replicated;
+ ok $replicated = $replicated_class->new($method)
+ => "Created a replication object $method";
+
+ isa_ok $replicated->schema
+ => 'DBIx::Class::Schema';
+
+ isa_ok $replicated->schema->storage
+ => 'DBIx::Class::Storage::DBI::Replicated';
+
+ isa_ok $replicated->schema->storage->balancer
+ => 'DBIx::Class::Storage::DBI::Replicated::Balancer::Random'
+ => 'configured balancer_type';
+}
+
+ok $replicated->schema->storage->meta
+ => 'has a meta object';
+
+isa_ok $replicated->schema->storage->master
+ => 'DBIx::Class::Storage::DBI';
+
+isa_ok $replicated->schema->storage->pool
+ => 'DBIx::Class::Storage::DBI::Replicated::Pool';
+
+does_ok $replicated->schema->storage->balancer
+ => 'DBIx::Class::Storage::DBI::Replicated::Balancer';
+
+ok my @replicant_connects = $replicated->generate_replicant_connect_info
+ => 'got replication connect information';
+
+ok my @replicated_storages = $replicated->schema->storage->connect_replicants(@replicant_connects)
+ => 'Created some storages suitable for replicants';
+
+our %debug;
+$replicated->schema->storage->debug(1);
+$replicated->schema->storage->debugcb(sub {
+ my ($op, $info) = @_;
+ ##warn "\n$op, $info\n";
+ %debug = (
+ op => $op,
+ info => $info,
+ dsn => ($info=~m/\[(.+)\]/)[0],
+ storage_type => $info=~m/REPLICANT/ ? 'REPLICANT' : 'MASTER',
+ );
+});
+
+ok my @all_storages = $replicated->schema->storage->all_storages
+ => '->all_storages';
+
+is scalar @all_storages,
+ 3
+ => 'correct number of ->all_storages';
+
+is ((grep $_->isa('DBIx::Class::Storage::DBI'), @all_storages),
+ 3
+ => '->all_storages are correct type');
+
+my @all_storage_opts =
+ grep { (reftype($_)||'') eq 'HASH' }
+ map @{ $_->_connect_info }, @all_storages;
+
+is ((grep $_->{master_option}, @all_storage_opts),
+ 3
+ => 'connect_info was merged from master to replicants');
+
+my @replicant_names = keys %{ $replicated->schema->storage->replicants };
+
+ok @replicant_names, "found replicant names @replicant_names";
+
+## Silence warning about not supporting the is_replicating method if using the
+## sqlite dbs.
+$replicated->schema->storage->debugobj->silence(1)
+ if first { m{^t/} } @replicant_names;
+
+isa_ok $replicated->schema->storage->balancer->current_replicant
+ => 'DBIx::Class::Storage::DBI';
+
+$replicated->schema->storage->debugobj->silence(0);
+
+ok $replicated->schema->storage->pool->has_replicants
+ => 'does have replicants';
+
+is $replicated->schema->storage->pool->num_replicants => 2
+ => 'has two replicants';
+
+does_ok $replicated_storages[0]
+ => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
+
+does_ok $replicated_storages[1]
+ => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
+
+does_ok $replicated->schema->storage->replicants->{$replicant_names[0]}
+ => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
+
+does_ok $replicated->schema->storage->replicants->{$replicant_names[1]}
+ => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
+
+## Add some info to the database
+
+$replicated
+ ->schema
+ ->populate('Artist', [
+ [ qw/artistid name/ ],
+ [ 4, "Ozric Tentacles"],
+ ]);
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
+ like $debug{info}, qr/INSERT/, 'Last was an insert';
+
+## Make sure all the slaves have the table definitions
+
+$replicated->replicate;
+$replicated->schema->storage->replicants->{$replicant_names[0]}->active(1);
+$replicated->schema->storage->replicants->{$replicant_names[1]}->active(1);
+
+## Silence warning about not supporting the is_replicating method if using the
+## sqlite dbs.
+$replicated->schema->storage->debugobj->silence(1)
+ if first { m{^t/} } @replicant_names;
+
+$replicated->schema->storage->pool->validate_replicants;
+
+$replicated->schema->storage->debugobj->silence(0);
+
+## Make sure we can read the data.
+
+ok my $artist1 = $replicated->schema->resultset('Artist')->find(4)
+ => 'Created Result';
+
+## We removed testing here since master read weight is on, so we can't tell in
+## advance what storage to expect. We turn master read weight off a bit lower
+## is $debug{storage_type}, 'REPLICANT'
+## => "got last query from a replicant: $debug{dsn}, $debug{info}";
+
+isa_ok $artist1
+ => 'DBICTest::Artist';
+
+is $artist1->name, 'Ozric Tentacles'
+ => 'Found expected name for first result';
+
+## Check that master_read_weight is honored
+{
+ no warnings qw/once redefine/;
+
+ local
+ *DBIx::Class::Storage::DBI::Replicated::Balancer::Random::_random_number =
+ sub { 999 };
+
+ $replicated->schema->storage->balancer->increment_storage;
+
+ is $replicated->schema->storage->balancer->current_replicant,
+ $replicated->schema->storage->master
+ => 'master_read_weight is honored';
+
+ ## turn it off for the duration of the test
+ $replicated->schema->storage->balancer->master_read_weight(0);
+ $replicated->schema->storage->balancer->increment_storage;
+}
+
+## Add some new rows that only the master will have This is because
+## we overload any type of write operation so that is must hit the master
+## database.
+
+$replicated
+ ->schema
+ ->populate('Artist', [
+ [ qw/artistid name/ ],
+ [ 5, "Doom's Children"],
+ [ 6, "Dead On Arrival"],
+ [ 7, "Watergate"],
+ ]);
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
+ like $debug{info}, qr/INSERT/, 'Last was an insert';
+
+## Make sure all the slaves have the table definitions
+$replicated->replicate;
+
+## Should find some data now
+
+ok my $artist2 = $replicated->schema->resultset('Artist')->find(5)
+ => 'Sync succeed';
+
+is $debug{storage_type}, 'REPLICANT'
+ => "got last query from a replicant: $debug{dsn}";
+
+isa_ok $artist2
+ => 'DBICTest::Artist';
+
+is $artist2->name, "Doom's Children"
+ => 'Found expected name for first result';
+
+## What happens when we disconnect all the replicants?
+
+is $replicated->schema->storage->pool->connected_replicants => 2
+ => "both replicants are connected";
+
+$replicated->schema->storage->replicants->{$replicant_names[0]}->disconnect;
+$replicated->schema->storage->replicants->{$replicant_names[1]}->disconnect;
+
+is $replicated->schema->storage->pool->connected_replicants => 0
+ => "both replicants are now disconnected";
+
+## All these should pass, since the database should automatically reconnect
+
+ok my $artist3 = $replicated->schema->resultset('Artist')->find(6)
+ => 'Still finding stuff.';
+
+is $debug{storage_type}, 'REPLICANT'
+ => "got last query from a replicant: $debug{dsn}";
+
+isa_ok $artist3
+ => 'DBICTest::Artist';
+
+is $artist3->name, "Dead On Arrival"
+ => 'Found expected name for first result';
+
+is $replicated->schema->storage->pool->connected_replicants => 1
+ => "At Least One replicant reconnected to handle the job";
+
+## What happens when we try to select something that doesn't exist?
+
+ok ! $replicated->schema->resultset('Artist')->find(666)
+ => 'Correctly failed to find something.';
+
+is $debug{storage_type}, 'REPLICANT'
+ => "got last query from a replicant: $debug{dsn}";
+
+## test the reliable option
+
+TESTRELIABLE: {
+
+ $replicated->schema->storage->set_reliable_storage;
+
+ ok $replicated->schema->resultset('Artist')->find(2)
+ => 'Read from master 1';
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
+ ok $replicated->schema->resultset('Artist')->find(5)
+ => 'Read from master 2';
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
+ $replicated->schema->storage->set_balanced_storage;
+
+ ok $replicated->schema->resultset('Artist')->find(3)
+ => 'Read from replicant';
+
+ is $debug{storage_type}, 'REPLICANT',
+ "got last query from a replicant: $debug{dsn}";
+}
+
+## Make sure when reliable goes out of scope, we are using replicants again
+
+ok $replicated->schema->resultset('Artist')->find(1)
+ => 'back to replicant 1.';
+
+ is $debug{storage_type}, 'REPLICANT',
+ "got last query from a replicant: $debug{dsn}";
+
+ok $replicated->schema->resultset('Artist')->find(2)
+ => 'back to replicant 2.';
+
+ is $debug{storage_type}, 'REPLICANT',
+ "got last query from a replicant: $debug{dsn}";
+
+## set all the replicants to inactive, and make sure the balancer falls back to
+## the master.
+
+$replicated->schema->storage->replicants->{$replicant_names[0]}->active(0);
+$replicated->schema->storage->replicants->{$replicant_names[1]}->active(0);
+
+{
+ ## catch the fallback to master warning
+ open my $debugfh, '>', \my $fallback_warning;
+ my $oldfh = $replicated->schema->storage->debugfh;
+ $replicated->schema->storage->debugfh($debugfh);
+
+ ok $replicated->schema->resultset('Artist')->find(2)
+ => 'Fallback to master';
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
+ like $fallback_warning, qr/falling back to master/
+ => 'emits falling back to master warning';
+
+ $replicated->schema->storage->debugfh($oldfh);
+}
+
+$replicated->schema->storage->replicants->{$replicant_names[0]}->active(1);
+$replicated->schema->storage->replicants->{$replicant_names[1]}->active(1);
+
+## Silence warning about not supporting the is_replicating method if using the
+## sqlite dbs.
+$replicated->schema->storage->debugobj->silence(1)
+ if first { m{^t/} } @replicant_names;
+
+$replicated->schema->storage->pool->validate_replicants;
+
+$replicated->schema->storage->debugobj->silence(0);
+
+ok $replicated->schema->resultset('Artist')->find(2)
+ => 'Returned to replicates';
+
+is $debug{storage_type}, 'REPLICANT',
+ "got last query from a replicant: $debug{dsn}";
+
+## Getting slave status tests
+
+SKIP: {
+ ## We skip this tests unless you have a custom replicants, since the default
+ ## sqlite based replication tests don't support these functions.
+
+ skip 'Cannot Test Replicant Status on Non Replicating Database', 10
+ unless DBICTest->has_custom_dsn && $ENV{"DBICTEST_SLAVE0_DSN"};
+
+ $replicated->replicate; ## Give the slaves a chance to catchup.
+
+ ok $replicated->schema->storage->replicants->{$replicant_names[0]}->is_replicating
+ => 'Replicants are replicating';
+
+ is $replicated->schema->storage->replicants->{$replicant_names[0]}->lag_behind_master, 0
+ => 'Replicant is zero seconds behind master';
+
+ ## Test the validate replicants
+
+ $replicated->schema->storage->pool->validate_replicants;
+
+ is $replicated->schema->storage->pool->active_replicants, 2
+ => 'Still have 2 replicants after validation';
+
+ ## Force the replicants to fail the validate test by required their lag to
+ ## be negative (ie ahead of the master!)
+
+ $replicated->schema->storage->pool->maximum_lag(-10);
+ $replicated->schema->storage->pool->validate_replicants;
+
+ is $replicated->schema->storage->pool->active_replicants, 0
+ => 'No way a replicant be be ahead of the master';
+
+ ## Let's be fair to the replicants again. Let them lag up to 5
+
+ $replicated->schema->storage->pool->maximum_lag(5);
+ $replicated->schema->storage->pool->validate_replicants;
+
+ is $replicated->schema->storage->pool->active_replicants, 2
+ => 'Both replicants in good standing again';
+
+ ## Check auto validate
+
+ is $replicated->schema->storage->balancer->auto_validate_every, 100
+ => "Got the expected value for auto validate";
+
+ ## This will make sure we auto validatge everytime
+ $replicated->schema->storage->balancer->auto_validate_every(0);
+
+ ## set all the replicants to inactive, and make sure the balancer falls back to
+ ## the master.
+
+ $replicated->schema->storage->replicants->{$replicant_names[0]}->active(0);
+ $replicated->schema->storage->replicants->{$replicant_names[1]}->active(0);
+
+ ## Ok, now when we go to run a query, autovalidate SHOULD reconnect
+
+ is $replicated->schema->storage->pool->active_replicants => 0
+ => "both replicants turned off";
+
+ ok $replicated->schema->resultset('Artist')->find(5)
+ => 'replicant reactivated';
+
+ is $debug{storage_type}, 'REPLICANT',
+ "got last query from a replicant: $debug{dsn}";
+
+ is $replicated->schema->storage->pool->active_replicants => 2
+ => "both replicants reactivated";
+}
+
+## Test the reliably callback
+
+ok my $reliably = sub {
+
+ ok $replicated->schema->resultset('Artist')->find(5)
+ => 'replicant reactivated';
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
+} => 'created coderef properly';
+
+$replicated->schema->storage->execute_reliably($reliably);
+
+## Try something with an error
+
+ok my $unreliably = sub {
+
+ ok $replicated->schema->resultset('ArtistXX')->find(5)
+ => 'replicant reactivated';
+
+} => 'created coderef properly';
+
+throws_ok {$replicated->schema->storage->execute_reliably($unreliably)}
+ qr/Can't find source for ArtistXX/
+ => 'Bad coderef throws proper error';
+
+## Make sure replication came back
+
+ok $replicated->schema->resultset('Artist')->find(3)
+ => 'replicant reactivated';
+
+is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
+
+## make sure transactions are set to execute_reliably
+
+ok my $transaction = sub {
+
+ my $id = shift @_;
+
+ $replicated
+ ->schema
+ ->populate('Artist', [
+ [ qw/artistid name/ ],
+ [ $id, "Children of the Grave"],
+ ]);
+
+ ok my $result = $replicated->schema->resultset('Artist')->find($id)
+ => "Found expected artist for $id";
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
+ ok my $more = $replicated->schema->resultset('Artist')->find(1)
+ => 'Found expected artist again for 1';
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
+ return ($result, $more);
+
+} => 'Created a coderef properly';
+
+## Test the transaction with multi return
+{
+ ok my @return = $replicated->schema->txn_do($transaction, 666)
+ => 'did transaction';
+
+ is $return[0]->id, 666
+ => 'first returned value is correct';
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
+ is $return[1]->id, 1
+ => 'second returned value is correct';
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
+}
+
+## Test that asking for single return works
+{
+ ok my @return = $replicated->schema->txn_do($transaction, 777)
+ => 'did transaction';
+
+ is $return[0]->id, 777
+ => 'first returned value is correct';
+
+ is $return[1]->id, 1
+ => 'second returned value is correct';
+}
+
+## Test transaction returning a single value
+
+{
+ ok my $result = $replicated->schema->txn_do(sub {
+ ok my $more = $replicated->schema->resultset('Artist')->find(1)
+ => 'found inside a transaction';
+ is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
+ return $more;
+ }) => 'successfully processed transaction';
+
+ is $result->id, 1
+ => 'Got expected single result from transaction';
+}
+
+## Make sure replication came back
+
+ok $replicated->schema->resultset('Artist')->find(1)
+ => 'replicant reactivated';
+
+is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
+
+## Test Discard changes
+
+{
+ ok my $artist = $replicated->schema->resultset('Artist')->find(2)
+ => 'got an artist to test discard changes';
+
+ is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
+
+ ok $artist->get_from_storage({force_pool=>'master'})
+ => 'properly discard changes';
+
+ is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
+
+ ok $artist->discard_changes({force_pool=>'master'})
+ => 'properly called discard_changes against master (manual attrs)';
+
+ is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
+
+ ok $artist->discard_changes()
+ => 'properly called discard_changes against master (default attrs)';
+
+ is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
+
+ ok $artist->discard_changes({force_pool=>$replicant_names[0]})
+ => 'properly able to override the default attributes';
+
+ is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}"
+}
+
+## Test some edge cases, like trying to do a transaction inside a transaction, etc
+
+{
+ ok my $result = $replicated->schema->txn_do(sub {
+ return $replicated->schema->txn_do(sub {
+ ok my $more = $replicated->schema->resultset('Artist')->find(1)
+ => 'found inside a transaction inside a transaction';
+ is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
+ return $more;
+ });
+ }) => 'successfully processed transaction';
+
+ is $result->id, 1
+ => 'Got expected single result from transaction';
+}
+
+{
+ ok my $result = $replicated->schema->txn_do(sub {
+ return $replicated->schema->storage->execute_reliably(sub {
+ return $replicated->schema->txn_do(sub {
+ return $replicated->schema->storage->execute_reliably(sub {
+ ok my $more = $replicated->schema->resultset('Artist')->find(1)
+ => 'found inside crazy deep transactions and execute_reliably';
+ is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
+ return $more;
+ });
+ });
+ });
+ }) => 'successfully processed transaction';
+
+ is $result->id, 1
+ => 'Got expected single result from transaction';
+}
+
+## Test the force_pool resultset attribute.
+
+{
+ ok my $artist_rs = $replicated->schema->resultset('Artist')
+ => 'got artist resultset';
+
+ ## Turn on Forced Pool Storage
+ ok my $reliable_artist_rs = $artist_rs->search(undef, {force_pool=>'master'})
+ => 'Created a resultset using force_pool storage';
+
+ ok my $artist = $reliable_artist_rs->find(2)
+ => 'got an artist result via force_pool storage';
+
+ is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
+}
+
+## Test the force_pool resultset attribute part two.
+
+{
+ ok my $artist_rs = $replicated->schema->resultset('Artist')
+ => 'got artist resultset';
+
+ ## Turn on Forced Pool Storage
+ ok my $reliable_artist_rs = $artist_rs->search(undef, {force_pool=>$replicant_names[0]})
+ => 'Created a resultset using force_pool storage';
+
+ ok my $artist = $reliable_artist_rs->find(2)
+ => 'got an artist result via force_pool storage';
+
+ is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
+}
+## Delete the old database files
+$replicated->cleanup;
+
+done_testing;
+
+# vim: sw=4 sts=4 :
Copied: DBIx-Class/0.08/branches/extended_rels/t/storage/stats.t (from rev 7255, DBIx-Class/0.08/branches/extended_rels/t/31stats.t)
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/storage/stats.t (rev 0)
+++ DBIx-Class/0.08/branches/extended_rels/t/storage/stats.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -0,0 +1,104 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+plan tests => 12;
+
+use lib qw(t/lib);
+
+use_ok('DBICTest');
+my $schema = DBICTest->init_schema();
+
+my $cbworks = 0;
+
+$schema->storage->debugcb(sub { $cbworks = 1; });
+$schema->storage->debug(0);
+my $rs = $schema->resultset('CD')->search({});
+$rs->count();
+ok(!$cbworks, 'Callback not called with debug disabled');
+
+$schema->storage->debug(1);
+
+$rs->count();
+ok($cbworks, 'Debug callback worked.');
+
+my $prof = new DBIx::Test::Profiler();
+$schema->storage->debugobj($prof);
+
+# Test non-transaction calls.
+$rs->count();
+ok($prof->{'query_start'}, 'query_start called');
+ok($prof->{'query_end'}, 'query_end called');
+ok(!$prof->{'txn_begin'}, 'txn_begin not called');
+ok(!$prof->{'txn_commit'}, 'txn_commit not called');
+
+$prof->reset();
+
+# Test transaction calls
+$schema->txn_begin();
+ok($prof->{'txn_begin'}, 'txn_begin called');
+
+$rs = $schema->resultset('CD')->search({});
+$rs->count();
+ok($prof->{'query_start'}, 'query_start called');
+ok($prof->{'query_end'}, 'query_end called');
+
+$schema->txn_commit();
+ok($prof->{'txn_commit'}, 'txn_commit called');
+
+$prof->reset();
+
+# Test a rollback
+$schema->txn_begin();
+$rs = $schema->resultset('CD')->search({});
+$rs->count();
+$schema->txn_rollback();
+ok($prof->{'txn_rollback'}, 'txn_rollback called');
+
+$schema->storage->debug(0);
+
+package DBIx::Test::Profiler;
+use strict;
+
+sub new {
+ my $self = bless({});
+}
+
+sub query_start {
+ my $self = shift();
+ $self->{'query_start'} = 1;
+}
+
+sub query_end {
+ my $self = shift();
+ $self->{'query_end'} = 1;
+}
+
+sub txn_begin {
+ my $self = shift();
+ $self->{'txn_begin'} = 1;
+}
+
+sub txn_rollback {
+ my $self = shift();
+ $self->{'txn_rollback'} = 1;
+}
+
+sub txn_commit {
+ my $self = shift();
+ $self->{'txn_commit'} = 1;
+}
+
+sub reset {
+ my $self = shift();
+
+ $self->{'query_start'} = 0;
+ $self->{'query_end'} = 0;
+ $self->{'txn_begin'} = 0;
+ $self->{'txn_rollback'} = 0;
+ $self->{'txn_end'} = 0;
+}
+
+1;
Modified: DBIx-Class/0.08/branches/extended_rels/t/zzzzzzz_perl_perf_bug.t
===================================================================
--- DBIx-Class/0.08/branches/extended_rels/t/zzzzzzz_perl_perf_bug.t 2009-09-09 08:41:15 UTC (rev 7608)
+++ DBIx-Class/0.08/branches/extended_rels/t/zzzzzzz_perl_perf_bug.t 2009-09-09 09:39:56 UTC (rev 7609)
@@ -1,6 +1,7 @@
use strict;
use warnings;
use Test::More;
+use Benchmark;
use lib qw(t/lib);
use DBICTest; # do not remove even though it is not used
@@ -25,9 +26,6 @@
plan skip_all => 'Skipping as AUTOMATED_TESTING is set'
if ( $ENV{AUTOMATED_TESTING} );
-eval "use Benchmark ':all'";
-plan skip_all => 'needs Benchmark for testing' if $@;
-
plan tests => 3;
ok( 1, 'Dummy - prevents next test timing out' );
More information about the Bast-commits
mailing list