[Bast-commits] r6262 - in DBIx-Class/0.08/branches/storage-tweaks:
. lib/DBIx lib/DBIx/Class lib/DBIx/Class/InflateColumn
lib/DBIx/Class/Manual lib/DBIx/Class/Relationship
lib/DBIx/Class/SQLAHacks lib/DBIx/Class/Schema
lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI
lib/DBIx/Class/Storage/DBI/Oracle
lib/DBIx/Class/Storage/DBI/Sybase t t/count t/delete t/lib
t/lib/DBICTest t/lib/DBICTest/Schema t/resultset t/search
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Thu May 14 13:39:31 GMT 2009
Author: ribasushi
Date: 2009-05-14 13:39:30 +0000 (Thu, 14 May 2009)
New Revision: 6262
Added:
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/SQLAHacks.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/SQLAHacks/
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/SQLAHacks/OracleJoins.pm
DBIx-Class/0.08/branches/storage-tweaks/t/count/count_distinct.t
DBIx-Class/0.08/branches/storage-tweaks/t/count/count_joined.t
DBIx-Class/0.08/branches/storage-tweaks/t/delete/
DBIx-Class/0.08/branches/storage-tweaks/t/delete/m2m.t
DBIx-Class/0.08/branches/storage-tweaks/t/delete/related.t
DBIx-Class/0.08/branches/storage-tweaks/t/from_subquery.t
DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest/AuthorCheck.pm
Removed:
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/MultiDistinctEmulation.pm
DBIx-Class/0.08/branches/storage-tweaks/t/53delete_related.t
DBIx-Class/0.08/branches/storage-tweaks/t/deleting_many_to_many.t
Modified:
DBIx-Class/0.08/branches/storage-tweaks/
DBIx-Class/0.08/branches/storage-tweaks/Changes
DBIx-Class/0.08/branches/storage-tweaks/Makefile.PL
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Componentised.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/InflateColumn/DateTime.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Manual/Cookbook.pod
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Manual/FAQ.pod
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Relationship/Base.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Relationship/ManyToMany.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/ResultSet.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Schema.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Schema/Versioned.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Cursor.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/NoBindVars.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/SQLite.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/TxnScopeGuard.pm
DBIx-Class/0.08/branches/storage-tweaks/t/03podcoverage.t
DBIx-Class/0.08/branches/storage-tweaks/t/04dont_break_c3.t
DBIx-Class/0.08/branches/storage-tweaks/t/103many_to_many_warning.t
DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_1.t
DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_2.t
DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_3.t
DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_4.t
DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_rt41083.t
DBIx-Class/0.08/branches/storage-tweaks/t/41orrible.t
DBIx-Class/0.08/branches/storage-tweaks/t/42toplimit.t
DBIx-Class/0.08/branches/storage-tweaks/t/47bind_attribute.t
DBIx-Class/0.08/branches/storage-tweaks/t/60core.t
DBIx-Class/0.08/branches/storage-tweaks/t/66relationship.t
DBIx-Class/0.08/branches/storage-tweaks/t/71mysql.t
DBIx-Class/0.08/branches/storage-tweaks/t/73oracle.t
DBIx-Class/0.08/branches/storage-tweaks/t/73oracle_inflate.t
DBIx-Class/0.08/branches/storage-tweaks/t/76joins.t
DBIx-Class/0.08/branches/storage-tweaks/t/93nobindvars.t
DBIx-Class/0.08/branches/storage-tweaks/t/94versioning.t
DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest.pm
DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest/Schema/CD_to_Producer.pm
DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest/Schema/Track.pm
DBIx-Class/0.08/branches/storage-tweaks/t/lib/sqlite.sql
DBIx-Class/0.08/branches/storage-tweaks/t/resultset/as_query.t
DBIx-Class/0.08/branches/storage-tweaks/t/search/subquery.t
DBIx-Class/0.08/branches/storage-tweaks/t/zzzzzzz_perl_perf_bug.t
Log:
r6195 at Thesaurus (orig r6194): caelum | 2009-05-09 15:46:55 +0200
added postgres default port stuff to FAQ
r6199 at Thesaurus (orig r6198): mo | 2009-05-10 17:37:16 +0200
set_$rel accepts now a $link_vals hashref like add_to_$rel does
r6202 at Thesaurus (orig r6201): ribasushi | 2009-05-10 19:57:31 +0200
Require DBICTest.pm in all tests even if it is not needed at all
r6203 at Thesaurus (orig r6202): ribasushi | 2009-05-10 20:17:09 +0200
No more 'I forgot to run perl Makefile.PL'
r6204 at Thesaurus (orig r6203): ribasushi | 2009-05-10 21:35:03 +0200
Switch the m2m method warnings from warnings::register to $ENV{DBIC_METHOD_CLOBBER_OK} = 1
r6206 at Thesaurus (orig r6205): ribasushi | 2009-05-11 12:50:54 +0200
Change the makefile to test r6202
r6218 at Thesaurus (orig r6217): ribasushi | 2009-05-12 07:02:14 +0200
Trying to untangle failing merge (whitespace change)
r6220 at Thesaurus (orig r6219): ribasushi | 2009-05-12 07:02:56 +0200
r5757 at Thesaurus (orig r5756): arcanez | 2009-03-14 14:55:55 +0100
created count_distinct branch
r5758 at Thesaurus (orig r5757): arcanez | 2009-03-14 15:33:03 +0100
* change count with group_by (distinct) to use a subquery
* rewrite of _bind_to_sql (uses placeholders and bindvars)
* tests for count distinct
* fixed tests for from subquery
r5760 at Thesaurus (orig r5759): arcanez | 2009-03-16 16:48:28 +0100
don't remove the where clause unless we're doing distinct, it needs to be there
r5850 at Thesaurus (orig r5849): arcanez | 2009-03-30 21:40:05 +0200
* add more tests
* remove old cruft
* remove old note
r6035 at Thesaurus (orig r6034): ribasushi | 2009-04-30 09:10:36 +0200
Add joined count test
r6079 at Thesaurus (orig r6078): arcanez | 2009-05-01 08:41:34 +0200
cleanup/fix some broken tests
r6097 at Thesaurus (orig r6096): arcanez | 2009-05-01 19:37:04 +0200
make sure merge bind
test for aformentioned
TODO count_joined test for a little while
r6105 at Thesaurus (orig r6104): arcanez | 2009-05-02 02:33:49 +0200
remove hackish ways
r6106 at Thesaurus (orig r6105): arcanez | 2009-05-02 03:20:04 +0200
more fixes to tests
r6107 at Thesaurus (orig r6106): arcanez | 2009-05-02 03:33:47 +0200
remove DBIx::Class::Storage::DBI::MultiDistinctEmulation
r6111 at Thesaurus (orig r6110): ribasushi | 2009-05-03 02:00:19 +0200
Failing test without immediate fixes go to branches, not to trunk
r6114 at Thesaurus (orig r6113): ribasushi | 2009-05-03 10:23:28 +0200
Bump SQLA ependencies so parenthesis_significant is guaranteed to be there
r6148 at Thesaurus (orig r6147): ribasushi | 2009-05-06 17:40:31 +0200
Add subquery/from test by michaelr (copied from subquery branch r5742)
r6151 at Thesaurus (orig r6150): ribasushi | 2009-05-06 17:56:07 +0200
TODOify sqla-dependent tests
r6152 at Thesaurus (orig r6151): arcanez | 2009-05-06 18:33:58 +0200
fix old test using new bind vars (no more interpolating)
r6154 at Thesaurus (orig r6153): ribasushi | 2009-05-07 00:56:40 +0200
Rename internal function to clarify what it does
r6171 at Thesaurus (orig r6170): ribasushi | 2009-05-07 19:53:30 +0200
Adjust tests for the IN fixes
r6187 at Thesaurus (orig r6186): ribasushi | 2009-05-08 23:11:43 +0200
Final count tests
r6188 at Thesaurus (orig r6187): arcanez | 2009-05-09 03:50:12 +0200
rewrite DISTINCT/COUNT(DISTINCT) Cookbook entries
r6213 at Thesaurus (orig r6212): arcanez | 2009-05-11 22:41:21 +0200
warn/die based on { select => { distinct => { } } }
r6214 at Thesaurus (orig r6213): arcanez | 2009-05-11 23:21:11 +0200
use carp instead of warn
r6216 at Thesaurus (orig r6215): arcanez | 2009-05-11 23:45:05 +0200
make sure we get just a string
r6217 at Thesaurus (orig r6216): arcanez | 2009-05-11 23:52:11 +0200
oops
r6222 at Thesaurus (orig r6221): ribasushi | 2009-05-12 08:11:27 +0200
r6112 at Thesaurus (orig r6111): nniuq | 2009-05-03 02:36:33 +0200
Initially, fixes to enable saving of LOB types in Oracle. Possibly timestamp tweaks.
r6113 at Thesaurus (orig r6112): nniuq | 2009-05-03 03:52:29 +0200
Support for saving CLOB and BLOB types in Oracle.
r6118 at Thesaurus (orig r6117): nniuq | 2009-05-04 03:58:03 +0200
Proper support for timestamp inflation. Added last_updated_at to DBICTest::Schema::Track as a date by default, initialized in sqlite loader, redefined to timestamp for Oracle tests.
r6119 at Thesaurus (orig r6118): nniuq | 2009-05-04 04:03:28 +0200
Re-added last_updated_at to create table statement.
r6134 at Thesaurus (orig r6133): nniuq | 2009-05-05 15:11:49 +0200
Added self to contributors; clarified comment on :ora_types imports.
r6182 at Thesaurus (orig r6181): nniuq | 2009-05-08 17:10:58 +0200
Refactored to call _{inflate_to,deflate_from}_datetime through a _flate_or_fallback wrapper handling a parser's lack of support for the requested type.
r6183 at Thesaurus (orig r6182): ribasushi | 2009-05-08 17:24:54 +0200
Remove redundant var
r6189 at Thesaurus (orig r6188): nniuq | 2009-05-09 03:59:20 +0200
Changed test of lob values from is to ok on an eq expr, to avoid a huge got/expected diagnosis. In doing so, discovered it was testing undef vs undef! Whoops. Fixed.
r6210 at Thesaurus (orig r6209): nniuq | 2009-05-11 16:24:27 +0200
Moved DBIC::SQL::Abstract inner classes to DBIx::Class::SQLAHacks namespace to decouple 41orrible.t tests from use of DBD::Oracle in Oracle Generic driver.
r6224 at Thesaurus (orig r6223): ribasushi | 2009-05-12 08:13:31 +0200
r6223 at Thesaurus (orig r6222): ribasushi | 2009-05-12 08:12:50 +0200
Whops, forgotten post-merge tweaks
r6226 at Thesaurus (orig r6225): ribasushi | 2009-05-12 08:43:58 +0200
Cleanup
r6227 at Thesaurus (orig r6226): ribasushi | 2009-05-12 09:42:45 +0200
Shuffle delete tests, and sanify the delete related ones
r6228 at Thesaurus (orig r6227): ribasushi | 2009-05-12 09:54:37 +0200
Rename m2m warn disable envvar
r6229 at Thesaurus (orig r6228): ribasushi | 2009-05-12 10:20:08 +0200
Switch warn to carp and die to throw_exception where possible
r6230 at Thesaurus (orig r6229): bricas | 2009-05-12 13:31:35 +0200
added info to Changes from my DateTime::InflateColumn modifications
r6231 at Thesaurus (orig r6230): nniuq | 2009-05-12 15:08:14 +0200
Added synopsis of merged oracle-tweaks branch to Changes
r6233 at Thesaurus (orig r6232): debolaz | 2009-05-12 17:17:09 +0200
Test for failing code related to many to many in MySQL
r6234 at Thesaurus (orig r6233): arcanez | 2009-05-12 17:33:56 +0200
Changes for count_distinct branch merge
r6235 at Thesaurus (orig r6234): ribasushi | 2009-05-12 18:09:14 +0200
Some more die/croak conversions
r6236 at Thesaurus (orig r6235): ribasushi | 2009-05-12 18:51:38 +0200
Fix shot test
r6244 at Thesaurus (orig r6243): ribasushi | 2009-05-13 03:02:11 +0200
fix bogus test
r6245 at Thesaurus (orig r6244): ribasushi | 2009-05-13 03:06:42 +0200
Fix _select_for_update/delete - bring back old code, use subqueries only when resultset attributes call for it
r6252 at Thesaurus (orig r6251): ribasushi | 2009-05-14 01:41:31 +0200
Better testing and heuristics for subqueried _cond_for_update_delete
r6253 at Thesaurus (orig r6252): ribasushi | 2009-05-14 01:54:41 +0200
join can be found without seen_join
r6255 at Thesaurus (orig r6254): ribasushi | 2009-05-14 12:12:44 +0200
Sometimes _prepare_for_execute may not return a set of bind vars - guard against that
r6256 at Thesaurus (orig r6255): ribasushi | 2009-05-14 12:14:19 +0200
Clarify test
Property changes on: DBIx-Class/0.08/branches/storage-tweaks
___________________________________________________________________
Name: svn:mergeinfo
-
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:5969
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:11142
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/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/multi_stuff:5565
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_sequence:4173
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/replication_dedux:4600
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/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/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/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/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/trunk:6178
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/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:5969
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:11142
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/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/multi_stuff:5565
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/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/replication_dedux:4600
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/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/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/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/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/trunk:6255
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
Modified: DBIx-Class/0.08/branches/storage-tweaks/Changes
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/Changes 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/Changes 2009-05-14 13:39:30 UTC (rev 6262)
@@ -1,15 +1,26 @@
Revision history for DBIx::Class
- - ::Storage::DBI::Replicated::Balancer::Random:
- added master_read_weight
- - ::Storage::DBI::Replicated: storage opts from connect_info,
- connect_info merging to replicants, hashref connect_info support,
- improved trace output, other bug fixes/cleanups
+ - Remove MultiDistinctEmulation.pm, effectively deprecating
+ { select => { distinct => [ qw/col1 col2/ ] } }
+ - Change ->count code to work correctly with DISTINCT (distinct => 1)
+ via GROUP BY
+ - remove interpolation of bind vars for as_query
+ - update Cookbook entry for "SELECT DISTINCT with multiple columns"
+ - update Cookbook entry for "SELECT COUNT(DISTINCT colname)"
- Refactor DBIx::Class::Storage::DBI::Sybase to automatically
load a subclass, namely Microsoft_SQL_Server.pm
(similar to DBIx::Class::Storage::DBI::ODBC)
- Proper support for update/delete of joined resultsets
(using IN => $sub_rs->as_query)
+ - Refactor InflateColumn::DateTime to allow components to
+ circumvent DateTime parsing
+ - Support inflation of timestamp datatype
+ - Support BLOB and CLOB datatypes on Oracle
+ - Storage::DBI::Replicated::Balancer::Random:
+ added master_read_weight
+ - Storage::DBI::Replicated: storage opts from connect_info,
+ connect_info merging to replicants, hashref connect_info support,
+ improved trace output, other bug fixes/cleanups
0.08102 2009-04-30 08:29:00 (UTC)
- Fixed two subtle bugs when using columns or select/as
Modified: DBIx-Class/0.08/branches/storage-tweaks/Makefile.PL
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/Makefile.PL 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/Makefile.PL 2009-05-14 13:39:30 UTC (rev 6262)
@@ -190,6 +190,7 @@
. 'Do you really want to continue?',
'no',
);
+
exit 0 unless ($ans =~ /^y(es)?$/i);
}
}
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Componentised.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Componentised.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Componentised.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -17,7 +17,7 @@
foreach my $first_comp (@comps) {
if ($to eq 'DBIx::Class::Core' &&
$target->isa("DBIx::Class::${first_comp}")) {
- warn "Possible incorrect order of components in ".
+ carp "Possible incorrect order of components in ".
"${target}::load_components($first_comp) call: Core loaded ".
"before $first_comp. See the documentation for ".
"DBIx::Class::$first_comp for more information";
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/InflateColumn/DateTime.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/InflateColumn/DateTime.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/InflateColumn/DateTime.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -3,6 +3,7 @@
use strict;
use warnings;
use base qw/DBIx::Class/;
+use Carp::Clan qw/^DBIx::Class/;
=head1 NAME
@@ -94,7 +95,7 @@
my $type;
- for (qw/date datetime/) {
+ for (qw/date datetime timestamp/) {
my $key = "inflate_${_}";
next unless exists $info->{$key};
@@ -106,19 +107,18 @@
unless ($type) {
$type = lc($info->{data_type});
- $type = 'datetime' if ($type =~ /^timestamp/);
}
my $timezone;
if ( defined $info->{extra}{timezone} ) {
- warn "Putting timezone into extra => { timezone => '...' } has been deprecated, ".
+ carp "Putting timezone into extra => { timezone => '...' } has been deprecated, ".
"please put it directly into the columns definition.";
$timezone = $info->{extra}{timezone};
}
my $locale;
if ( defined $info->{extra}{locale} ) {
- warn "Putting locale into extra => { locale => '...' } has been deprecated, ".
+ carp "Putting locale into extra => { locale => '...' } has been deprecated, ".
"please put it directly into the columns definition.";
$locale = $info->{extra}{locale};
}
@@ -128,37 +128,24 @@
my $undef_if_invalid = $info->{datetime_undef_if_invalid};
- if ($type eq 'datetime' || $type eq 'date') {
- my ($parse, $format) = ("parse_${type}", "format_${type}");
+ if ($type eq 'datetime' || $type eq 'date' || $type eq 'timestamp') {
+ # This shallow copy of %info avoids t/52_cycle.t treating
+ # the resulting deflator as a circular reference.
+ my %info = ( '_ic_dt_method' => $type , %{ $info } );
- # This assignment must happen here, otherwise Devel::Cycle treats
- # the resulting deflator as a circular reference (go figure):
- #
- # Cycle #1
- # DBICTest::Schema A->{source_registrations} => %B
- # %B->{Event} => DBIx::Class::ResultSource::Table C
- # DBIx::Class::ResultSource::Table C->{_columns} => %D
- # %D->{created_on} => %E
- # %E->{_inflate_info} => %F
- # %F->{deflate} => &G
- # closure &G, $info => $H
- # $H => %E
- #
- my $floating_tz_ok;
if (defined $info->{extra}{floating_tz_ok}) {
- warn "Putting floating_tz_ok into extra => { floating_tz_ok => 1 } has been deprecated, ".
+ carp "Putting floating_tz_ok into extra => { floating_tz_ok => 1 } has been deprecated, ".
"please put it directly into the columns definition.";
- $floating_tz_ok = $info->{extra}{floating_tz_ok};
+ $info{floating_tz_ok} = $info->{extra}{floating_tz_ok};
}
- $floating_tz_ok = $info->{floating_tz_ok} if defined $info->{floating_tz_ok};
$self->inflate_column(
$column =>
{
inflate => sub {
my ($value, $obj) = @_;
- my $dt = eval { $obj->_datetime_parser->$parse($value); };
- die "Error while inflating ${value} for ${column} on ${self}: $@"
+ my $dt = eval { $obj->_inflate_to_datetime( $value, \%info ) };
+ $self->throw_exception ("Error while inflating ${value} for ${column} on ${self}: $@")
if $@ and not $undef_if_invalid;
$dt->set_time_zone($timezone) if $timezone;
$dt->set_locale($locale) if $locale;
@@ -167,21 +154,41 @@
deflate => sub {
my ($value, $obj) = @_;
if ($timezone) {
- warn "You're using a floating timezone, please see the documentation of"
+ carp "You're using a floating timezone, please see the documentation of"
. " DBIx::Class::InflateColumn::DateTime for an explanation"
if ref( $value->time_zone ) eq 'DateTime::TimeZone::Floating'
- and not $floating_tz_ok
+ and not $info{floating_tz_ok}
and not $ENV{DBIC_FLOATING_TZ_OK};
$value->set_time_zone($timezone);
$value->set_locale($locale) if $locale;
}
- $obj->_datetime_parser->$format($value);
+ $obj->_deflate_from_datetime( $value, \%info );
},
}
);
}
}
+sub _flate_or_fallback
+{
+ my( $self, $value, $info, $method_fmt ) = @_;
+
+ my $parser = $self->_datetime_parser;
+ my $preferred_method = sprintf($method_fmt, $info->{ _ic_dt_method });
+ my $method = $parser->can($preferred_method) ? $preferred_method : sprintf($method_fmt, 'datetime');
+ return $parser->$method($value);
+}
+
+sub _inflate_to_datetime {
+ my( $self, $value, $info ) = @_;
+ return $self->_flate_or_fallback( $value, $info, 'parse_%s' );
+}
+
+sub _deflate_from_datetime {
+ my( $self, $value, $info ) = @_;
+ return $self->_flate_or_fallback( $value, $info, 'format_%s' );
+}
+
sub _datetime_parser {
my $self = shift;
if (my $parser = $self->__datetime_parser) {
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Manual/Cookbook.pod
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Manual/Cookbook.pod 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Manual/Cookbook.pod 2009-05-14 13:39:30 UTC (rev 6262)
@@ -237,30 +237,50 @@
=head2 SELECT DISTINCT with multiple columns
- my $rs = $schema->resultset('Foo')->search(
+ my $rs = $schema->resultset('Artist')->search(
{},
{
- select => [
- { distinct => [ $source->columns ] }
- ],
- as => [ $source->columns ] # remember 'as' is not the same as SQL AS :-)
+ columns => [ qw/artistid name rank/ ],
+ distinct => 1
+ }
+ );
+
+ my $rs = $schema->resultset('Artist')->search(
+ {},
+ {
+ columns => [ qw/artistid name rank/ ],
+ group_by => [ qw/artistid name rank/ ],
}
);
+ # Equivalent SQL:
+ # SELECT me.artistid, me.name, me.rank
+ # FROM artist me
+ # GROUP BY artistid, name, rank
+
=head2 SELECT COUNT(DISTINCT colname)
- my $rs = $schema->resultset('Foo')->search(
+ my $rs = $schema->resultset('Artist')->search(
{},
{
- select => [
- { count => { distinct => 'colname' } }
- ],
- as => [ 'count' ]
+ columns => [ qw/name/ ],
+ distinct => 1
}
);
- my $count = $rs->next->get_column('count');
+ my $rs = $schema->resultset('Artist')->search(
+ {},
+ {
+ columns => [ qw/name/ ],
+ group_by => [ qw/name/ ],
+ }
+ );
+ my $count = $rs->count;
+
+ # Equivalent SQL:
+ # SELECT COUNT( DISTINCT( me.name ) ) FROM artist me
+
=head2 Grouping results
L<DBIx::Class> supports C<GROUP BY> as follows:
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Manual/FAQ.pod
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Manual/FAQ.pod 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Manual/FAQ.pod 2009-05-14 13:39:30 UTC (rev 6262)
@@ -552,3 +552,23 @@
See L<DBIx::Class::Manual::Cookbook/Stringification>
=back
+
+=head2 Troubleshooting
+
+=over 4
+
+=item Help, I can't connect to postgresql!
+
+If you get an error such as:
+
+ DBI connect('dbname=dbic','user',...) failed: could not connect to server:
+ No such file or directory Is the server running locally and accepting
+ connections on Unix domain socket "/var/run/postgresql/.s.PGSQL.5432"?
+
+Likely you have/had two copies of postgresql installed simultaneously, the
+second one will use a default port of 5433, while L<DBD::Pg> is compiled with a
+default port of 5432.
+
+You can chance the port setting in C<postgresql.conf>.
+
+=back
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Relationship/Base.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Relationship/Base.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Relationship/Base.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -470,7 +470,7 @@
=over 4
-=item Arguments: (\@hashrefs | \@objs)
+=item Arguments: (\@hashrefs | \@objs), $link_vals?
=back
@@ -481,6 +481,10 @@
$actor->set_roles(\@roles);
# Replaces all of $actor's previous roles with the two named
+ $actor->set_roles(\@roles, { salary => 15_000_000 });
+ # Sets a column in the link table for all roles
+
+
Replace all the related objects with the given reference to a list of
objects. This does a C<delete> B<on the link table resultset> to remove the
association between the current object and all related objects, then calls
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Relationship/ManyToMany.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Relationship/ManyToMany.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Relationship/ManyToMany.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -3,7 +3,8 @@
use strict;
use warnings;
-use warnings::register;
+
+use Carp::Clan qw/^DBIx::Class/;
use Sub::Name ();
sub many_to_many {
@@ -28,16 +29,20 @@
for ($add_meth, $remove_meth, $set_meth, $rs_meth) {
if ( $class->can ($_) ) {
- warnings::warnif(<<"EOW")
+ carp (<<"EOW") unless $ENV{DBIC_OVERWRITE_HELPER_METHODS_OK};
+
***************************************************************************
-The many-to-many relationship $meth is trying to create a utility method called
-$_. This will overwrite the existing method on $class. You almost certainly
-want to rename your method or the many-to-many relationship, as your method
-will not be callable (it will use the one from the relationship instead.)
+The many-to-many relationship '$meth' is trying to create a utility method
+called $_.
+This will completely overwrite one such already existing method on class
+$class.
-To disable this warning add the following to $class
+You almost certainly want to rename your method or the many-to-many
+relationship, as the functionality of the original method will not be
+accessible anymore.
- no warnings 'DBIx::Class::Relationship::ManyToMany';
+To disable this warning set to a true value the environment variable
+DBIC_OVERWRITE_HELPER_METHODS_OK
***************************************************************************
EOW
@@ -103,7 +108,7 @@
);
my @to_set = (ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_);
$self->search_related($rel, {})->delete;
- $self->$add_meth($_) for (@to_set);
+ $self->$add_meth($_, ref($_[1]) ? $_[1] : {}) for (@to_set);
};
my $remove_meth_name = join '::', $class, $remove_meth;
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/ResultSet.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/ResultSet.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -307,7 +307,7 @@
my $new_attrs = { %{$our_attrs}, %{$attrs} };
# merge new attrs into inherited
- foreach my $key (qw/join prefetch +select +as/) {
+ foreach my $key (qw/join prefetch +select +as bind/) {
next unless exists $attrs->{$key};
$new_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key});
}
@@ -1148,12 +1148,6 @@
with to find the number of elements. If passed arguments, does a search
on the resultset and counts the results of that.
-Note: When using C<count> with C<group_by>, L<DBIx::Class> emulates C<GROUP BY>
-using C<COUNT( DISTINCT( columns ) )>. Some databases (notably SQLite) do
-not support C<DISTINCT> with multiple columns. If you are using such a
-database, you should only use columns from the main table in your C<group_by>
-clause.
-
=cut
sub count {
@@ -1174,32 +1168,21 @@
sub _count { # Separated out so pager can get the full count
my $self = shift;
- my $select = { count => '*' };
-
my $attrs = { %{$self->_resolved_attrs} };
- if (my $group_by = delete $attrs->{group_by}) {
- delete $attrs->{having};
- my @distinct = (ref $group_by ? @$group_by : ($group_by));
- # todo: try CONCAT for multi-column pk
- my @pk = $self->result_source->primary_columns;
- if (@pk == 1) {
- my $alias = $attrs->{alias};
- foreach my $column (@distinct) {
- if ($column =~ qr/^(?:\Q${alias}.\E)?$pk[0]$/) {
- @distinct = ($column);
- last;
- }
- }
- }
- $select = { count => { distinct => \@distinct } };
+ if (my $group_by = $attrs->{group_by}) {
+ delete $attrs->{order_by};
+
+ $attrs->{select} = $group_by;
+ $attrs->{from} = [ { 'mesub' => (ref $self)->new($self->result_source, $attrs)->cursor->as_query } ];
+ delete $attrs->{where};
}
- $attrs->{select} = $select;
+ $attrs->{select} = { count => '*' };
$attrs->{as} = [qw/count/];
- # offset, order by and page are not needed to count. record_filter is cdbi
- delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
+ # offset, order by, group by, where and page are not needed to count. record_filter is cdbi
+ delete $attrs->{$_} for qw/rows offset order_by group_by page pager record_filter/;
my $tmp_rs = (ref $self)->new($self->result_source, $attrs);
my ($count) = $tmp_rs->cursor->next;
@@ -1329,10 +1312,58 @@
# No-op. No condition, we're updating/deleting everything
return $cond unless ref $full_cond;
- foreach my $pk ($self->result_source->primary_columns) {
- $cond->{$pk} = { -in => $self->get_column($pk)->as_query };
+ # Some attributes when present require a subquery
+ # This might not work on some database (mysql), but...
+ # it won't work without the subquery either so who cares
+ if (grep { defined $self->{attrs}{$_} } qw/join seen_join from rows group_by/) {
+
+ foreach my $pk ($self->result_source->primary_columns) {
+ $cond->{$pk} = { IN => $self->get_column($pk)->as_query };
+ }
+
+ return $cond;
}
+ if (ref $full_cond eq 'ARRAY') {
+ $cond = [
+ map {
+ my %hash;
+ foreach my $key (keys %{$_}) {
+ $key =~ /([^.]+)$/;
+ $hash{$1} = $_->{$key};
+ }
+ \%hash;
+ } @{$full_cond}
+ ];
+ }
+ elsif (ref $full_cond eq 'HASH') {
+ if ((keys %{$full_cond})[0] eq '-and') {
+ $cond->{-and} = [];
+ my @cond = @{$full_cond->{-and}};
+ for (my $i = 0; $i < @cond; $i++) {
+ my $entry = $cond[$i];
+ my $hash;
+ if (ref $entry eq 'HASH') {
+ $hash = $self->_cond_for_update_delete($entry);
+ }
+ else {
+ $entry =~ /([^.]+)$/;
+ $hash->{$1} = $cond[++$i];
+ }
+ push @{$cond->{-and}}, $hash;
+ }
+ }
+ else {
+ foreach my $key (keys %{$full_cond}) {
+ $key =~ /([^.]+)$/;
+ $cond->{$1} = $full_cond->{$key};
+ }
+ }
+ }
+ else {
+ $self->throw_exception("Can't update/delete on resultset with condition unless hash or array");
+ }
+
return $cond;
}
Added: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/SQLAHacks/OracleJoins.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/SQLAHacks/OracleJoins.pm (rev 0)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/SQLAHacks/OracleJoins.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -0,0 +1,171 @@
+package # Hide from PAUSE
+ DBIx::Class::SQLAHacks::OracleJoins;
+
+use base qw( DBIx::Class::SQLAHacks );
+use Carp::Clan qw/^DBIx::Class/;
+
+sub select {
+ my ($self, $table, $fields, $where, $order, @rest) = @_;
+
+ if (ref($table) eq 'ARRAY') {
+ $where = $self->_oracle_joins($where, @{ $table });
+ }
+
+ return $self->SUPER::select($table, $fields, $where, $order, @rest);
+}
+
+sub _recurse_from {
+ my ($self, $from, @join) = @_;
+
+ my @sqlf = $self->_make_as($from);
+
+ foreach my $j (@join) {
+ my ($to, $on) = @{ $j };
+
+ if (ref $to eq 'ARRAY') {
+ push (@sqlf, $self->_recurse_from(@{ $to }));
+ }
+ else {
+ push (@sqlf, $self->_make_as($to));
+ }
+ }
+
+ return join q{, }, @sqlf;
+}
+
+sub _oracle_joins {
+ my ($self, $where, $from, @join) = @_;
+ my $join_where = {};
+ $self->_recurse_oracle_joins($join_where, $from, @join);
+ if (keys %$join_where) {
+ if (!defined($where)) {
+ $where = $join_where;
+ } else {
+ if (ref($where) eq 'ARRAY') {
+ $where = { -or => $where };
+ }
+ $where = { -and => [ $join_where, $where ] };
+ }
+ }
+ return $where;
+}
+
+sub _recurse_oracle_joins {
+ my ($self, $where, $from, @join) = @_;
+
+ foreach my $j (@join) {
+ my ($to, $on) = @{ $j };
+
+ if (ref $to eq 'ARRAY') {
+ $self->_recurse_oracle_joins($where, @{ $to });
+ }
+
+ my $to_jt = ref $to eq 'ARRAY' ? $to->[0] : $to;
+ my $left_join = q{};
+ my $right_join = q{};
+
+ if (ref $to_jt eq 'HASH' and exists $to_jt->{-join_type}) {
+ #TODO: Support full outer joins -- this would happen much earlier in
+ #the sequence since oracle 8's full outer join syntax is best
+ #described as INSANE.
+ croak "Can't handle full outer joins in Oracle 8 yet!\n"
+ if $to_jt->{-join_type} =~ /full/i;
+
+ $left_join = q{(+)} if $to_jt->{-join_type} =~ /left/i
+ && $to_jt->{-join_type} !~ /inner/i;
+
+ $right_join = q{(+)} if $to_jt->{-join_type} =~ /right/i
+ && $to_jt->{-join_type} !~ /inner/i;
+ }
+
+ foreach my $lhs (keys %{ $on }) {
+ $where->{$lhs . $left_join} = \"= $on->{ $lhs }$right_join";
+ }
+ }
+}
+
+1;
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::SQLAHacks::OracleJoins - Pre-ANSI Joins-via-Where-Clause Syntax
+
+=head1 PURPOSE
+
+This module was originally written to support Oracle < 9i where ANSI joins
+weren't supported at all, but became the module for Oracle >= 8 because
+Oracle's optimising of ANSI joins is horrible. (See:
+http://scsys.co.uk:8001/7495)
+
+=head1 SYNOPSIS
+
+Not intended for use directly; used as the sql_maker_class for schemas and components.
+
+=head1 DESCRIPTION
+
+Implements pre-ANSI joins specified in the where clause. Instead of:
+
+ SELECT x FROM y JOIN z ON y.id = z.id
+
+It will write:
+
+ SELECT x FROM y, z WHERE y.id = z.id
+
+It should properly support left joins, and right joins. Full outer joins are
+not possible due to the fact that Oracle requires the entire query be written
+to union the results of a left and right join, and by the time this module is
+called to create the where query and table definition part of the sql query,
+it's already too late.
+
+=head1 METHODS
+
+=over
+
+=item select ($\@$;$$@)
+
+Replaces DBIx::Class::SQLAHacks's select() method, which calls _oracle_joins()
+to modify the column and table list before calling SUPER::select().
+
+=item _recurse_from ($$\@)
+
+Recursive subroutine that builds the table list.
+
+=item _oracle_joins ($$$@)
+
+Creates the left/right relationship in the where query.
+
+=back
+
+=head1 BUGS
+
+Does not support full outer joins.
+Probably lots more.
+
+=head1 SEE ALSO
+
+=over
+
+=item L<DBIx::Class::Storage::DBI::Oracle::WhereJoins> - Storage class using this
+
+=item L<DBIx::Class::SQLAHacks> - Parent module
+
+=item L<DBIx::Class> - Duh
+
+=back
+
+=head1 AUTHOR
+
+Justin Wheeler C<< <jwheeler at datademons.com> >>
+
+=head1 CONTRIBUTORS
+
+David Jack Olrik C<< <djo at cpan.org> >>
+
+=head1 LICENSE
+
+This module is licensed under the same terms as Perl itself.
+
+=cut
+
Added: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/SQLAHacks.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/SQLAHacks.pm (rev 0)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/SQLAHacks.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -0,0 +1,432 @@
+package # Hide from PAUSE
+ DBIx::Class::SQLAHacks;
+
+use base qw/SQL::Abstract::Limit/;
+use Carp::Clan qw/^DBIx::Class/;
+
+sub new {
+ my $self = shift->SUPER::new(@_);
+
+ # This prevents the caching of $dbh in S::A::L, I believe
+ # If limit_dialect is a ref (like a $dbh), go ahead and replace
+ # it with what it resolves to:
+ $self->{limit_dialect} = $self->_find_syntax($self->{limit_dialect})
+ if ref $self->{limit_dialect};
+
+ $self;
+}
+
+
+# Some databases (sqlite) do not handle multiple parenthesis
+# around in/between arguments. A tentative x IN ( ( 1, 2 ,3) )
+# is interpreted as x IN 1 or something similar.
+#
+# Since we currently do not have access to the SQLA AST, resort
+# to barbaric mutilation of any SQL supplied in literal form
+
+sub _strip_outer_paren {
+ my ($self, $arg) = @_;
+
+ return $self->_SWITCH_refkind ($arg, {
+ ARRAYREFREF => sub {
+ $$arg->[0] = __strip_outer_paren ($$arg->[0]);
+ return $arg;
+ },
+ SCALARREF => sub {
+ return \__strip_outer_paren( $$arg );
+ },
+ FALLBACK => sub {
+ return $arg
+ },
+ });
+}
+
+sub __strip_outer_paren {
+ my $sql = shift;
+
+ if ($sql and not ref $sql) {
+ while ($sql =~ /^ \s* \( (.*) \) \s* $/x ) {
+ $sql = $1;
+ }
+ }
+
+ return $sql;
+}
+
+sub _where_field_IN {
+ my ($self, $lhs, $op, $rhs) = @_;
+ $rhs = $self->_strip_outer_paren ($rhs);
+ return $self->SUPER::_where_field_IN ($lhs, $op, $rhs);
+}
+
+sub _where_field_BETWEEN {
+ my ($self, $lhs, $op, $rhs) = @_;
+ $rhs = $self->_strip_outer_paren ($rhs);
+ return $self->SUPER::_where_field_BETWEEN ($lhs, $op, $rhs);
+}
+
+
+
+# DB2 is the only remaining DB using this. Even though we are not sure if
+# RowNumberOver is still needed here (should be part of SQLA) leave the
+# code in place
+sub _RowNumberOver {
+ my ($self, $sql, $order, $rows, $offset ) = @_;
+
+ $offset += 1;
+ my $last = $rows + $offset;
+ my ( $order_by ) = $self->_order_by( $order );
+
+ $sql = <<"SQL";
+SELECT * FROM
+(
+ SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
+ $sql
+ $order_by
+ ) Q1
+) Q2
+WHERE ROW_NUM BETWEEN $offset AND $last
+
+SQL
+
+ return $sql;
+}
+
+
+# While we're at it, this should make LIMIT queries more efficient,
+# without digging into things too deeply
+use Scalar::Util 'blessed';
+sub _find_syntax {
+ my ($self, $syntax) = @_;
+
+ # DB2 is the only remaining DB using this. Even though we are not sure if
+ # RowNumberOver is still needed here (should be part of SQLA) leave the
+ # code in place
+ my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax;
+ if(ref($self) && $dbhname && $dbhname eq 'DB2') {
+ return 'RowNumberOver';
+ }
+
+ $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
+}
+
+sub select {
+ my ($self, $table, $fields, $where, $order, @rest) = @_;
+ local $self->{having_bind} = [];
+ local $self->{from_bind} = [];
+
+ if (ref $table eq 'SCALAR') {
+ $table = $$table;
+ }
+ elsif (not ref $table) {
+ $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];
+ croak "LIMIT 0 Does Not Compute" if $rest[0] == 0;
+ # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
+ my ($sql, @where_bind) = $self->SUPER::select(
+ $table, $self->_recurse_fields($fields), $where, $order, @rest
+ );
+ $sql .=
+ $self->{for} ?
+ (
+ $self->{for} eq 'update' ? ' FOR UPDATE' :
+ $self->{for} eq 'shared' ? ' FOR SHARE' :
+ ''
+ ) :
+ ''
+ ;
+ return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}) : $sql;
+}
+
+sub insert {
+ my $self = shift;
+ my $table = shift;
+ $table = $self->_quote($table) unless ref($table);
+ $self->SUPER::insert($table, @_);
+}
+
+sub update {
+ my $self = shift;
+ my $table = shift;
+ $table = $self->_quote($table) unless ref($table);
+ $self->SUPER::update($table, @_);
+}
+
+sub delete {
+ my $self = shift;
+ my $table = shift;
+ $table = $self->_quote($table) unless ref($table);
+ $self->SUPER::delete($table, @_);
+}
+
+sub _emulate_limit {
+ my $self = shift;
+ if ($_[3] == -1) {
+ return $_[1].$self->_order_by($_[2]);
+ } else {
+ return $self->SUPER::_emulate_limit(@_);
+ }
+}
+
+sub _recurse_fields {
+ my ($self, $fields, $params) = @_;
+ my $ref = ref $fields;
+ return $self->_quote($fields) unless $ref;
+ return $$fields if $ref eq 'SCALAR';
+
+ if ($ref eq 'ARRAY') {
+ return join(', ', map {
+ $self->_recurse_fields($_)
+ .(exists $self->{rownum_hack_count} && !($params && $params->{no_rownum_hack})
+ ? ' AS col'.$self->{rownum_hack_count}++
+ : '')
+ } @$fields);
+ } elsif ($ref eq 'HASH') {
+ foreach my $func (keys %$fields) {
+ if ($func eq 'distinct') {
+ my $_fields = $fields->{$func};
+ if (ref $_fields eq 'ARRAY' && @{$_fields} > 1) {
+ croak "Unsupported syntax, please use " .
+ "{ group_by => [ qw/" . (join ' ', @$_fields) . "/ ] }" .
+ " or " .
+ "{ select => [ qw/" . (join ' ', @$_fields) . "/ ], distinct => 1 }";
+ }
+ else {
+ $_fields = @{$_fields}[0] if ref $_fields eq 'ARRAY';
+ carp "This syntax will be deprecated in 09, please use " .
+ "{ group_by => '${_fields}' }" .
+ " or " .
+ "{ select => '${_fields}', distinct => 1 }";
+ }
+ }
+
+ return $self->_sqlcase($func)
+ .'( '.$self->_recurse_fields($fields->{$func}).' )';
+ }
+ }
+ # Is the second check absolutely necessary?
+ elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
+ return $self->_fold_sqlbind( $fields );
+ }
+ else {
+ croak($ref . qq{ unexpected in _recurse_fields()})
+ }
+}
+
+sub _order_by {
+ my $self = shift;
+ my $ret = '';
+ my @extra;
+ if (ref $_[0] eq 'HASH') {
+ if (defined $_[0]->{group_by}) {
+ $ret = $self->_sqlcase(' group by ')
+ .$self->_recurse_fields($_[0]->{group_by}, { no_rownum_hack => 1 });
+ }
+ if (defined $_[0]->{having}) {
+ my $frag;
+ ($frag, @extra) = $self->_recurse_where($_[0]->{having});
+ push(@{$self->{having_bind}}, @extra);
+ $ret .= $self->_sqlcase(' having ').$frag;
+ }
+ if (defined $_[0]->{order_by}) {
+ $ret .= $self->_order_by($_[0]->{order_by});
+ }
+ if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) {
+ return $self->SUPER::_order_by($_[0]);
+ }
+ } elsif (ref $_[0] eq 'SCALAR') {
+ $ret = $self->_sqlcase(' order by ').${ $_[0] };
+ } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
+ my @order = @{+shift};
+ $ret = $self->_sqlcase(' order by ')
+ .join(', ', map {
+ my $r = $self->_order_by($_, @_);
+ $r =~ s/^ ?ORDER BY //i;
+ $r;
+ } @order);
+ } else {
+ $ret = $self->SUPER::_order_by(@_);
+ }
+ return $ret;
+}
+
+sub _order_directions {
+ my ($self, $order) = @_;
+ $order = $order->{order_by} if ref $order eq 'HASH';
+ return $self->SUPER::_order_directions($order);
+}
+
+sub _table {
+ my ($self, $from) = @_;
+ if (ref $from eq 'ARRAY') {
+ return $self->_recurse_from(@$from);
+ } elsif (ref $from eq 'HASH') {
+ return $self->_make_as($from);
+ } else {
+ return $from; # would love to quote here but _table ends up getting called
+ # twice during an ->select without a limit clause due to
+ # the way S::A::Limit->select works. should maybe consider
+ # bypassing this and doing S::A::select($self, ...) in
+ # our select method above. meantime, quoting shims have
+ # been added to select/insert/update/delete here
+ }
+}
+
+sub _recurse_from {
+ my ($self, $from, @join) = @_;
+ my @sqlf;
+ push(@sqlf, $self->_make_as($from));
+ 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 ';
+ }
+ push(@sqlf, $join_clause);
+
+ if (ref $to eq 'ARRAY') {
+ push(@sqlf, '(', $self->_recurse_from(@$to), ')');
+ } else {
+ push(@sqlf, $self->_make_as($to));
+ }
+ push(@sqlf, ' ON ', $self->_join_condition($on));
+ }
+ return join('', @sqlf);
+}
+
+sub _fold_sqlbind {
+ my ($self, $sqlbind) = @_;
+ my $sql = shift @$$sqlbind;
+ push @{$self->{from_bind}}, @$$sqlbind;
+ return $sql;
+}
+
+sub _make_as {
+ my ($self, $from) = @_;
+ return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
+ : ref $_ eq 'REF' ? $self->_fold_sqlbind($_)
+ : $self->_quote($_))
+ } reverse each %{$self->_skip_options($from)});
+}
+
+sub _skip_options {
+ my ($self, $hash) = @_;
+ my $clean_hash = {};
+ $clean_hash->{$_} = $hash->{$_}
+ for grep {!/^-/} keys %$hash;
+ return $clean_hash;
+}
+
+sub _join_condition {
+ my ($self, $cond) = @_;
+ if (ref $cond eq 'HASH') {
+ my %j;
+ for (keys %$cond) {
+ my $v = $cond->{$_};
+ if (ref $v) {
+ croak (ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
+ if ref($v) ne 'SCALAR';
+ $j{$_} = $v;
+ }
+ else {
+ my $x = '= '.$self->_quote($v); $j{$_} = \$x;
+ }
+ };
+ return scalar($self->_recurse_where(\%j));
+ } elsif (ref $cond eq 'ARRAY') {
+ return join(' OR ', map { $self->_join_condition($_) } @$cond);
+ } else {
+ die "Can't handle this yet!";
+ }
+}
+
+sub _quote {
+ my ($self, $label) = @_;
+ return '' unless defined $label;
+ return "*" if $label eq '*';
+ return $label unless $self->{quote_char};
+ if(ref $self->{quote_char} eq "ARRAY"){
+ return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
+ if !defined $self->{name_sep};
+ my $sep = $self->{name_sep};
+ return join($self->{name_sep},
+ map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
+ split(/\Q$sep\E/,$label));
+ }
+ return $self->SUPER::_quote($label);
+}
+
+sub limit_dialect {
+ my $self = shift;
+ $self->{limit_dialect} = shift if @_;
+ return $self->{limit_dialect};
+}
+
+sub quote_char {
+ my $self = shift;
+ $self->{quote_char} = shift if @_;
+ return $self->{quote_char};
+}
+
+sub name_sep {
+ my $self = shift;
+ $self->{name_sep} = shift if @_;
+ return $self->{name_sep};
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+DBIx::Class::SQLAHacks - This module is a subclass of SQL::Abstract::Limit
+and includes a number of DBIC-specific workarounds, not yet suitable for
+inclusion into SQLA proper.
+
+=head1 METHODS
+
+=head2 new
+
+Tries to determine limit dialect.
+
+=head2 select
+
+Quotes table names, handles "limit" dialects (e.g. where rownum between x and
+y), supports SELECT ... FOR UPDATE and SELECT ... FOR SHARE.
+
+=head2 insert update delete
+
+Just quotes table names.
+
+=head2 limit_dialect
+
+Specifies the dialect of used for implementing an SQL "limit" clause for
+restricting the number of query results returned. Valid values are: RowNum.
+
+See L<DBIx::Class::Storage::DBI/connect_info> for details.
+
+=head2 name_sep
+
+Character separating quoted table names.
+
+See L<DBIx::Class::Storage::DBI/connect_info> for details.
+
+=head2 quote_char
+
+Set to an array-ref to specify separate left and right quotes for table names.
+
+See L<DBIx::Class::Storage::DBI/connect_info> for details.
+
+=cut
+
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Schema/Versioned.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Schema/Versioned.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Schema/Versioned.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -181,6 +181,8 @@
use strict;
use warnings;
use base 'DBIx::Class';
+
+use Carp::Clan qw/^DBIx::Class/;
use POSIX 'strftime';
__PACKAGE__->mk_classdata('_filedata');
@@ -225,7 +227,7 @@
# must be called on a fresh database
if ($self->get_db_version()) {
- warn 'Install not possible as versions table already exists in database';
+ carp 'Install not possible as versions table already exists in database';
}
# default to current version if none passed
@@ -291,13 +293,13 @@
# db unversioned
unless ($db_version) {
- warn 'Upgrade not possible as database is unversioned. Please call install first.';
+ carp 'Upgrade not possible as database is unversioned. Please call install first.';
return;
}
# db and schema at same version. do nothing
if ($db_version eq $self->schema_version) {
- print "Upgrade not necessary\n";
+ carp "Upgrade not necessary\n";
return;
}
@@ -317,11 +319,11 @@
$self->create_upgrade_path({ upgrade_file => $upgrade_file });
unless (-f $upgrade_file) {
- warn "Upgrade not possible, no upgrade file found ($upgrade_file), please create one\n";
+ carp "Upgrade not possible, no upgrade file found ($upgrade_file), please create one\n";
return;
}
- warn "\nDB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n";
+ carp "\nDB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n";
# backup if necessary then apply upgrade
$self->_filedata($self->_read_sql_file($upgrade_file));
@@ -391,7 +393,7 @@
sub apply_statement {
my ($self, $statement) = @_;
- $self->storage->dbh->do($_) or warn "SQL was:\n $_";
+ $self->storage->dbh->do($_) or carp "SQL was:\n $_";
}
=head2 get_db_version
@@ -490,17 +492,17 @@
if($pversion eq $self->schema_version)
{
-# warn "This version is already installed\n";
+# carp "This version is already installed\n";
return 1;
}
if(!$pversion)
{
- warn "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n";
+ carp "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n";
return 1;
}
- warn "Versions out of sync. This is " . $self->schema_version .
+ carp "Versions out of sync. This is " . $self->schema_version .
", your database contains version $pversion, please call upgrade on your Schema.\n";
}
@@ -563,7 +565,7 @@
print $file $diff;
close($file);
- print "WARNING: There may be differences between your DB and your DBIC schema. Please review and if necessary run the SQL in $filename to sync your DB.\n";
+ carp "WARNING: There may be differences between your DB and your DBIC schema. Please review and if necessary run the SQL in $filename to sync your DB.\n";
}
@@ -585,7 +587,7 @@
my $file = shift || return;
my $fh;
- open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
+ open $fh, "<$file" or carp("Can't open upgrade file, $file ($!)");
my @data = split(/\n/, join('', <$fh>));
@data = grep(!/^--/, @data);
@data = split(/;/, join('', @data));
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Schema.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Schema.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Schema.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -235,7 +235,7 @@
if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
if($rs_class && $rs_class ne $rs_set) {
- warn "We found ResultSet class '$rs_class' for '$result', but it seems "
+ carp "We found ResultSet class '$rs_class' for '$result', but it seems "
. "that you had already set '$result' to use '$rs_set' instead";
}
}
@@ -251,7 +251,7 @@
}
foreach (sort keys %resultsets) {
- warn "load_namespaces found ResultSet class $_ with no "
+ carp "load_namespaces found ResultSet class $_ with no "
. 'corresponding Result class';
}
@@ -344,7 +344,7 @@
my $snsub = $comp_class->can('source_name');
if(! $snsub ) {
- warn "Failed to load $comp_class. Can't find source_name method. Is $comp_class really a full DBIC result class? Fix it, move it elsewhere, or make your load_classes call more specific.";
+ carp "Failed to load $comp_class. Can't find source_name method. Is $comp_class really a full DBIC result class? Fix it, move it elsewhere, or make your load_classes call more specific.";
next;
}
$comp = $snsub->($comp_class) || $comp;
@@ -1350,7 +1350,7 @@
sub compose_connection {
my ($self, $target, @info) = @_;
- warn "compose_connection deprecated as of 0.08000"
+ carp "compose_connection deprecated as of 0.08000"
unless ($INC{"DBIx/Class/CDBICompat.pm"} || $warn++);
my $base = 'DBIx::Class::ResultSetProxy';
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Cursor.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Cursor.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Cursor.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -72,7 +72,7 @@
my @args = $storage->_select_args(@{$self->{args}});
my ($sql, $bind) = $storage->_prep_for_execute(@args[0 .. 2], [@args[4 .. $#args]]);
- return \[ "($sql)", @$bind ];
+ return \[ "($sql)", @{ $bind || [] }];
}
=head2 next
Deleted: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/MultiDistinctEmulation.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/MultiDistinctEmulation.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/MultiDistinctEmulation.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -1,51 +0,0 @@
-package DBIx::Class::Storage::DBI::MultiDistinctEmulation;
-
-use strict;
-use warnings;
-
-use base qw/DBIx::Class::Storage::DBI/;
-
-sub _select {
- my ($self, $ident, $select, $condition, $attrs) = @_;
-
- # hack to make count distincts with multiple columns work in SQLite and Oracle
- if (ref $select eq 'ARRAY') {
- @{$select} = map {$self->replace_distincts($_)} @{$select};
- } else {
- $select = $self->replace_distincts($select);
- }
-
- return $self->next::method($ident, $select, $condition, $attrs);
-}
-
-sub replace_distincts {
- my ($self, $select) = @_;
-
- $select->{count}->{distinct} = join("||", @{$select->{count}->{distinct}})
- if (ref $select eq 'HASH' && $select->{count} && ref $select->{count} eq 'HASH' &&
- $select->{count}->{distinct} && ref $select->{count}->{distinct} eq 'ARRAY');
-
- return $select;
-}
-
-1;
-
-=head1 NAME
-
-DBIx::Class::Storage::DBI::MultiDistinctEmulation - Some databases can't handle count distincts with multiple cols. They should use base on this.
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-This class allows count distincts with multiple columns for retarded databases (Oracle and SQLite)
-
-=head1 AUTHORS
-
-Luke Saunders <luke.saunders at gmail.com>
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/NoBindVars.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/NoBindVars.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/NoBindVars.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -61,7 +61,7 @@
}
$new_sql .= join '', @sql_part;
- return ($new_sql);
+ return ($new_sql, []);
}
=head1 AUTHORS
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -1,5 +1,4 @@
package DBIx::Class::Storage::DBI::Oracle::Generic;
-# -*- mode: cperl; cperl-indent-level: 2 -*-
use strict;
use warnings;
@@ -24,12 +23,12 @@
=cut
+use base qw/DBIx::Class::Storage::DBI/;
use Carp::Clan qw/^DBIx::Class/;
-use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/;
+# For ORA_BLOB => 113, ORA_CLOB => 112
+use DBD::Oracle qw( :ora_types );
-# __PACKAGE__->load_components(qw/PK::Auto/);
-
sub _dbh_last_insert_id {
my ($self, $dbh, $source, @columns) = @_;
my @ids = ();
@@ -190,6 +189,48 @@
$self->dbh->do("SAVEPOINT $name");
}
+=head2 source_bind_attributes
+
+Handle LOB types in Oracle. Under a certain size (4k?), you can get away
+with the driver assuming your input is the deprecated LONG type if you
+encode it as a hex string. That ain't gonna fly at larger values, where
+you'll discover you have to do what this does.
+
+This method had to be overridden because we need to set ora_field to the
+actual column, and that isn't passed to the call (provided by Storage) to
+bind_attribute_by_data_type.
+
+According to L<DBD::Oracle>, the ora_field isn't always necessary, but
+adding it doesn't hurt, and will save your bacon if you're modifying a
+table with more than one LOB column.
+
+=cut
+
+sub source_bind_attributes
+{
+ my $self = shift;
+ my($source) = @_;
+
+ my %bind_attributes;
+
+ foreach my $column ($source->columns) {
+ my $data_type = $source->column_info($column)->{data_type} || '';
+ next unless $data_type;
+
+ my %column_bind_attrs = $self->bind_attribute_by_data_type($data_type);
+
+ if ($data_type =~ /^[BC]LOB$/i) {
+ $column_bind_attrs{'ora_type'}
+ = uc($data_type) eq 'CLOB' ? ORA_CLOB : ORA_BLOB;
+ $column_bind_attrs{'ora_field'} = $column;
+ }
+
+ $bind_attributes{$column} = \%column_bind_attrs;
+ }
+
+ return \%bind_attributes;
+}
+
# Oracle automatically releases a savepoint when you start another one with the
# same name.
sub _svp_release { 1 }
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -5,95 +5,8 @@
use strict;
use warnings;
-__PACKAGE__->sql_maker_class('DBIC::SQL::Abstract::Oracle');
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::OracleJoins');
-BEGIN {
- package # Hide from PAUSE
- DBIC::SQL::Abstract::Oracle;
-
- use base qw( DBIC::SQL::Abstract );
-
- sub select {
- my ($self, $table, $fields, $where, $order, @rest) = @_;
-
- if (ref($table) eq 'ARRAY') {
- $where = $self->_oracle_joins($where, @{ $table });
- }
-
- return $self->SUPER::select($table, $fields, $where, $order, @rest);
- }
-
- sub _recurse_from {
- my ($self, $from, @join) = @_;
-
- my @sqlf = $self->_make_as($from);
-
- foreach my $j (@join) {
- my ($to, $on) = @{ $j };
-
- if (ref $to eq 'ARRAY') {
- push (@sqlf, $self->_recurse_from(@{ $to }));
- }
- else {
- push (@sqlf, $self->_make_as($to));
- }
- }
-
- return join q{, }, @sqlf;
- }
-
- sub _oracle_joins {
- my ($self, $where, $from, @join) = @_;
- my $join_where = {};
- $self->_recurse_oracle_joins($join_where, $from, @join);
- if (keys %$join_where) {
- if (!defined($where)) {
- $where = $join_where;
- } else {
- if (ref($where) eq 'ARRAY') {
- $where = { -or => $where };
- }
- $where = { -and => [ $join_where, $where ] };
- }
- }
- return $where;
- }
-
- sub _recurse_oracle_joins {
- my ($self, $where, $from, @join) = @_;
-
- foreach my $j (@join) {
- my ($to, $on) = @{ $j };
-
- if (ref $to eq 'ARRAY') {
- $self->_recurse_oracle_joins($where, @{ $to });
- }
-
- my $to_jt = ref $to eq 'ARRAY' ? $to->[0] : $to;
- my $left_join = q{};
- my $right_join = q{};
-
- if (ref $to_jt eq 'HASH' and exists $to_jt->{-join_type}) {
- #TODO: Support full outer joins -- this would happen much earlier in
- #the sequence since oracle 8's full outer join syntax is best
- #described as INSANE.
- die "Can't handle full outer joins in Oracle 8 yet!\n"
- if $to_jt->{-join_type} =~ /full/i;
-
- $left_join = q{(+)} if $to_jt->{-join_type} =~ /left/i
- && $to_jt->{-join_type} !~ /inner/i;
-
- $right_join = q{(+)} if $to_jt->{-join_type} =~ /right/i
- && $to_jt->{-join_type} !~ /inner/i;
- }
-
- foreach my $lhs (keys %{ $on }) {
- $where->{$lhs . $left_join} = \"= $on->{ $lhs }$right_join";
- }
- }
- }
-}
-
1;
__END__
@@ -135,34 +48,8 @@
=head1 METHODS
-This module replaces a subroutine contained in DBIC::SQL::Abstract:
+See L<DBIx::Class::SQLAHacks::OracleJoins> for implementation details.
-=over
-
-=item sql_maker
-
-=back
-
-It also creates a new module in its BEGIN { } block called
-DBIC::SQL::Abstract::Oracle which has the following methods:
-
-=over
-
-=item select ($\@$;$$@)
-
-Replaces DBIC::SQL::Abstract's select() method, which calls _oracle_joins()
-to modify the column and table list before calling SUPER::select().
-
-=item _recurse_from ($$\@)
-
-Recursive subroutine that builds the table list.
-
-=item _oracle_joins ($$$@)
-
-Creates the left/right relationship in the where query.
-
-=back
-
=head1 BUGS
Does not support full outer joins.
@@ -172,8 +59,10 @@
=over
-=item L<DBIC::SQL::Abstract>
+=item L<DBIx::Class::SQLAHacks>
+=item L<DBIx::Class::SQLAHacks::OracleJoins>
+
=item L<DBIx::Class::Storage::DBI::Oracle::Generic>
=item L<DBIx::Class>
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/SQLite.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/SQLite.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/SQLite.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -6,7 +6,7 @@
use File::Copy;
use File::Spec;
-use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/;
+use base qw/DBIx::Class::Storage::DBI/;
sub _dbh_last_insert_id {
my ($self, $dbh, $source, $col) = @_;
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -3,7 +3,10 @@
use strict;
use warnings;
-use base qw/DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server DBIx::Class::Storage::DBI::Sybase/;
+use base qw/
+ DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server
+ DBIx::Class::Storage::DBI::Sybase
+/;
1;
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/DBI.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -7,7 +7,7 @@
use warnings;
use Carp::Clan qw/^DBIx::Class/;
use DBI;
-use SQL::Abstract::Limit;
+use DBIx::Class::SQLAHacks;
use DBIx::Class::Storage::DBI::Cursor;
use DBIx::Class::Storage::Statistics;
use Scalar::Util qw/blessed weaken/;
@@ -29,379 +29,9 @@
__PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Cursor');
__PACKAGE__->mk_group_accessors('inherited' => qw/sql_maker_class/);
-__PACKAGE__->sql_maker_class('DBIC::SQL::Abstract');
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks');
-BEGIN {
-package # Hide from PAUSE
- DBIC::SQL::Abstract; # Would merge upstream, but nate doesn't reply :(
-
-use base qw/SQL::Abstract::Limit/;
-
-sub new {
- my $self = shift->SUPER::new(@_);
-
- # This prevents the caching of $dbh in S::A::L, I believe
- # If limit_dialect is a ref (like a $dbh), go ahead and replace
- # it with what it resolves to:
- $self->{limit_dialect} = $self->_find_syntax($self->{limit_dialect})
- if ref $self->{limit_dialect};
-
- $self;
-}
-
-
-
-# Some databases (sqlite) do not handle multiple parenthesis
-# around in/between arguments. A tentative x IN ( ( 1, 2 ,3) )
-# is interpreted as x IN 1 or something similar.
-#
-# Since we currently do not have access to the SQLA AST, resort
-# to barbaric mutilation of any SQL supplied in literal form
-
-sub _strip_outer_paren {
- my ($self, $arg) = @_;
-
- return $self->_SWITCH_refkind ($arg, {
- ARRAYREFREF => sub {
- $$arg->[0] = __strip_outer_paren ($$arg->[0]);
- return $arg;
- },
- SCALARREF => sub {
- return \__strip_outer_paren( $$arg );
- },
- FALLBACK => sub {
- return $arg
- },
- });
-}
-
-sub __strip_outer_paren {
- my $sql = shift;
-
- if ($sql and not ref $sql) {
- while ($sql =~ /^ \s* \( (.*) \) \s* $/x ) {
- $sql = $1;
- }
- }
-
- return $sql;
-}
-
-sub _where_field_IN {
- my ($self, $lhs, $op, $rhs) = @_;
- $rhs = $self->_strip_outer_paren ($rhs);
- return $self->SUPER::_where_field_IN ($lhs, $op, $rhs);
-}
-
-sub _where_field_BETWEEN {
- my ($self, $lhs, $op, $rhs) = @_;
- $rhs = $self->_strip_outer_paren ($rhs);
- return $self->SUPER::_where_field_BETWEEN ($lhs, $op, $rhs);
-}
-
-
-
-# DB2 is the only remaining DB using this. Even though we are not sure if
-# RowNumberOver is still needed here (should be part of SQLA) leave the
-# code in place
-sub _RowNumberOver {
- my ($self, $sql, $order, $rows, $offset ) = @_;
-
- $offset += 1;
- my $last = $rows + $offset;
- my ( $order_by ) = $self->_order_by( $order );
-
- $sql = <<"SQL";
-SELECT * FROM
-(
- SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
- $sql
- $order_by
- ) Q1
-) Q2
-WHERE ROW_NUM BETWEEN $offset AND $last
-
-SQL
-
- return $sql;
-}
-
-
-# While we're at it, this should make LIMIT queries more efficient,
-# without digging into things too deeply
-use Scalar::Util 'blessed';
-sub _find_syntax {
- my ($self, $syntax) = @_;
-
- # DB2 is the only remaining DB using this. Even though we are not sure if
- # RowNumberOver is still needed here (should be part of SQLA) leave the
- # code in place
- my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax;
- if(ref($self) && $dbhname && $dbhname eq 'DB2') {
- return 'RowNumberOver';
- }
-
- $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
-}
-
-sub select {
- my ($self, $table, $fields, $where, $order, @rest) = @_;
- if (ref $table eq 'SCALAR') {
- $table = $$table;
- }
- elsif (not ref $table) {
- $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];
- die "LIMIT 0 Does Not Compute" if $rest[0] == 0;
- # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
- local $self->{having_bind} = [];
- my ($sql, @ret) = $self->SUPER::select(
- $table, $self->_recurse_fields($fields), $where, $order, @rest
- );
- $sql .=
- $self->{for} ?
- (
- $self->{for} eq 'update' ? ' FOR UPDATE' :
- $self->{for} eq 'shared' ? ' FOR SHARE' :
- ''
- ) :
- ''
- ;
- return wantarray ? ($sql, @ret, @{$self->{having_bind}}) : $sql;
-}
-
-sub insert {
- my $self = shift;
- my $table = shift;
- $table = $self->_quote($table) unless ref($table);
- $self->SUPER::insert($table, @_);
-}
-
-sub update {
- my $self = shift;
- my $table = shift;
- $table = $self->_quote($table) unless ref($table);
- $self->SUPER::update($table, @_);
-}
-
-sub delete {
- my $self = shift;
- my $table = shift;
- $table = $self->_quote($table) unless ref($table);
- $self->SUPER::delete($table, @_);
-}
-
-sub _emulate_limit {
- my $self = shift;
- if ($_[3] == -1) {
- return $_[1].$self->_order_by($_[2]);
- } else {
- return $self->SUPER::_emulate_limit(@_);
- }
-}
-
-sub _recurse_fields {
- my ($self, $fields, $params) = @_;
- my $ref = ref $fields;
- return $self->_quote($fields) unless $ref;
- return $$fields if $ref eq 'SCALAR';
-
- if ($ref eq 'ARRAY') {
- return join(', ', map {
- $self->_recurse_fields($_)
- .(exists $self->{rownum_hack_count} && !($params && $params->{no_rownum_hack})
- ? ' AS col'.$self->{rownum_hack_count}++
- : '')
- } @$fields);
- } elsif ($ref eq 'HASH') {
- foreach my $func (keys %$fields) {
- return $self->_sqlcase($func)
- .'( '.$self->_recurse_fields($fields->{$func}).' )';
- }
- }
- # Is the second check absolutely necessary?
- elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
- return $self->_bind_to_sql( $fields );
- }
- else {
- Carp::croak($ref . qq{ unexpected in _recurse_fields()})
- }
-}
-
-sub _order_by {
- my $self = shift;
- my $ret = '';
- my @extra;
- if (ref $_[0] eq 'HASH') {
- if (defined $_[0]->{group_by}) {
- $ret = $self->_sqlcase(' group by ')
- .$self->_recurse_fields($_[0]->{group_by}, { no_rownum_hack => 1 });
- }
- if (defined $_[0]->{having}) {
- my $frag;
- ($frag, @extra) = $self->_recurse_where($_[0]->{having});
- push(@{$self->{having_bind}}, @extra);
- $ret .= $self->_sqlcase(' having ').$frag;
- }
- if (defined $_[0]->{order_by}) {
- $ret .= $self->_order_by($_[0]->{order_by});
- }
- if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) {
- return $self->SUPER::_order_by($_[0]);
- }
- } elsif (ref $_[0] eq 'SCALAR') {
- $ret = $self->_sqlcase(' order by ').${ $_[0] };
- } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
- my @order = @{+shift};
- $ret = $self->_sqlcase(' order by ')
- .join(', ', map {
- my $r = $self->_order_by($_, @_);
- $r =~ s/^ ?ORDER BY //i;
- $r;
- } @order);
- } else {
- $ret = $self->SUPER::_order_by(@_);
- }
- return $ret;
-}
-
-sub _order_directions {
- my ($self, $order) = @_;
- $order = $order->{order_by} if ref $order eq 'HASH';
- return $self->SUPER::_order_directions($order);
-}
-
-sub _table {
- my ($self, $from) = @_;
- if (ref $from eq 'ARRAY') {
- return $self->_recurse_from(@$from);
- } elsif (ref $from eq 'HASH') {
- return $self->_make_as($from);
- } else {
- return $from; # would love to quote here but _table ends up getting called
- # twice during an ->select without a limit clause due to
- # the way S::A::Limit->select works. should maybe consider
- # bypassing this and doing S::A::select($self, ...) in
- # our select method above. meantime, quoting shims have
- # been added to select/insert/update/delete here
- }
-}
-
-sub _recurse_from {
- my ($self, $from, @join) = @_;
- my @sqlf;
- push(@sqlf, $self->_make_as($from));
- 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 ';
- }
- push(@sqlf, $join_clause);
-
- if (ref $to eq 'ARRAY') {
- push(@sqlf, '(', $self->_recurse_from(@$to), ')');
- } else {
- push(@sqlf, $self->_make_as($to));
- }
- push(@sqlf, ' ON ', $self->_join_condition($on));
- }
- return join('', @sqlf);
-}
-
-sub _bind_to_sql {
- my $self = shift;
- my $arr = shift;
- my $sql = shift @$$arr;
- $sql =~ s/\?/$self->_quote((shift @$$arr)->[1])/eg;
- return $sql
-}
-
-sub _make_as {
- my ($self, $from) = @_;
- return join(' ', map { (ref $_ eq 'SCALAR' ? $$_
- : ref $_ eq 'REF' ? $self->_bind_to_sql($_)
- : $self->_quote($_))
- } reverse each %{$self->_skip_options($from)});
-}
-
-sub _skip_options {
- my ($self, $hash) = @_;
- my $clean_hash = {};
- $clean_hash->{$_} = $hash->{$_}
- for grep {!/^-/} keys %$hash;
- return $clean_hash;
-}
-
-sub _join_condition {
- my ($self, $cond) = @_;
- if (ref $cond eq 'HASH') {
- my %j;
- for (keys %$cond) {
- my $v = $cond->{$_};
- if (ref $v) {
- # XXX no throw_exception() in this package and croak() fails with strange results
- Carp::croak(ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
- if ref($v) ne 'SCALAR';
- $j{$_} = $v;
- }
- else {
- my $x = '= '.$self->_quote($v); $j{$_} = \$x;
- }
- };
- return scalar($self->_recurse_where(\%j));
- } elsif (ref $cond eq 'ARRAY') {
- return join(' OR ', map { $self->_join_condition($_) } @$cond);
- } else {
- die "Can't handle this yet!";
- }
-}
-
-sub _quote {
- my ($self, $label) = @_;
- return '' unless defined $label;
- return "*" if $label eq '*';
- return $label unless $self->{quote_char};
- if(ref $self->{quote_char} eq "ARRAY"){
- return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
- if !defined $self->{name_sep};
- my $sep = $self->{name_sep};
- return join($self->{name_sep},
- map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
- split(/\Q$sep\E/,$label));
- }
- return $self->SUPER::_quote($label);
-}
-
-sub limit_dialect {
- my $self = shift;
- $self->{limit_dialect} = shift if @_;
- return $self->{limit_dialect};
-}
-
-sub quote_char {
- my $self = shift;
- $self->{quote_char} = shift if @_;
- return $self->{quote_char};
-}
-
-sub name_sep {
- my $self = shift;
- $self->{name_sep} = shift if @_;
- return $self->{name_sep};
-}
-
-} # End of BEGIN block
-
=head1 NAME
DBIx::Class::Storage::DBI - DBI storage handler
@@ -1672,7 +1302,7 @@
my ($self, $schema, $databases, $version, $dir, $preversion, $sqltargs) = @_;
if(!$dir || !-d $dir) {
- warn "No directory given, using ./\n";
+ carp "No directory given, using ./\n";
$dir = "./";
}
$databases ||= ['MySQL', 'SQLite', 'PostgreSQL'];
@@ -1695,7 +1325,8 @@
my $sqlt = SQL::Translator->new( $sqltargs );
$sqlt->parser('SQL::Translator::Parser::DBIx::Class');
- my $sqlt_schema = $sqlt->translate({ data => $schema }) or die $sqlt->error;
+ my $sqlt_schema = $sqlt->translate({ data => $schema })
+ or $self->throw_exception ($sqlt->error);
foreach my $db (@$databases) {
$sqlt->reset();
@@ -1706,13 +1337,13 @@
my $filename = $schema->ddl_filename($db, $version, $dir);
if (-e $filename && ($version eq $schema_version )) {
# if we are dumping the current version, overwrite the DDL
- warn "Overwriting existing DDL file - $filename";
+ carp "Overwriting existing DDL file - $filename";
unlink($filename);
}
my $output = $sqlt->translate;
if(!$output) {
- warn("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
+ carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
next;
}
if(!open($file, ">$filename")) {
@@ -1728,13 +1359,13 @@
my $prefilename = $schema->ddl_filename($db, $preversion, $dir);
if(!-e $prefilename) {
- warn("No previous schema file found ($prefilename)");
+ carp("No previous schema file found ($prefilename)");
next;
}
my $difffile = $schema->ddl_filename($db, $version, $dir, $preversion);
if(-e $difffile) {
- warn("Overwriting existing diff file - $difffile");
+ carp("Overwriting existing diff file - $difffile");
unlink($difffile);
}
@@ -1743,26 +1374,37 @@
my $t = SQL::Translator->new($sqltargs);
$t->debug( 0 );
$t->trace( 0 );
- $t->parser( $db ) or die $t->error;
- my $out = $t->translate( $prefilename ) or die $t->error;
+
+ $t->parser( $db )
+ or $self->throw_exception ($t->error);
+
+ my $out = $t->translate( $prefilename )
+ or $self->throw_exception ($t->error);
+
$source_schema = $t->schema;
- unless ( $source_schema->name ) {
- $source_schema->name( $prefilename );
- }
+
+ $source_schema->name( $prefilename )
+ unless ( $source_schema->name );
}
# The "new" style of producers have sane normalization and can support
# diffing a SQL file against a DBIC->SQLT schema. Old style ones don't
# And we have to diff parsed SQL against parsed SQL.
my $dest_schema = $sqlt_schema;
-
+
unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) {
my $t = SQL::Translator->new($sqltargs);
$t->debug( 0 );
$t->trace( 0 );
- $t->parser( $db ) or die $t->error;
- my $out = $t->translate( $filename ) or die $t->error;
+
+ $t->parser( $db )
+ or $self->throw_exception ($t->error);
+
+ my $out = $t->translate( $filename )
+ or $self->throw_exception ($t->error);
+
$dest_schema = $t->schema;
+
$dest_schema->name( $filename )
unless $dest_schema->name;
}
@@ -1854,7 +1496,7 @@
$self->dbh->do($line); # shouldn't be using ->dbh ?
};
if ($@) {
- warn qq{$@ (running "${line}")};
+ carp qq{$@ (running "${line}")};
}
$self->_query_end($line);
};
@@ -1976,38 +1618,7 @@
be with raw DBI.
-=head1 SQL METHODS
-The module defines a set of methods within the DBIC::SQL::Abstract
-namespace. These build on L<SQL::Abstract::Limit> to provide the
-SQL query functions.
-
-The following methods are extended:-
-
-=over 4
-
-=item delete
-
-=item insert
-
-=item select
-
-=item update
-
-=item limit_dialect
-
-See L</connect_info> for details.
-
-=item quote_char
-
-See L</connect_info> for details.
-
-=item name_sep
-
-See L</connect_info> for details.
-
-=back
-
=head1 AUTHORS
Matt S. Trout <mst at shadowcatsystems.co.uk>
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/TxnScopeGuard.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/TxnScopeGuard.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage/TxnScopeGuard.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -2,6 +2,7 @@
use strict;
use warnings;
+use Carp ();
sub new {
my ($class, $storage) = @_;
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class/Storage.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -328,7 +328,7 @@
=head2 sql_maker
Returns a C<sql_maker> object - normally an object of class
-C<DBIC::SQL::Abstract>.
+C<DBIx::Class::SQLAHacks>.
=cut
Modified: DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/lib/DBIx/Class.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -275,6 +275,8 @@
ningu: David Kamholz <dkamholz at cpan.org>
+Nniuq: Ron "Quinn" Straight" <quinnfazigu at gmail.org>
+
norbi: Norbert Buchmuller <norbi at nix.hu>
Numa: Dan Sully <daniel at cpan.org>
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/03podcoverage.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/03podcoverage.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/03podcoverage.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -99,7 +99,6 @@
'DBIx::Class::Storage::DBI' => { skip => 1 },
'DBIx::Class::Storage::DBI::DB2' => { skip => 1 },
'DBIx::Class::Storage::DBI::MSSQL' => { skip => 1 },
- 'DBIx::Class::Storage::DBI::MultiDistinctEmulation' => { skip => 1 },
'DBIx::Class::Storage::DBI::ODBC400' => { skip => 1 },
'DBIx::Class::Storage::DBI::ODBC::DB2_400_SQL' => { skip => 1 },
'DBIx::Class::Storage::DBI::Oracle' => { skip => 1 },
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/04dont_break_c3.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/04dont_break_c3.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/04dont_break_c3.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -1,11 +1,11 @@
-#!/usr/bin/perl -w
-#Simon Ilyushchenko, 12/05/05
-#Testing the case when we try to inject into @ISA a class that's already a parent of the target class.
use strict;
use Test::More tests => 2;
use MRO::Compat;
+use lib qw(t/lib);
+use DBICTest; # do not remove even though it is not used
+
{
package AAA;
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/103many_to_many_warning.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/103many_to_many_warning.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/103many_to_many_warning.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -5,42 +5,38 @@
use lib qw(t/lib);
use Data::Dumper;
-plan ( ($] >= 5.009000 and $] < 5.010001)
- ? (skip_all => 'warnings::register broken under 5.10: http://rt.perl.org/rt3/Public/Bug/Display.html?id=62522')
- : (tests => 4)
-);
+plan tests => 4;
+my $exp_warn = qr/The many-to-many relationship 'bars' is trying to create/;
{
my @w;
- local $SIG{__WARN__} = sub { push @w, @_ };
+ local $SIG{__WARN__} = sub { $_[0] =~ $exp_warn ? push @w, $_[0] : warn $_[0] };
my $code = gen_code ( suffix => 1 );
eval "$code";
ok (! $@, 'Eval code without warnings suppression')
|| diag $@;
- ok ( (grep { $_ =~ /The many-to-many relationship bars is trying to create/ } @w), "Warning triggered without relevant 'no warnings'");
+ ok (@w, "Warning triggered without DBIC_OVERWRITE_HELPER_METHODS_OK");
}
{
my @w;
- local $SIG{__WARN__} = sub { push @w, @_ };
+ local $SIG{__WARN__} = sub { $_[0] =~ $exp_warn ? push @w, $_[0] : warn $_[0] };
- my $code = gen_code ( suffix => 2, no_warn => 1 );
+ my $code = gen_code ( suffix => 2 );
+
+ local $ENV{DBIC_OVERWRITE_HELPER_METHODS_OK} = 1;
eval "$code";
ok (! $@, 'Eval code with warnings suppression')
|| diag $@;
- ok ( (not grep { $_ =~ /The many-to-many relationship bars is trying to create/ } @w), "No warning triggered with relevant 'no warnings'");
+ ok (! @w, "No warning triggered with DBIC_OVERWRITE_HELPER_METHODS_OK");
}
sub gen_code {
my $args = { @_ };
my $suffix = $args->{suffix};
- my $no_warn = ( $args->{no_warn}
- ? "no warnings 'DBIx::Class::Relationship::ManyToMany';"
- : '',
- );
return <<EOF;
use strict;
@@ -95,7 +91,6 @@
},
);
- ${no_warn}
__PACKAGE__->set_primary_key('barid');
__PACKAGE__->has_many('foo_to_bar' => 'DBICTest::Schema::FooToBar${suffix}' => 'foo');
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_1.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_1.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_1.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -4,7 +4,8 @@
use warnings;
use Test::More;
-unshift(@INC, './t/lib');
+use lib qw(t/lib);
+use DBICTest; # do not remove even though it is not used
plan tests => 8;
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_2.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_2.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_2.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -4,7 +4,8 @@
use warnings;
use Test::More;
-unshift(@INC, './t/lib');
+use lib qw(t/lib);
+use DBICTest; # do not remove even though it is not used
plan tests => 6;
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_3.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_3.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_3.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -4,7 +4,8 @@
use warnings;
use Test::More;
-unshift(@INC, './t/lib');
+use lib qw(t/lib);
+use DBICTest; # do not remove even though it is not used
plan tests => 7;
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_4.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_4.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_4.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -4,7 +4,8 @@
use warnings;
use Test::More;
-unshift(@INC, './t/lib');
+use lib qw(t/lib);
+use DBICTest; # do not remove even though it is not used
plan tests => 6;
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_rt41083.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_rt41083.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/39load_namespaces_rt41083.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -4,6 +4,7 @@
use warnings;
use lib 't/lib';
+use DBICTest; # do not remove even though it is not used
use Test::More tests => 8;
sub _chk_warning {
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/41orrible.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/41orrible.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/41orrible.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -2,14 +2,15 @@
use warnings;
use Test::More;
-use DBIx::Class::Storage::DBI::Oracle::WhereJoins;
+use DBIx::Class::SQLAHacks::OracleJoins;
use lib qw(t/lib);
+use DBICTest; # do not remove even though it is not used
use DBIC::SqlMakerTest;
plan tests => 4;
-my $sa = new DBIC::SQL::Abstract::Oracle;
+my $sa = new DBIx::Class::SQLAHacks::OracleJoins;
$sa->limit_dialect('RowNum');
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/42toplimit.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/42toplimit.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/42toplimit.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -3,10 +3,12 @@
use Test::More;
use DBIx::Class::Storage::DBI;
+use lib qw(t/lib);
+use DBICTest; # do not remove even though it is not used
plan tests => 1;
-my $sa = new DBIC::SQL::Abstract;
+my $sa = new DBIx::Class::SQLAHacks;
$sa->limit_dialect( 'Top' );
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/47bind_attribute.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/47bind_attribute.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/47bind_attribute.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -3,19 +3,19 @@
use Test::More;
use lib qw(t/lib);
-use DBICTest;
+use DBIC::SqlMakerTest;
+use_ok('DBICTest');
+
my $schema = DBICTest->init_schema;
BEGIN {
eval "use DBD::SQLite";
plan $@
? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 7 );
+ : ( tests => 9 );
}
-### $schema->storage->debug(1);
-
my $where_bind = {
where => \'name like ?',
bind => [ 'Cat%' ],
@@ -55,10 +55,10 @@
$new_source->source_name('Complex');
$new_source->name(\<<'');
-( select a.*, cd.cdid as cdid, cd.title as title, cd.year as year
- from artist a
- join cd on cd.artist=a.artistid
- where cd.year=?)
+( SELECT a.*, cd.cdid AS cdid, cd.title AS title, cd.year AS year
+ FROM artist a
+ JOIN cd ON cd.artist = a.artistid
+ WHERE cd.year = ?)
$schema->register_extra_source('Complex' => $new_source);
@@ -72,11 +72,22 @@
->search({ 'artistid' => 1 });
is ( $rs->count, 1, '...cookbook (bind first) + chained search' );
+{
+ $rs = $schema->resultset('Complex')->search({}, { bind => [ 1999 ] })->search({}, { where => \"title LIKE ?", bind => [ 'Spoon%' ] });
+ my ($sql, @bind) = @${$rs->as_query};
+ is_same_sql_bind(
+ $sql, \@bind,
+ "(SELECT me.artistid, me.name, me.rank, me.charfield FROM (SELECT a.*, cd.cdid AS cdid, cd.title AS title, cd.year AS year FROM artist a JOIN cd ON cd.artist = a.artistid WHERE cd.year = ?) WHERE title LIKE ?)",
+ [
+ [ '!!dummy' => '1999' ],
+ [ '!!dummy' => 'Spoon%' ]
+ ],
+ 'got correct SQL'
+);
+
+}
+
TODO: {
- # not sure what causes an uninit warning here, please remove when the TODO starts to pass,
- # so the real reason for the warning can be found and fixed
- local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /uninitialized/ };
-
local $TODO = 'bind args order needs fixing (semifor)';
$rs = $schema->resultset('Complex')->search({}, { bind => [ 1999 ] })
->search({ 'artistid' => 1 }, {
Deleted: DBIx-Class/0.08/branches/storage-tweaks/t/53delete_related.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/53delete_related.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/53delete_related.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -1,30 +0,0 @@
-use Test::More;
-use strict;
-use warnings;
-use lib qw(t/lib);
-use DBICTest;
-
-plan tests => 7;
-
-my $schema = DBICTest->init_schema();
-my $total_cds = $schema->resultset('CD')->count;
-cmp_ok($total_cds, '>', 0, 'need cd records');
-
-# test that delete_related w/o conditions deletes all related records only
-my $artist = $schema->resultset("Artist")->find(3);
-my $artist_cds = $artist->cds->count;
-cmp_ok($artist_cds, '<', $total_cds, 'need more cds than just related cds');
-
-ok($artist->delete_related('cds'));
-cmp_ok($schema->resultset('CD')->count, '==', ($total_cds - $artist_cds), 'wrong number of cds were deleted');
-
-$total_cds -= $artist_cds;
-
-# test that delete_related w/conditions deletes just the matched related records only
-my $artist2 = $schema->resultset("Artist")->find(2);
-my $artist2_cds = $artist2->search_related('cds')->count;
-cmp_ok($artist2_cds, '<', $total_cds, 'need more cds than related cds');
-
-ok($artist2->delete_related('cds', {title => {like => '%'}}));
-cmp_ok($schema->resultset('CD')->count, '==', ($total_cds - $artist2_cds), 'wrong number of cds were deleted');
-
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/60core.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/60core.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/60core.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -8,7 +8,7 @@
my $schema = DBICTest->init_schema();
-plan tests => 95;
+plan tests => 96;
eval { require DateTime::Format::MySQL };
my $NO_DTFM = $@ ? 1 : 0;
@@ -28,7 +28,7 @@
my @art = $schema->resultset("Artist")->search({ }, { order_by => 'name DESC'});
-cmp_ok(@art, '==', 3, "Three artists returned");
+is(@art, 3, "Three artists returned");
my $art = $art[0];
@@ -39,7 +39,7 @@
is($art->name, 'We Are In Rehab', "Accessor update ok");
my %dirty = $art->get_dirty_columns();
-cmp_ok(scalar(keys(%dirty)), '==', 1, '1 dirty column');
+is(scalar(keys(%dirty)), 1, '1 dirty column');
ok(grep($_ eq 'name', keys(%dirty)), 'name is dirty');
is($art->get_column("name"), 'We Are In Rehab', 'And via get_column');
@@ -47,7 +47,7 @@
ok($art->update, 'Update run');
my %not_dirty = $art->get_dirty_columns();
-cmp_ok(scalar(keys(%not_dirty)), '==', 0, 'Nothing is dirty');
+is(scalar(keys(%not_dirty)), 0, 'Nothing is dirty');
eval {
my $ret = $art->make_column_dirty('name2');
@@ -55,7 +55,7 @@
ok(defined($@), 'Failed to make non-existent column dirty');
$art->make_column_dirty('name');
my %fake_dirty = $art->get_dirty_columns();
-cmp_ok(scalar(keys(%fake_dirty)), '==', 1, '1 fake dirty column');
+is(scalar(keys(%fake_dirty)), 1, '1 fake dirty column');
ok(grep($_ eq 'name', keys(%fake_dirty)), 'name is fake dirty');
my $record_jp = $schema->resultset("Artist")->search(undef, { join => 'cds' })->search(undef, { prefetch => 'cds' })->next;
@@ -68,15 +68,15 @@
@art = $schema->resultset("Artist")->search({ name => 'We Are In Rehab' });
-cmp_ok(@art, '==', 1, "Changed artist returned by search");
+is(@art, 1, "Changed artist returned by search");
-cmp_ok($art[0]->artistid, '==', 3,'Correct artist too');
+is($art[0]->artistid, 3,'Correct artist too');
lives_ok (sub { $art->delete }, 'Cascading delete on Ordered has_many works' ); # real test in ordered.t
@art = $schema->resultset("Artist")->search({ });
-cmp_ok(@art, '==', 2, 'And then there were two');
+is(@art, 2, 'And then there were two');
ok(!$art->in_storage, "It knows it's dead");
@@ -90,15 +90,15 @@
@art = $schema->resultset("Artist")->search({ });
-cmp_ok(@art, '==', 3, 'And now there are three again');
+is(@art, 3, 'And now there are three again');
my $new = $schema->resultset("Artist")->create({ artistid => 4 });
-cmp_ok($new->artistid, '==', 4, 'Create produced record ok');
+is($new->artistid, 4, 'Create produced record ok');
@art = $schema->resultset("Artist")->search({ });
-cmp_ok(@art, '==', 4, "Oh my god! There's four of them!");
+is(@art, 4, "Oh my god! There's four of them!");
$new->set_column('name' => 'Man With A Fork');
@@ -152,7 +152,7 @@
my $cd = $schema->resultset("CD")->find(1);
my %cols = $cd->get_columns;
-cmp_ok(keys %cols, '==', 6, 'get_columns number of columns ok');
+is(keys %cols, 6, 'get_columns number of columns ok');
is($cols{title}, 'Spoonful of bees', 'get_columns values ok');
@@ -235,31 +235,40 @@
my( $or_rs ) = $schema->resultset("CD")->search_rs($search, { join => 'tags',
order_by => 'cdid' });
-cmp_ok($or_rs->count, '==', 5, 'Search with OR ok');
+is($or_rs->count, 5, 'Search with OR ok');
my $distinct_rs = $schema->resultset("CD")->search($search, { join => 'tags', distinct => 1 });
-cmp_ok($distinct_rs->all, '==', 4, 'DISTINCT search with OR ok');
+is($distinct_rs->all, 4, 'DISTINCT search with OR ok');
SKIP: {
skip "SQLite < 3.2.6 doesn't understand COUNT(DISTINCT())", 2
if $is_broken_sqlite;
- my $tcount = $schema->resultset("Track")->search(
+ my $tcount = $schema->resultset('Track')->search(
{},
- {
- select => {count => {distinct => ['position', 'title']}},
- as => ['count']
+ {
+ select => [ qw/position title/ ],
+ distinct => 1,
}
);
- cmp_ok($tcount->next->get_column('count'), '==', 13, 'multiple column COUNT DISTINCT ok');
+ is($tcount->count, 13, 'multiple column COUNT DISTINCT ok');
- $tcount = $schema->resultset("Track")->search(
+ $tcount = $schema->resultset('Track')->search(
{},
- {
- columns => {count => {count => {distinct => ['position', 'title']}}},
+ {
+ columns => [ qw/position title/ ],
+ distinct => 1,
}
);
- cmp_ok($tcount->next->get_column('count'), '==', 13, 'multiple column COUNT DISTINCT using column syntax ok');
+ is($tcount->count, 13, 'multiple column COUNT DISTINCT ok');
+
+ $tcount = $schema->resultset('Track')->search(
+ {},
+ {
+ group_by => [ qw/position title/ ]
+ }
+ );
+ is($tcount->count, 13, 'multiple column COUNT DISTINCT using column syntax ok');
}
my $tag_rs = $schema->resultset('Tag')->search(
@@ -267,17 +276,17 @@
my $rel_rs = $tag_rs->search_related('cd');
-cmp_ok($rel_rs->count, '==', 5, 'Related search ok');
+is($rel_rs->count, 5, 'Related search ok');
-cmp_ok($or_rs->next->cdid, '==', $rel_rs->next->cdid, 'Related object ok');
+is($or_rs->next->cdid, $rel_rs->next->cdid, 'Related object ok');
$or_rs->reset;
$rel_rs->reset;
my $tag = $schema->resultset('Tag')->search(
[ { 'me.tag' => 'Blue' } ], { cols=>[qw/tagid/] } )->next;
-cmp_ok($tag->has_column_loaded('tagid'), '==', 1, 'Has tagid loaded');
-cmp_ok($tag->has_column_loaded('tag'), '==', 0, 'Has not tag loaded');
+ok($tag->has_column_loaded('tagid'), 'Has tagid loaded');
+ok(!$tag->has_column_loaded('tag'), 'Has not tag loaded');
ok($schema->storage(), 'Storage available');
@@ -309,7 +318,7 @@
ok($schema->source('SourceNameArtists'), 'SourceNameArtists result source exists');
my @artsn = $schema->resultset('SourceNameArtists')->search({}, { order_by => 'name DESC' });
- cmp_ok(@artsn, '==', 4, "Four artists returned");
+ is(@artsn, 4, "Four artists returned");
# make sure subclasses that don't set source_name are ok
ok($schema->source('ArtistSubclass'), 'ArtistSubclass exists');
@@ -323,8 +332,8 @@
{
my $art_del = $schema->resultset("Artist")->find({ artistid => 1 });
lives_ok (sub { $art_del->delete }, 'Cascading delete on Ordered has_many works' ); # real test in ordered.t
- cmp_ok( $schema->resultset("CD")->search({artist => 1}), '==', 0, 'Cascading through has_many top level.');
- cmp_ok( $schema->resultset("CD_to_Producer")->search({cd => 1}), '==', 0, 'Cascading through has_many children.');
+ is( $schema->resultset("CD")->search({artist => 1}), 0, 'Cascading through has_many top level.');
+ is( $schema->resultset("CD_to_Producer")->search({cd => 1}), 0, 'Cascading through has_many children.');
}
# test column_info
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/66relationship.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/66relationship.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/66relationship.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -8,7 +8,7 @@
my $schema = DBICTest->init_schema();
-plan tests => 74;
+plan tests => 78;
# has_a test
my $cd = $schema->resultset("CD")->find(4);
@@ -189,6 +189,14 @@
is( $prod_rs->first->name, 'Matt S Trout',
'many_to_many add_to_$rel($obj) ok' );
$cd->remove_from_producers($prod);
+$cd->add_to_producers($prod, {attribute => 1});
+is( $prod_rs->count(), 1, 'many_to_many add_to_$rel($obj, $link_vals) count ok' );
+is( $cd->cd_to_producer->first->attribute, 1, 'many_to_many $link_vals ok');
+$cd->remove_from_producers($prod);
+$cd->set_producers([$prod], {attribute => 2});
+is( $prod_rs->count(), 1, 'many_to_many set_$rel($obj, $link_vals) count ok' );
+is( $cd->cd_to_producer->first->attribute, 2, 'many_to_many $link_vals ok');
+$cd->remove_from_producers($prod);
is( $schema->resultset('Producer')->find(1)->name, 'Matt S Trout',
"producer object exists after remove of link" );
is( $prod_rs->count, 0, 'many_to_many remove_from_$rel($obj) ok' );
@@ -234,6 +242,7 @@
is( $twokey->fourkeys_to_twokeys->count, 0,
'twokey has no links to fourkey' );
+
my $undef_artist_cd = $schema->resultset("CD")->new_result({ 'title' => 'badgers', 'year' => 2007 });
is($undef_artist_cd->has_column_loaded('artist'), '', 'FK not loaded');
is($undef_artist_cd->search_related('artist')->count, 0, '0=1 search when FK does not exist and object not yet in db');
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/71mysql.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/71mysql.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/71mysql.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -2,6 +2,7 @@
use warnings;
use Test::More;
+use Test::Exception;
use lib qw(t/lib);
use DBICTest;
use DBI::Const::GetInfoType;
@@ -13,7 +14,7 @@
plan skip_all => 'Set $ENV{DBICTEST_MYSQL_DSN}, _USER and _PASS to run this test'
unless ($dsn && $user);
-plan tests => 10;
+plan tests => 11;
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
@@ -23,6 +24,18 @@
$dbh->do("CREATE TABLE artist (artistid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(100), rank INTEGER NOT NULL DEFAULT '13', charfield CHAR(10));");
+$dbh->do("DROP TABLE IF EXISTS cd;");
+
+$dbh->do("CREATE TABLE cd (cdid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, artist INTEGER, title TEXT, year INTEGER, genreid INTEGER, single_track INTEGER);");
+
+$dbh->do("DROP TABLE IF EXISTS producer;");
+
+$dbh->do("CREATE TABLE producer (producerid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name TEXT);");
+
+$dbh->do("DROP TABLE IF EXISTS cd_to_producer;");
+
+$dbh->do("CREATE TABLE cd_to_producer (cd INTEGER,producer INTEGER);");
+
#'dbi:mysql:host=localhost;database=dbic_test', 'dbic_test', '');
# This is in Core now, but it's here just to test that it doesn't break
@@ -41,7 +54,7 @@
offset => 2,
order_by => 'artistid' }
);
-is( $it->count, 3, "LIMIT count ok" );
+is( $it->count, 3, "LIMIT count ok" ); # ask for 3 rows out of 7 artists
is( $it->next->name, "Artist 2", "iterator->next ok" );
$it->next;
$it->next;
@@ -119,8 +132,13 @@
=> 'Nothing Found!';
}
+my $cd = $schema->resultset ('CD')->create ({});
+my $producer = $schema->resultset ('Producer')->create ({});
+
+lives_ok { $cd->set_producers ([ $producer ]) } 'set_relationship doesnt die';
+
# clean up our mess
END {
#$dbh->do("DROP TABLE artist") if $dbh;
-}
\ No newline at end of file
+}
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/73oracle.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/73oracle.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/73oracle.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -28,6 +28,7 @@
use strict;
use warnings;
+use Test::Exception;
use Test::More;
use lib qw(t/lib);
use DBICTest;
@@ -39,7 +40,7 @@
' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\''
unless ($dsn && $user && $pass);
-plan tests => 24;
+plan tests => 34;
DBICTest::Schema->load_classes('ArtistFQN');
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
@@ -63,7 +64,7 @@
$dbh->do("CREATE TABLE artist (artistid NUMBER(12), name VARCHAR(255), rank NUMBER(38), charfield VARCHAR2(10))");
$dbh->do("CREATE TABLE sequence_test (pkid1 NUMBER(12), pkid2 NUMBER(12), nonpkid NUMBER(12), name VARCHAR(255))");
$dbh->do("CREATE TABLE cd (cdid NUMBER(12), artist NUMBER(12), title VARCHAR(255), year VARCHAR(4))");
-$dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12), position NUMBER(12), title VARCHAR(255), last_updated_on DATE)");
+$dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12), position NUMBER(12), title VARCHAR(255), last_updated_on DATE, last_updated_at DATE)");
$dbh->do("ALTER TABLE artist ADD (CONSTRAINT artist_pk PRIMARY KEY (artistid))");
$dbh->do("ALTER TABLE sequence_test ADD (CONSTRAINT sequence_test_constraint PRIMARY KEY (pkid1, pkid2))");
@@ -80,6 +81,23 @@
END;
});
+{
+ # Swiped from t/bindtype_columns.t to avoid creating my own Resultset.
+
+ local $SIG{__WARN__} = sub {};
+ eval { $dbh->do('DROP TABLE bindtype_test') };
+
+ $dbh->do(qq[
+ CREATE TABLE bindtype_test
+ (
+ id integer NOT NULL PRIMARY KEY,
+ bytea integer NULL,
+ blob blob NULL,
+ clob clob NULL
+ )
+ ],{ RaiseError => 1, PrintError => 1 });
+}
+
# This is in Core now, but it's here just to test that it doesn't break
$schema->class('Artist')->load_components('PK::Auto');
# These are compat shims for PK::Auto...
@@ -106,16 +124,33 @@
# check count distinct with multiple columns
my $other_track = $schema->resultset('Track')->create({ trackid => 2, cd => 1, position => 1, title => 'Track2' });
+
my $tcount = $schema->resultset('Track')->search(
- {},
- {
- select => [{count => {distinct => ['position', 'title']}}],
- as => ['count']
- }
- );
+ {},
+ {
+ select => [ qw/position title/ ],
+ distinct => 1,
+ }
+);
+is($tcount->count, 2, 'multiple column COUNT DISTINCT ok');
-is($tcount->next->get_column('count'), 2, "multiple column select distinct ok");
+$tcount = $schema->resultset('Track')->search(
+ {},
+ {
+ columns => [ qw/position title/ ],
+ distinct => 1,
+ }
+);
+is($tcount->count, 2, 'multiple column COUNT DISTINCT ok');
+$tcount = $schema->resultset('Track')->search(
+ {},
+ {
+ group_by => [ qw/position title/ ]
+ }
+);
+is($tcount->count, 2, 'multiple column COUNT DISTINCT using column syntax ok');
+
# test LIMIT support
for (1..6) {
$schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
@@ -147,6 +182,28 @@
my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 });
is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually");
+{
+ my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
+ $binstr{'large'} = $binstr{'small'} x 1024;
+
+ my $maxloblen = length $binstr{'large'};
+ note "Localizing LongReadLen to $maxloblen to avoid truncation of test data";
+ local $dbh->{'LongReadLen'} = $maxloblen;
+
+ my $rs = $schema->resultset('BindType');
+ my $id = 0;
+
+ foreach my $type (qw( blob clob )) {
+ foreach my $size (qw( small large )) {
+ $id++;
+
+ lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
+ "inserted $size $type without dying";
+ ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" );
+ }
+ }
+}
+
# clean up our mess
END {
if($schema && ($dbh = $schema->storage->dbh)) {
@@ -158,6 +215,7 @@
$dbh->do("DROP TABLE sequence_test");
$dbh->do("DROP TABLE cd");
$dbh->do("DROP TABLE track");
+ $dbh->do("DROP TABLE bindtype_test");
}
}
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/73oracle_inflate.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/73oracle_inflate.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/73oracle_inflate.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -17,12 +17,13 @@
plan skip_all => 'needs DateTime and DateTime::Format::Oracle for testing';
}
else {
- plan tests => 4;
+ plan tests => 7;
}
}
# DateTime::Format::Oracle needs this set
$ENV{NLS_DATE_FORMAT} = 'DD-MON-YY';
+$ENV{NLS_TIMESTAMP_FORMAT} = 'YYYY-MM-DD HH24:MI:SSXFF';
$ENV{NLS_LANG} = 'AMERICAN_AMERICA.WE8ISO8859P1';
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
@@ -31,16 +32,20 @@
my $col_metadata = $schema->class('Track')->column_info('last_updated_on');
$schema->class('Track')->add_column( 'last_updated_on' => {
data_type => 'date' });
+$schema->class('Track')->add_column( 'last_updated_at' => {
+ data_type => 'timestamp' });
my $dbh = $schema->storage->dbh;
+#$dbh->do("alter session set nls_timestamp_format = 'YYYY-MM-DD HH24:MI:SSXFF'");
+
eval {
$dbh->do("DROP TABLE track");
};
-$dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12), position NUMBER(12), title VARCHAR(255), last_updated_on DATE)");
+$dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12), position NUMBER(12), title VARCHAR(255), last_updated_on DATE, last_updated_at TIMESTAMP)");
# insert a row to play with
-my $new = $schema->resultset('Track')->create({ trackid => 1, cd => 1, position => 1, title => 'Track1', last_updated_on => '06-MAY-07' });
+my $new = $schema->resultset('Track')->create({ trackid => 1, cd => 1, position => 1, title => 'Track1', last_updated_on => '06-MAY-07', last_updated_at => '2009-05-03 21:17:18.5' });
is($new->trackid, 1, "insert sucessful");
my $track = $schema->resultset('Track')->find( 1 );
@@ -49,11 +54,18 @@
is( $track->last_updated_on->month, 5, "DateTime methods work on inflated column");
+#note '$track->last_updated_at => ', $track->last_updated_at;
+is( ref($track->last_updated_at), 'DateTime', "last_updated_at inflated ok");
+
+is( $track->last_updated_at->nanosecond, 500_000_000, "DateTime methods work with nanosecond precision");
+
my $dt = DateTime->now();
$track->last_updated_on($dt);
+$track->last_updated_at($dt);
$track->update;
is( $track->last_updated_on->month, $dt->month, "deflate ok");
+is( int $track->last_updated_at->nanosecond, int $dt->nanosecond, "deflate ok with nanosecond precision");
# clean up our mess
END {
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/76joins.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/76joins.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/76joins.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -33,7 +33,7 @@
}
# test the abstract join => SQL generator
-my $sa = new DBIC::SQL::Abstract;
+my $sa = new DBIx::Class::SQLAHacks;
my @j = (
{ child => 'person' },
@@ -127,7 +127,7 @@
[ { father => 'person' }, { 'father.person_id' => { '!=', '42' } }, ],
[ { mother => 'person' }, { 'mother.person_id' => 'child.mother_id' } ],
);
-$match = qr/^HASH reference arguments are not supported in JOINS - try using "\.\.\." instead/;
+$match = qr/HASH reference arguments are not supported in JOINS/;
eval { $sa->_recurse_from(@j6) };
like( $@, $match, 'join 6 (HASH reference for ON statement dies) ok' );
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/93nobindvars.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/93nobindvars.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/93nobindvars.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -57,7 +57,7 @@
offset => 2,
order_by => 'artistid' }
);
-is( $it->count, 3, "LIMIT count ok" );
+is( $it->count, 3, "LIMIT count ok" ); # ask for 3 rows out of 7 artists
is( $it->next->name, "Artist 2", "iterator->next ok" );
$it->next;
$it->next;
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/94versioning.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/94versioning.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/94versioning.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -33,6 +33,8 @@
};
use lib qw(t/lib);
+use DBICTest; # do not remove even though it is not used
+
use_ok('DBICVersionOrig');
my $schema_orig = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
@@ -83,7 +85,7 @@
# should overwrite files and warn about it
my @w;
local $SIG{__WARN__} = sub {
- if ($_[0] =~ /^Overwriting/) {
+ if ($_[0] =~ /Overwriting existing/) {
push @w, $_[0];
}
else {
@@ -93,8 +95,8 @@
$schema_upgrade->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0');
is (2, @w, 'A warning generated for both the DDL and the diff');
- like ($w[0], qr/^Overwriting existing DDL file - $fn->{v2}/, 'New version DDL overwrite warning');
- like ($w[1], qr/^Overwriting existing diff file - $fn->{trans}/, 'Upgrade diff overwrite warning');
+ like ($w[0], qr/Overwriting existing DDL file - $fn->{v2}/, 'New version DDL overwrite warning');
+ like ($w[1], qr/Overwriting existing diff file - $fn->{trans}/, 'Upgrade diff overwrite warning');
}
{
Added: DBIx-Class/0.08/branches/storage-tweaks/t/count/count_distinct.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/count/count_distinct.t (rev 0)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/count/count_distinct.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -0,0 +1,82 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use lib qw(t/lib);
+
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+my $schema = DBICTest->init_schema();
+
+eval "use DBD::SQLite";
+plan skip_all => 'needs DBD::SQLite for testing' if $@;
+plan tests => 18;
+
+# The tag Blue is assigned to cds 1 2 3 and 5
+# The tag Cheesy is assigned to cds 2 4 and 5
+#
+# This combination should make some interesting group_by's
+#
+my $rs;
+my $in_rs = $schema->resultset('Tag')->search({ tag => [ 'Blue', 'Cheesy' ] });
+
+$rs = $schema->resultset('Tag')->search({ tag => 'Blue' });
+is($rs->count, 4, 'Count without DISTINCT');
+
+$rs = $schema->resultset('Tag')->search({ tag => [ 'Blue', 'Cheesy' ] }, { group_by => 'tag' });
+is($rs->count, 2, 'Count with single column group_by');
+
+$rs = $schema->resultset('Tag')->search({ tag => [ 'Blue', 'Cheesy' ] }, { group_by => 'cd' });
+is($rs->count, 5, 'Count with another single column group_by');
+
+$rs = $schema->resultset('Tag')->search({ tag => 'Blue' }, { group_by => [ qw/tag cd/ ]});
+is($rs->count, 4, 'Count with multiple column group_by');
+
+$rs = $schema->resultset('Tag')->search({ tag => 'Blue' }, { distinct => 1 });
+is($rs->count, 4, 'Count with single column distinct');
+
+$rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->get_column('tag')->as_query } });
+is($rs->count, 7, 'Count with IN subquery');
+
+$rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->get_column('tag')->as_query } }, { group_by => 'tag' });
+is($rs->count, 2, 'Count with IN subquery with outside group_by');
+
+$rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->get_column('tag')->as_query } }, { distinct => 1 });
+is($rs->count, 7, 'Count with IN subquery with outside distinct');
+
+$rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->get_column('tag')->as_query } }, { distinct => 1, select => 'tag' }),
+is($rs->count, 2, 'Count with IN subquery with outside distinct on a single column');
+
+$rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->search({}, { group_by => 'tag' })->get_column('tag')->as_query } });
+is($rs->count, 7, 'Count with IN subquery with single group_by');
+
+$rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->search({}, { group_by => 'cd' })->get_column('tag')->as_query } });
+is($rs->count, 7, 'Count with IN subquery with another single group_by');
+
+$rs = $schema->resultset('Tag')->search({ tag => { -in => $in_rs->search({}, { group_by => [ qw/tag cd/ ] })->get_column('tag')->as_query } });
+is($rs->count, 7, 'Count with IN subquery with multiple group_by');
+
+$rs = $schema->resultset('Tag')->search({ tag => \"= 'Blue'" });
+is($rs->count, 4, 'Count without DISTINCT, using literal SQL');
+
+$rs = $schema->resultset('Tag')->search({ tag => \" IN ('Blue', 'Cheesy')" }, { group_by => 'tag' });
+is($rs->count, 2, 'Count with literal SQL and single group_by');
+
+$rs = $schema->resultset('Tag')->search({ tag => \" IN ('Blue', 'Cheesy')" }, { group_by => 'cd' });
+is($rs->count, 5, 'Count with literal SQL and another single group_by');
+
+$rs = $schema->resultset('Tag')->search({ tag => \" IN ('Blue', 'Cheesy')" }, { group_by => [ qw/tag cd/ ] });
+is($rs->count, 7, 'Count with literal SQL and multiple group_by');
+
+my @warnings;
+{
+ local $SIG{__WARN__} = sub { push @warnings, shift };
+ my $row = $schema->resultset('Tag')->search({}, { select => { distinct => 'tag' } })->first;
+}
+
+is(@warnings, 1, 'expecteing warn');
+
+dies_ok(sub { my $row = $schema->resultset('Tag')->search({}, { select => { distinct => [qw/tag cd/] } })->first }, 'expecting to die');
Property changes on: DBIx-Class/0.08/branches/storage-tweaks/t/count/count_distinct.t
___________________________________________________________________
Name: svn:mergeinfo
+
Added: DBIx-Class/0.08/branches/storage-tweaks/t/count/count_joined.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/count/count_joined.t (rev 0)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/count/count_joined.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib qw(t/lib);
+
+use DBICTest;
+
+plan tests => 1;
+
+my $schema = DBICTest->init_schema();
+
+TODO: {
+ local $TODO = 'Needs -paren fixes in SQLA before it can work';
+ my $cds = $schema->resultset("CD")->search({ cdid => 1 }, { join => { cd_to_producer => 'producer' } });
+ is($cds->count, 1, "extra joins do not explode single entity count");
+}
Copied: DBIx-Class/0.08/branches/storage-tweaks/t/delete/m2m.t (from rev 6120, DBIx-Class/0.08/branches/storage-tweaks/t/deleting_many_to_many.t)
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/delete/m2m.t (rev 0)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/delete/m2m.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -0,0 +1,23 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+plan tests => 5;
+
+my $cd = $schema->resultset("CD")->find(2);
+ok $cd->liner_notes;
+ok keys %{$cd->{_relationship_data}}, "_relationship_data populated";
+
+$cd->discard_changes;
+ok $cd->liner_notes, 'relationships still valid after discarding changes';
+
+ok $cd->liner_notes->delete;
+$cd->discard_changes;
+ok !$cd->liner_notes, 'discard_changes resets relationship';
\ No newline at end of file
Copied: DBIx-Class/0.08/branches/storage-tweaks/t/delete/related.t (from rev 6120, DBIx-Class/0.08/branches/storage-tweaks/t/53delete_related.t)
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/delete/related.t (rev 0)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/delete/related.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -0,0 +1,45 @@
+use Test::More;
+use strict;
+use warnings;
+use lib qw(t/lib);
+use DBICTest;
+
+plan tests => 3;
+
+my $schema = DBICTest->init_schema();
+
+my $ars = $schema->resultset('Artist');
+my $cdrs = $schema->resultset('CD');
+
+# create some custom entries
+$ars->populate ([
+ [qw/artistid name/],
+ [qw/71 a1/],
+ [qw/72 a2/],
+ [qw/73 a3/],
+]);
+$cdrs->populate ([
+ [qw/cdid artist title year/],
+ [qw/70 71 delete0 2005/],
+ [qw/71 72 delete1 2005/],
+ [qw/72 72 delete2 2005/],
+ [qw/73 72 delete3 2006/],
+ [qw/74 72 delete4 2007/],
+ [qw/75 73 delete5 2008/],
+]);
+
+my $total_cds = $cdrs->count;
+
+# test that delete_related w/o conditions deletes all related records only
+$ars->search ({name => 'a3' })->search_related ('cds')->delete;
+is ($cdrs->count, $total_cds -= 1, 'related delete ok');
+
+my $a2_cds = $ars->search ({ name => 'a2' })->search_related ('cds');
+
+# test that related deletion w/conditions deletes just the matched related records only
+$a2_cds->search ({ year => 2005 })->delete;
+is ($cdrs->count, $total_cds -= 2, 'related + condition delete ok');
+
+# test that related deletion with limit condition works
+$a2_cds->search ({}, { rows => 1})->delete;
+is ($cdrs->count, $total_cds -= 1, 'related + limit delete ok');
Deleted: DBIx-Class/0.08/branches/storage-tweaks/t/deleting_many_to_many.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/deleting_many_to_many.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/deleting_many_to_many.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -1,23 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-use warnings;
-
-use Test::More;
-use lib qw(t/lib);
-use DBICTest;
-
-my $schema = DBICTest->init_schema();
-
-plan tests => 5;
-
-my $cd = $schema->resultset("CD")->find(2);
-ok $cd->liner_notes;
-ok keys %{$cd->{_relationship_data}}, "_relationship_data populated";
-
-$cd->discard_changes;
-ok $cd->liner_notes, 'relationships still valid after discarding changes';
-
-ok $cd->liner_notes->delete;
-$cd->discard_changes;
-ok !$cd->liner_notes, 'discard_changes resets relationship';
\ No newline at end of file
Added: DBIx-Class/0.08/branches/storage-tweaks/t/from_subquery.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/from_subquery.t (rev 0)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/from_subquery.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -0,0 +1,192 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More;
+
+BEGIN {
+ eval "use SQL::Abstract 1.49";
+ plan $@
+ ? ( skip_all => "Needs SQLA 1.49+" )
+ : ( tests => 8 );
+}
+
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+my $schema = DBICTest->init_schema();
+my $art_rs = $schema->resultset('Artist');
+my $cdrs = $schema->resultset('CD');
+
+{
+ my $cdrs2 = $cdrs->search({
+ artist_id => { 'in' => $art_rs->search({}, { rows => 1 })->get_column( 'id' )->as_query },
+ });
+
+ my $arr = $cdrs2->as_query;
+ my ($query, @bind) = @{$$arr};
+ is_same_sql_bind(
+ $query, \@bind,
+ "(SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE artist_id IN ( SELECT id FROM artist me LIMIT 1 ))",
+ [],
+ );
+}
+
+{
+ my $rs = $art_rs->search(
+ {},
+ {
+ 'select' => [
+ $cdrs->search({}, { rows => 1 })->get_column('id')->as_query,
+ ],
+ },
+ );
+
+ my $arr = $rs->as_query;
+ my ($query, @bind) = @{$$arr};
+ is_same_sql_bind(
+ $query, \@bind,
+ "(SELECT (SELECT id FROM cd me LIMIT 1) FROM artist me)",
+ [],
+ );
+}
+
+{
+ my $rs = $art_rs->search(
+ {},
+ {
+ '+select' => [
+ $cdrs->search({}, { rows => 1 })->get_column('id')->as_query,
+ ],
+ },
+ );
+
+ my $arr = $rs->as_query;
+ my ($query, @bind) = @{$$arr};
+ is_same_sql_bind(
+ $query, \@bind,
+ "(SELECT me.artistid, me.name, me.rank, me.charfield, (SELECT id FROM cd me LIMIT 1) FROM artist me)",
+ [],
+ );
+}
+
+# simple from
+{
+ my $rs = $cdrs->search(
+ {},
+ {
+ alias => 'cd2',
+ from => [
+ { cd2 => $cdrs->search({ id => { '>' => 20 } })->as_query },
+ ],
+ },
+ );
+
+ my $arr = $rs->as_query;
+ my ($query, @bind) = @{$$arr};
+ is_same_sql_bind(
+ $query, \@bind,
+ "(SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track FROM (SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE ( id > ? ) ) cd2)",
+ [
+ [ 'id', 20 ]
+ ],
+ );
+}
+
+# nested from
+{
+ my $art_rs2 = $schema->resultset('Artist')->search({},
+ {
+ from => [ { 'me' => 'artist' },
+ [ { 'cds' => $cdrs->search({},{ 'select' => [\'me.artist as cds_artist' ]})->as_query },
+ { 'me.artistid' => 'cds_artist' } ] ]
+ });
+
+ my $arr = $art_rs2->as_query;
+ my ($query, @bind) = @{$$arr};
+ is_same_sql_bind(
+ $query, \@bind,
+ "(SELECT me.artistid, me.name, me.rank, me.charfield FROM artist me JOIN (SELECT me.artist as cds_artist FROM cd me) cds ON me.artistid = cds_artist)",
+ []
+ );
+
+
+}
+
+# nested subquery in from
+{
+ my $rs = $cdrs->search(
+ {},
+ {
+ alias => 'cd2',
+ from => [
+ { cd2 => $cdrs->search(
+ { id => { '>' => 20 } },
+ {
+ alias => 'cd3',
+ from => [
+ { cd3 => $cdrs->search( { id => { '<' => 40 } } )->as_query }
+ ],
+ }, )->as_query },
+ ],
+ },
+ );
+
+ my $arr = $rs->as_query;
+ my ($query, @bind) = @{$$arr};
+ is_same_sql_bind(
+ $query, \@bind,
+ "(SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track
+ FROM
+ (SELECT cd3.cdid,cd3.artist,cd3.title,cd3.year,cd3.genreid,cd3.single_track
+ FROM
+ (SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track
+ FROM cd me WHERE ( id < ? ) ) cd3
+ WHERE ( id > ? ) ) cd2)",
+ [
+ [ 'id', 40 ],
+ [ 'id', 20 ]
+ ],
+ );
+
+}
+
+{
+ my $rs = $cdrs->search({
+ year => {
+ '=' => $cdrs->search(
+ { artistid => { '=' => \'me.artistid' } },
+ { alias => 'inner' }
+ )->get_column('year')->max_rs->as_query,
+ },
+ });
+ my $arr = $rs->as_query;
+ my ($query, @bind) = @{$$arr};
+ is_same_sql_bind(
+ $query, \@bind,
+ "(SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE year = (SELECT MAX(inner.year) FROM cd inner WHERE artistid = me.artistid))",
+ [],
+ );
+}
+
+{
+ my $rs = $cdrs->search(
+ {},
+ {
+ alias => 'cd2',
+ from => [
+ { cd2 => $cdrs->search({ title => 'Thriller' })->as_query },
+ ],
+ },
+ );
+
+ my $arr = $rs->as_query;
+ my ($query, @bind) = @{$$arr};
+ is_same_sql_bind(
+ $query, \@bind,
+ "(SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track FROM (SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE ( title = ? ) ) cd2)",
+ [ [ 'title', 'Thriller' ] ],
+ );
+}
+
+__END__
Added: DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest/AuthorCheck.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest/AuthorCheck.pm (rev 0)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest/AuthorCheck.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -0,0 +1,106 @@
+package # hide from PAUSE
+ DBICTest::AuthorCheck;
+
+use strict;
+use warnings;
+
+use Path::Class qw/file dir/;
+
+_check_author_makefile() unless $ENV{DBICTEST_NO_MAKEFILE_VERIFICATION};
+
+# Die if the author did not update his makefile
+#
+# This is pretty heavy handed, so the check is pretty solid:
+#
+# 1) Assume that this particular module is loaded from -I <$root>/t/lib
+# 2) Make sure <$root>/Makefile.PL exists
+# 3) Make sure we can stat() <$root>/Makefile.PL
+#
+# If all of the above is satisfied
+#
+# *) die if <$root>/inc does not exist
+# *) die if no stat() results for <$root>/Makefile (covers no Makefile)
+# *) die if Makefile.PL mtime > Makefile mtime
+#
+sub _check_author_makefile {
+
+ my $root = _find_co_root()
+ or return;
+
+ # not using file->stat as it invokes File::stat which in turn breaks stat(_)
+ my ($mf_pl_mtime, $mf_mtime) = ( map
+ { (stat ($root->file ($_)) )[9] }
+ qw/Makefile.PL Makefile/
+ );
+
+ return unless $mf_pl_mtime; # something went wrong during co_root detection ?
+
+ if (
+ not -d $root->subdir ('inc')
+ or
+ not $mf_mtime
+ or
+ $mf_mtime < $mf_pl_mtime
+ ) {
+ print STDERR <<'EOE';
+
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+======================== FATAL ERROR ===========================
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+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.
+
+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
+
+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
+
+
+
+EOE
+
+ exit 1;
+ }
+}
+
+# Try to determine the root of a checkout/untar if possible
+# or return undef
+sub _find_co_root {
+
+ my @mod_parts = split /::/, (__PACKAGE__ . '.pm');
+ my $rel_path = file (@mod_parts);
+
+ return undef unless ($INC{$rel_path});
+
+ # a bit convoluted, but what we do here essentially is:
+ # - get the file name of this particular module
+ # - do 'cd ..' as many times as necessary to get to t/lib/../..
+
+ my $root = dir ($INC{$rel_path});
+ for (0 .. @mod_parts + 1) {
+ $root = $root->parent;
+ }
+
+ return (-f $root->file ('Makefile.PL') )
+ ? $root
+ : undef
+ ;
+}
+
+1;
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest/Schema/CD_to_Producer.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest/Schema/CD_to_Producer.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest/Schema/CD_to_Producer.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -7,6 +7,7 @@
__PACKAGE__->add_columns(
cd => { data_type => 'integer' },
producer => { data_type => 'integer' },
+ attribute => { data_type => 'integer', is_nullable => 1 },
);
__PACKAGE__->set_primary_key(qw/cd producer/);
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest/Schema/Track.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest/Schema/Track.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest/Schema/Track.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -26,6 +26,10 @@
accessor => 'updated_date',
is_nullable => 1
},
+ last_updated_at => {
+ data_type => 'datetime',
+ is_nullable => 1
+ },
);
__PACKAGE__->set_primary_key('trackid');
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest.pm
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest.pm 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest.pm 2009-05-14 13:39:30 UTC (rev 6262)
@@ -3,6 +3,7 @@
use strict;
use warnings;
+use DBICTest::AuthorCheck;
use DBICTest::Schema;
=head1 NAME
Property changes on: DBIx-Class/0.08/branches/storage-tweaks/t/lib/DBICTest.pm
___________________________________________________________________
Name: svn:executable
- *
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/lib/sqlite.sql
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/lib/sqlite.sql 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/lib/sqlite.sql 2009-05-14 13:39:30 UTC (rev 6262)
@@ -108,6 +108,7 @@
CREATE TABLE cd_to_producer (
cd integer NOT NULL,
producer integer NOT NULL,
+ attribute integer,
PRIMARY KEY (cd, producer)
);
@@ -375,7 +376,8 @@
cd integer NOT NULL,
position integer NOT NULL,
title varchar(100) NOT NULL,
- last_updated_on datetime
+ last_updated_on datetime,
+ last_updated_at datetime
);
CREATE INDEX track_idx_cd_track ON track (cd);
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/resultset/as_query.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/resultset/as_query.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/resultset/as_query.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -7,7 +7,7 @@
use Test::More;
-plan ( tests => 4 );
+plan ( tests => 5 );
use lib qw(t/lib);
use DBICTest;
@@ -65,3 +65,12 @@
[ [ rank => 2 ], [ name => 'Billy Joel' ] ],
);
}
+
+{
+ my $rs = $schema->resultset("CD")->search(
+ { 'artist.name' => 'Caterwauler McCrae' },
+ { join => [qw/artist/]}
+ );
+ my $subsel_rs = $schema->resultset("CD")->search( { cdid => { IN => $rs->get_column('cdid')->as_query } } );
+ is($subsel_rs->count, $rs->count, 'Subselect on PK got the same row count');
+}
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/search/subquery.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/search/subquery.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/search/subquery.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -7,7 +7,7 @@
use Test::More;
-plan ( tests => 7 );
+plan ( tests => 8 );
use lib qw(t/lib);
use DBICTest;
@@ -85,8 +85,10 @@
my ($query, @bind) = @{$$arr};
is_same_sql_bind(
$query, \@bind,
- "( SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track FROM (SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE id > 20) cd2 )",
- [],
+ "( SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track FROM (SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE id > ?) cd2 )",
+ [
+ [ 'id', 20 ]
+ ],
);
}
@@ -137,10 +139,13 @@
(SELECT cd3.cdid,cd3.artist,cd3.title,cd3.year,cd3.genreid,cd3.single_track
FROM
(SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track
- FROM cd me WHERE id < 40) cd3
- WHERE id > 20) cd2
+ FROM cd me WHERE id < ?) cd3
+ WHERE id > ?) cd2
)",
- [],
+ [
+ [ 'id', 40 ],
+ [ 'id', 20 ]
+ ],
);
}
@@ -163,4 +168,28 @@
);
}
+{
+ my $rs = $cdrs->search(
+ {},
+ {
+ alias => 'cd2',
+ from => [
+ { cd2 => $cdrs->search({ title => 'Thriller' })->as_query },
+ ],
+ },
+ );
+
+ my $arr = $rs->as_query;
+ my ($query, @bind) = @{$$arr};
+ is_same_sql_bind(
+ $query, \@bind,
+ "(SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track FROM (SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE title = ?) cd2)",
+ [
+ [ 'title',
+ 'Thriller'
+ ]
+ ],
+ );
+}
+
__END__
Modified: DBIx-Class/0.08/branches/storage-tweaks/t/zzzzzzz_perl_perf_bug.t
===================================================================
--- DBIx-Class/0.08/branches/storage-tweaks/t/zzzzzzz_perl_perf_bug.t 2009-05-14 13:03:33 UTC (rev 6261)
+++ DBIx-Class/0.08/branches/storage-tweaks/t/zzzzzzz_perl_perf_bug.t 2009-05-14 13:39:30 UTC (rev 6262)
@@ -1,8 +1,8 @@
-#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use lib qw(t/lib);
+use DBICTest; # do not remove even though it is not used
# This is a rather unusual test.
# It does not test any aspect of DBIx::Class, but instead tests the
More information about the Bast-commits
mailing list