[Bast-commits] r7359 - in DBIx-Class/0.08/branches/prefetch: .
lib/DBIx lib/DBIx/Class lib/DBIx/Class/CDBICompat
lib/DBIx/Class/InflateColumn lib/DBIx/Class/Manual
lib/DBIx/Class/Relationship lib/DBIx/Class/ResultSource
lib/DBIx/Class/ResultSourceProxy lib/DBIx/Class/SQLAHacks
lib/DBIx/Class/Schema lib/DBIx/Class/Storage
lib/DBIx/Class/Storage/DBI lib/DBIx/Class/Storage/DBI/ODBC
lib/DBIx/Class/Storage/DBI/Oracle
lib/DBIx/Class/Storage/DBI/Replicated
lib/DBIx/Class/Storage/DBI/Replicated/Balancer
lib/DBIx/Class/Storage/DBI/Sybase
lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server
lib/SQL/Translator/Parser/DBIx
lib/SQL/Translator/Producer/DBIx/Class t t/bind t/cdbi
t/cdbi/testlib/DBIC/Test t/count t/inflate t/lib t/lib/DBIC
t/lib/DBICTest t/lib/DBICTest/Schema t/multi_create
t/prefetch t/relationship
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Fri Aug 21 09:22:53 GMT 2009
Author: ribasushi
Date: 2009-08-21 09:22:51 +0000 (Fri, 21 Aug 2009)
New Revision: 7359
Added:
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/SQLAHacks/MSSQL.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/AmbiguousGlob.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Introduction.pod
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server/
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server/NoBindVars.pm
DBIx-Class/0.08/branches/prefetch/t/92storage_on_connect_call.t
DBIx-Class/0.08/branches/prefetch/t/92storage_ping_count.t
DBIx-Class/0.08/branches/prefetch/t/inflate/datetime_mssql.t
DBIx-Class/0.08/branches/prefetch/t/inflate/datetime_oracle.t
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/ArtistGUID.pm
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/CustomSql.pm
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Money.pm
DBIx-Class/0.08/branches/prefetch/t/multi_create/diamond.t
DBIx-Class/0.08/branches/prefetch/t/multi_create/existing_in_chain.t
DBIx-Class/0.08/branches/prefetch/t/multi_create/has_many.t
DBIx-Class/0.08/branches/prefetch/t/multi_create/in_memory.t
DBIx-Class/0.08/branches/prefetch/t/multi_create/multilev_single_PKeqFK.t
DBIx-Class/0.08/branches/prefetch/t/multi_create/standard.t
DBIx-Class/0.08/branches/prefetch/t/multi_create/torture.t
DBIx-Class/0.08/branches/prefetch/t/prefetch/count.t
DBIx-Class/0.08/branches/prefetch/t/prefetch/grouped.t
DBIx-Class/0.08/branches/prefetch/t/prefetch/incomplete.t
DBIx-Class/0.08/branches/prefetch/t/prefetch/via_search_related.t
DBIx-Class/0.08/branches/prefetch/t/relationship/update_or_create_multi.t
DBIx-Class/0.08/branches/prefetch/t/relationship/update_or_create_single.t
DBIx-Class/0.08/branches/prefetch/t/zzzzzzz_sqlite_deadlock.t
Removed:
DBIx-Class/0.08/branches/prefetch/t/73oracle_inflate.t
DBIx-Class/0.08/branches/prefetch/t/96multi_create.t
DBIx-Class/0.08/branches/prefetch/t/96multi_create_new.t
DBIx-Class/0.08/branches/prefetch/t/96multi_create_torture.t
DBIx-Class/0.08/branches/prefetch/t/multi_create/multilev_might_have_PKeqFK.t
Modified:
DBIx-Class/0.08/branches/prefetch/
DBIx-Class/0.08/branches/prefetch/Changes
DBIx-Class/0.08/branches/prefetch/Features_09
DBIx-Class/0.08/branches/prefetch/Makefile.PL
DBIx-Class/0.08/branches/prefetch/TODO
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ColumnCase.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Copy.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ImaDBI.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Iterator.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/LazyLoading.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/LiveObjectIndex.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Relationship.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Relationships.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Retrieve.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/TempColumns.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/DB.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Exception.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/InflateColumn/DateTime.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/InflateColumn/File.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Cookbook.pod
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Example.pod
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/FAQ.pod
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Intro.pod
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Troubleshooting.pod
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Ordered.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/PK.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/Accessor.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/Base.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/BelongsTo.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/CascadeActions.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/HasMany.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/HasOne.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/ManyToMany.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/ProxyMethods.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSet.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSetColumn.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSource.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSource/View.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSourceHandle.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSourceProxy/Table.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Row.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/SQLAHacks.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/SQLAHacks/MySQL.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Schema.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Schema/Versioned.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/StartupCheck.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Cursor.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/DB2.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/MSSQL.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/NoBindVars.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC/ACCESS.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Oracle.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Pg.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/First.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/Random.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/SQLite.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/mysql.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/Statistics.pm
DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/UTF8Columns.pm
DBIx-Class/0.08/branches/prefetch/lib/SQL/Translator/Parser/DBIx/Class.pm
DBIx-Class/0.08/branches/prefetch/lib/SQL/Translator/Producer/DBIx/Class/File.pm
DBIx-Class/0.08/branches/prefetch/t/03podcoverage.t
DBIx-Class/0.08/branches/prefetch/t/19quotes.t
DBIx-Class/0.08/branches/prefetch/t/19quotes_newstyle.t
DBIx-Class/0.08/branches/prefetch/t/31stats.t
DBIx-Class/0.08/branches/prefetch/t/42toplimit.t
DBIx-Class/0.08/branches/prefetch/t/46where_attribute.t
DBIx-Class/0.08/branches/prefetch/t/60core.t
DBIx-Class/0.08/branches/prefetch/t/71mysql.t
DBIx-Class/0.08/branches/prefetch/t/72pg.t
DBIx-Class/0.08/branches/prefetch/t/73oracle.t
DBIx-Class/0.08/branches/prefetch/t/745db2.t
DBIx-Class/0.08/branches/prefetch/t/746db2_400.t
DBIx-Class/0.08/branches/prefetch/t/746mssql.t
DBIx-Class/0.08/branches/prefetch/t/746sybase.t
DBIx-Class/0.08/branches/prefetch/t/74mssql.t
DBIx-Class/0.08/branches/prefetch/t/76select.t
DBIx-Class/0.08/branches/prefetch/t/83cache.t
DBIx-Class/0.08/branches/prefetch/t/85utf8.t
DBIx-Class/0.08/branches/prefetch/t/86might_have.t
DBIx-Class/0.08/branches/prefetch/t/86sqlt.t
DBIx-Class/0.08/branches/prefetch/t/87ordered.t
DBIx-Class/0.08/branches/prefetch/t/88result_set_column.t
DBIx-Class/0.08/branches/prefetch/t/90join_torture.t
DBIx-Class/0.08/branches/prefetch/t/92storage.t
DBIx-Class/0.08/branches/prefetch/t/93nobindvars.t
DBIx-Class/0.08/branches/prefetch/t/93storage_replication.t
DBIx-Class/0.08/branches/prefetch/t/95sql_maker_quote.t
DBIx-Class/0.08/branches/prefetch/t/99dbic_sqlt_parser.t
DBIx-Class/0.08/branches/prefetch/t/bind/attribute.t
DBIx-Class/0.08/branches/prefetch/t/cdbi/02-Film.t
DBIx-Class/0.08/branches/prefetch/t/cdbi/testlib/DBIC/Test/SQLite.pm
DBIx-Class/0.08/branches/prefetch/t/count/count_rs.t
DBIx-Class/0.08/branches/prefetch/t/count/distinct.t
DBIx-Class/0.08/branches/prefetch/t/count/joined.t
DBIx-Class/0.08/branches/prefetch/t/count/prefetch.t
DBIx-Class/0.08/branches/prefetch/t/from_subquery.t
DBIx-Class/0.08/branches/prefetch/t/inflate/core.t
DBIx-Class/0.08/branches/prefetch/t/inflate/datetime_pg.t
DBIx-Class/0.08/branches/prefetch/t/inflate/serialize.t
DBIx-Class/0.08/branches/prefetch/t/lib/DBIC/SqlMakerTest.pm
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest.pm
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema.pm
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/ArtistUndirectedMap.pm
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Artwork.pm
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Bookmark.pm
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/CD.pm
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Event.pm
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/EventTZPg.pm
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Genre.pm
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Serialized.pm
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Track.pm
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Year1999CDs.pm
DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Year2000CDs.pm
DBIx-Class/0.08/branches/prefetch/t/lib/sqlite.sql
DBIx-Class/0.08/branches/prefetch/t/multi_create/m2m.t
DBIx-Class/0.08/branches/prefetch/t/prefetch/double_prefetch.t
DBIx-Class/0.08/branches/prefetch/t/prefetch/multiple_hasmany.t
DBIx-Class/0.08/branches/prefetch/t/prefetch/standard.t
DBIx-Class/0.08/branches/prefetch/t/relationship/core.t
Log:
r6772 at Thesaurus (orig r6771): ribasushi | 2009-06-23 16:46:18 +0200
Move tests around, add extra has_one relationship
r6773 at Thesaurus (orig r6772): caelum | 2009-06-23 18:36:22 +0200
add missing ' to doc
r6781 at Thesaurus (orig r6780): ribasushi | 2009-06-24 11:08:02 +0200
Properly name the relinfo variable
r6782 at Thesaurus (orig r6781): ribasushi | 2009-06-24 12:12:49 +0200
find_related fix for single-type relationships
r6783 at Thesaurus (orig r6782): nigel | 2009-06-24 17:28:33 +0200
r11786 at hex: nigel | 2009-06-24 16:27:58 +0100
Fixed set_$rel with where restriction deleting rows outside the restriction
r6784 at Thesaurus (orig r6783): nigel | 2009-06-24 17:47:31 +0200
r11788 at hex: nigel | 2009-06-24 16:47:04 +0100
Rework of set_$rel patch with less obfuscation
r6789 at Thesaurus (orig r6788): ribasushi | 2009-06-25 09:19:10 +0200
Commit test inspired by joel - it seemingly fails on Mac?
r6790 at Thesaurus (orig r6789): ribasushi | 2009-06-25 11:04:26 +0200
Minor cleanups
r6793 at Thesaurus (orig r6792): teejay | 2009-06-26 14:43:05 +0200
normalised artist_id, and plural relationships to plural names making use of alias/relname less ambiguous than relname/tablename being the same, also added a little more info on joining/relationships
r6794 at Thesaurus (orig r6793): tomboh | 2009-06-26 15:25:19 +0200
Documentation fix:
- timezone is no longer an extra setting
- fix a typo of 'subsequently'
r6795 at Thesaurus (orig r6794): gphat | 2009-06-26 16:33:35 +0200
Fix typo in ResultSet docs
r6803 at Thesaurus (orig r6802): ribasushi | 2009-06-27 12:39:03 +0200
Todoified (unsolvable) test from RT#42466
r6804 at Thesaurus (orig r6803): ribasushi | 2009-06-27 12:52:26 +0200
POD patch from RT#46808
r6805 at Thesaurus (orig r6804): ribasushi | 2009-06-27 13:59:03 +0200
Adjust sqlt schema parser to add tables in FK dependency order
r6806 at Thesaurus (orig r6805): ribasushi | 2009-06-27 14:08:35 +0200
Bump author SQLT dependency for early developer testing
Regenerate SQLite schema with new parser/sqlt
Use throw_exception in lieu of plain die when possible
r6813 at Thesaurus (orig r6812): castaway | 2009-06-28 06:11:08 +0200
Tests for grouping with prefetch
r6820 at Thesaurus (orig r6819): ribasushi | 2009-06-28 13:00:03 +0200
The prefetch+group_by is a complex problem - branch
r6844 at Thesaurus (orig r6843): abraxxa | 2009-06-29 11:02:17 +0200
fixed typo in test
r6848 at Thesaurus (orig r6847): ribasushi | 2009-06-29 19:09:00 +0200
Minor Ordered optimization (don't use count)
r6856 at Thesaurus (orig r6855): caelum | 2009-06-29 23:42:11 +0200
r5451 at hlagh (orig r6605): caelum | 2009-06-10 09:23:44 -0700
new branch to implement on_connect_call
r5484 at hlagh (orig r6633): caelum | 2009-06-11 11:03:10 -0700
on_connect_call implementation and set_datetime_format support for Oracle
r5492 at hlagh (orig r6641): caelum | 2009-06-11 16:39:28 -0700
connect_call_set_datetime_format for Oracle, I have no idea why this didn't get committed before...
r5504 at hlagh (orig r6655): caelum | 2009-06-12 17:28:06 -0700
finished up on_connect_call stuff
r5507 at hlagh (orig r6658): caelum | 2009-06-13 04:03:36 -0700
fixup _setup_connect_do, other minor cleanups
r5508 at hlagh (orig r6659): caelum | 2009-06-13 04:35:33 -0700
make the on_(dis)?connect_do accessors returnn the original structure
r5509 at hlagh (orig r6660): caelum | 2009-06-13 08:31:52 -0700
allow undef for _setup_connect_do
r5522 at hlagh (orig r6679): caelum | 2009-06-14 09:56:40 -0700
rename connect_do store
r5621 at hlagh (orig r6769): caelum | 2009-06-23 07:38:33 -0700
minor doc update
r5628 at hlagh (orig r6777): caelum | 2009-06-23 16:36:12 -0700
properly test nanosecond precision with oracle and datetime_setup
r5669 at hlagh (orig r6784): caelum | 2009-06-24 10:49:25 -0700
IC::DT does support timestamp with timezone
r5768 at hlagh (orig r6846): caelum | 2009-06-29 08:20:32 -0700
remove DateTime from 73oracle.t
r5781 at hlagh (orig r6849): caelum | 2009-06-29 13:07:43 -0700
remove the _store stuff for on_connect_do
r5785 at hlagh (orig r6853): ribasushi | 2009-06-29 14:38:30 -0700
Some beautification
r6871 at Thesaurus (orig r6870): ribasushi | 2009-06-30 10:09:03 +0200
Cleanup dependency handling a bit
r6875 at Thesaurus (orig r6874): ribasushi | 2009-06-30 12:39:06 +0200
Allow broken resultsource-class-derived objects to still work
r6876 at Thesaurus (orig r6875): ribasushi | 2009-06-30 12:40:46 +0200
clarify
r6878 at Thesaurus (orig r6877): ash | 2009-06-30 13:48:13 +0200
Update POD on Dynamic sub-classing
r6883 at Thesaurus (orig r6882): ribasushi | 2009-06-30 17:36:38 +0200
r6815 at Thesaurus (orig r6814): ribasushi | 2009-06-28 10:32:42 +0200
Branch to explore double joins on search_related
r6816 at Thesaurus (orig r6815): ribasushi | 2009-06-28 10:34:16 +0200
Thetest case that started it all
r6817 at Thesaurus (orig r6816): ribasushi | 2009-06-28 10:35:11 +0200
The proposed fix (do not add an extra join if it is already present in the topmost join)
r6818 at Thesaurus (orig r6817): ribasushi | 2009-06-28 11:04:26 +0200
Minor omission
r6819 at Thesaurus (orig r6818): ribasushi | 2009-06-28 11:07:33 +0200
Adjust a couple of tests for new behavior (thus all of this might be backwards incompatible to the point of being useless):
The counts in t/90join_torture.t are now 5*3, not 5*3*3, as a second join is not induced by search_related
The raw sql scan in t/prefetch/standard.t is just silly, won't even try to understand it
Just to maintain the TreeLike folding, I add a 3rd children join which was inserted by search_related before the code changes
r6889 at Thesaurus (orig r6888): ribasushi | 2009-06-30 19:36:11 +0200
Todoify test for now
r6890 at Thesaurus (orig r6889): ribasushi | 2009-06-30 19:37:05 +0200
Todoify test for now (2)
r6892 at Thesaurus (orig r6891): ribasushi | 2009-06-30 19:52:31 +0200
Todoify test for now (3)
r6903 at Thesaurus (orig r6902): ribasushi | 2009-07-01 08:46:12 +0200
Fixed deadlock test
r6904 at Thesaurus (orig r6903): ribasushi | 2009-07-01 12:22:00 +0200
Clarify exception text
r6907 at Thesaurus (orig r6906): ribasushi | 2009-07-01 13:23:46 +0200
r6821 at Thesaurus (orig r6820): ribasushi | 2009-06-28 13:09:11 +0200
Branch for prefetch+group play
r6823 at Thesaurus (orig r6822): ribasushi | 2009-06-28 14:38:36 +0200
Normalize group_by
r6824 at Thesaurus (orig r6823): ribasushi | 2009-06-28 14:39:54 +0200
Proper prefetch+group test
r6826 at Thesaurus (orig r6825): ribasushi | 2009-06-28 14:42:48 +0200
Whoops
r6828 at Thesaurus (orig r6827): ribasushi | 2009-06-28 15:06:57 +0200
Lose the literal sql bits - castaway is right it's silly to support those
r6833 at Thesaurus (orig r6832): ribasushi | 2009-06-28 22:38:43 +0200
Rogue comments
r6837 at Thesaurus (orig r6836): ribasushi | 2009-06-29 09:44:25 +0200
A couple of test fixes
r6838 at Thesaurus (orig r6837): ribasushi | 2009-06-29 09:46:13 +0200
Support for -select/-as in SQLAHacks field selection
r6839 at Thesaurus (orig r6838): ribasushi | 2009-06-29 09:49:53 +0200
This is tested elsewhere
r6840 at Thesaurus (orig r6839): ribasushi | 2009-06-29 09:50:43 +0200
This is tested elsewhere (2)
r6841 at Thesaurus (orig r6840): ribasushi | 2009-06-29 10:07:09 +0200
Test cleanups
r6842 at Thesaurus (orig r6841): ribasushi | 2009-06-29 10:11:13 +0200
Most of the grouped prefetch solution
r6843 at Thesaurus (orig r6842): ribasushi | 2009-06-29 10:14:45 +0200
clearer
r6845 at Thesaurus (orig r6844): ribasushi | 2009-06-29 12:05:37 +0200
And score! (all works)
r6882 at Thesaurus (orig r6881): ribasushi | 2009-06-30 16:23:06 +0200
rs->get_column now properly recognizes prefetch and collapses if at all possible
r6886 at Thesaurus (orig r6885): ribasushi | 2009-06-30 17:39:58 +0200
Whoops
r6910 at Thesaurus (orig r6909): ribasushi | 2009-07-01 13:27:15 +0200
Optimize set_column on uninserted objects
r6921 at Thesaurus (orig r6920): caelum | 2009-07-01 17:40:32 +0200
r5859 at hlagh (orig r6912): caelum | 2009-07-01 06:21:30 -0700
new connected() for dbd::sybase users
r5860 at hlagh (orig r6913): caelum | 2009-07-01 06:25:46 -0700
add a couple of dbd::sybase reconnection tests
r5861 at hlagh (orig r6914): caelum | 2009-07-01 06:35:07 -0700
better connection test
r5862 at hlagh (orig r6915): caelum | 2009-07-01 06:45:05 -0700
use dbh->do for connected instead of prepare_cached
r5863 at hlagh (orig r6916): ribasushi | 2009-07-01 06:55:21 -0700
Segfault
r5864 at hlagh (orig r6917): caelum | 2009-07-01 07:03:22 -0700
use ->do instead of ->prepare_cached in oracle's connected() too
r5865 at hlagh (orig r6918): caelum | 2009-07-01 08:20:52 -0700
fix segfault with old DBD::Sybase
r5866 at hlagh (orig r6919): caelum | 2009-07-01 08:39:18 -0700
move connection tests into _ping()
r6924 at Thesaurus (orig r6923): ijw | 2009-07-01 19:34:32 +0200
Added a test for a resultset to related-resultset join for 0 related records
r6928 at Thesaurus (orig r6927): ijw | 2009-07-01 20:04:16 +0200
Additional tests on prefetch - illustrates the bug with left-join has_many (NULL row returned) and the one that results from the trivial fix (prefetch gives no artist)
r6932 at Thesaurus (orig r6931): ribasushi | 2009-07-02 08:08:33 +0200
Another candidate for somethingawful.com (fix left join-ed count)
r6934 at Thesaurus (orig r6933): ribasushi | 2009-07-02 09:04:13 +0200
Changelog
r6935 at Thesaurus (orig r6934): ribasushi | 2009-07-02 11:23:48 +0200
cleanup
r6936 at Thesaurus (orig r6935): ijw | 2009-07-02 12:41:01 +0200
Check fetched rows == count for related resultsets
r6937 at Thesaurus (orig r6936): ijw | 2009-07-02 12:43:47 +0200
Confirm prefetch doesn't affect main row fetch, and main row fetch works with and without counting
r6938 at Thesaurus (orig r6937): ribasushi | 2009-07-02 12:52:51 +0200
More fail (fix is known but needs work)
r6939 at Thesaurus (orig r6938): ribasushi | 2009-07-02 13:07:22 +0200
And more fail
r6940 at Thesaurus (orig r6939): ribasushi | 2009-07-02 13:16:46 +0200
These tests are in prefetch/count.t
r6941 at Thesaurus (orig r6940): ribasushi | 2009-07-02 13:38:31 +0200
cleanup
r6942 at Thesaurus (orig r6941): ribasushi | 2009-07-02 13:38:49 +0200
Solve more prefetch inflation crap
r6943 at Thesaurus (orig r6942): ribasushi | 2009-07-02 13:47:41 +0200
Make the code readable
r6944 at Thesaurus (orig r6943): ribasushi | 2009-07-02 15:52:35 +0200
Everything works, just need to fix join-path chaining over search_related (to guard against obscure db quirks)
r6946 at Thesaurus (orig r6945): caelum | 2009-07-02 21:06:32 +0200
add sybase reconnect test
r6948 at Thesaurus (orig r6947): ribasushi | 2009-07-02 22:20:21 +0200
Last part of the join handling puzzle
r6951 at Thesaurus (orig r6950): ribasushi | 2009-07-03 00:14:50 +0200
r6360 at Thesaurus (orig r6359): arcanez | 2009-05-21 20:18:52 +0200
branch to work on prefetch/select
r6361 at Thesaurus (orig r6360): arcanez | 2009-05-21 20:32:46 +0200
failing test
r6373 at Thesaurus (orig r6372): ribasushi | 2009-05-22 11:07:26 +0200
Simplify unresolvable test by arcanez
r6905 at Thesaurus (orig r6904): ribasushi | 2009-07-01 12:54:03 +0200
Extend test
r6950 at Thesaurus (orig r6949): ribasushi | 2009-07-03 00:14:09 +0200
Apparent fix - simply delay the in_storage flagging of the main object until all prefetched objects are inflated. The rest of the changes are just cosmetics, preparing for the collapse_result rewrite
r6953 at Thesaurus (orig r6952): ribasushi | 2009-07-03 00:17:22 +0200
Changes
r6965 at Thesaurus (orig r6964): ribasushi | 2009-07-03 13:19:27 +0200
Add set_ansi_mode on_connect_call for mysql
Also switch to _do_query instead of plain dbh->do (shows up in the trace)
r6966 at Thesaurus (orig r6965): ribasushi | 2009-07-03 13:37:06 +0200
Capitalize mysql commands
r6967 at Thesaurus (orig r6966): ribasushi | 2009-07-03 15:07:49 +0200
Double an existing might_have test as has_one
r6968 at Thesaurus (orig r6967): ribasushi | 2009-07-03 16:36:32 +0200
Extra test to demonstrate has_one working, and a POD clarification of multicreate
r6973 at Thesaurus (orig r6972): ribasushi | 2009-07-03 20:20:42 +0200
r6554 at Thesaurus (orig r6553): frew | 2009-06-09 00:06:42 +0200
branch for mssql top issues
r6572 at Thesaurus (orig r6571): frew | 2009-06-09 23:18:46 +0200
more tests for SQL Server!
r6573 at Thesaurus (orig r6572): frew | 2009-06-09 23:49:10 +0200
Added AmbiguousGlob.pm for silly servers like mssql and mysql. See docs for more info
r6574 at Thesaurus (orig r6573): frew | 2009-06-09 23:55:22 +0200
fix plan
r6602 at Thesaurus (orig r6601): frew | 2009-06-10 17:03:30 +0200
more failing tests
r6608 at Thesaurus (orig r6607): frew | 2009-06-10 20:05:53 +0200
don't use eval!
r6610 at Thesaurus (orig r6609): frew | 2009-06-10 20:07:49 +0200
beginning of DWIM for IDENTITY_INSERT
r6628 at Thesaurus (orig r6627): frew | 2009-06-11 18:13:02 +0200
still busted :-(
r6631 at Thesaurus (orig r6630): frew | 2009-06-11 19:39:00 +0200
general function to go from column names and ident to result source
r6632 at Thesaurus (orig r6631): frew | 2009-06-11 19:40:11 +0200
Use new _resolve_column_sources method and begin insert_bulk method
r6635 at Thesaurus (orig r6634): frew | 2009-06-11 20:12:38 +0200
updated _resolve_column_source to _resolve_column_info as per ribasushi's suggestion
r6650 at Thesaurus (orig r6649): frew | 2009-06-12 17:13:32 +0200
Now I just need to check if the actual values are set...
r6651 at Thesaurus (orig r6650): frew | 2009-06-12 17:26:53 +0200
Insert Identity works!
r6652 at Thesaurus (orig r6651): frew | 2009-06-12 17:34:13 +0200
silly warns.
r6684 at Thesaurus (orig r6683): frew | 2009-06-15 16:49:00 +0200
failing test
r6686 at Thesaurus (orig r6685): ribasushi | 2009-06-15 18:10:26 +0200
make all resolved attrs visible to sqla
r6698 at Thesaurus (orig r6697): ribasushi | 2009-06-17 02:31:37 +0200
Half way working stuff, needs a LOT of tweaking still
r6729 at Thesaurus (orig r6728): ribasushi | 2009-06-19 19:49:27 +0200
Merge badness
r6730 at Thesaurus (orig r6729): ribasushi | 2009-06-19 19:49:40 +0200
fix eol
r6731 at Thesaurus (orig r6730): ribasushi | 2009-06-19 19:55:47 +0200
augment inheritance
r6735 at Thesaurus (orig r6734): ribasushi | 2009-06-20 10:34:42 +0200
Maybe I've nailed it
r6746 at Thesaurus (orig r6745): ribasushi | 2009-06-20 23:53:55 +0200
Test and merge fixes
r6747 at Thesaurus (orig r6746): ribasushi | 2009-06-21 00:01:09 +0200
Really fix tests
r6748 at Thesaurus (orig r6747): ribasushi | 2009-06-21 00:01:54 +0200
Really fix tests
r6749 at Thesaurus (orig r6748): ribasushi | 2009-06-21 00:18:33 +0200
Now really final
r6750 at Thesaurus (orig r6749): ribasushi | 2009-06-21 00:22:23 +0200
whoops
r6751 at Thesaurus (orig r6750): ribasushi | 2009-06-21 00:42:18 +0200
That should be all
r6752 at Thesaurus (orig r6751): ribasushi | 2009-06-21 08:54:00 +0200
Make sure quoting works
r6755 at Thesaurus (orig r6754): ribasushi | 2009-06-21 15:21:23 +0200
Groundwork for sanification of the toplimit test
r6863 at Thesaurus (orig r6862): ribasushi | 2009-06-30 01:13:49 +0200
Make sure storage classes use c3, just like the rest of dbic (tested on 5.8 as well)
r6869 at Thesaurus (orig r6868): ribasushi | 2009-06-30 09:53:27 +0200
Some fixes after review
r6874 at Thesaurus (orig r6873): ribasushi | 2009-06-30 11:54:34 +0200
Fix borked next invocation
r6896 at Thesaurus (orig r6895): frew | 2009-06-30 21:38:26 +0200
silly misspells and trailing whitespace
r6955 at Thesaurus (orig r6954): ribasushi | 2009-07-03 01:21:28 +0200
Some hack consolidation
r6962 at Thesaurus (orig r6961): ribasushi | 2009-07-03 12:06:57 +0200
Fix some mssql shortcommings when confronted with the new subequeried prefetch sql
r6963 at Thesaurus (orig r6962): ribasushi | 2009-07-03 12:47:57 +0200
Ask for newer DBD::Pg in author mode, suggest the newer version otherwise (proper array support). Make test more resilient as well
r6964 at Thesaurus (orig r6963): ribasushi | 2009-07-03 12:49:16 +0200
Switch to C3 mro throughout the ::Storage hierarchy (DBIx::Class brings in MRO::Compat, and all ::Storage's are based on it, tested on 5.8
r6969 at Thesaurus (orig r6968): ribasushi | 2009-07-03 19:54:04 +0200
Duh
r6970 at Thesaurus (orig r6969): frew | 2009-07-03 19:59:48 +0200
fix tests for new codez
r6971 at Thesaurus (orig r6970): ribasushi | 2009-07-03 20:18:53 +0200
detabify
r6972 at Thesaurus (orig r6971): ribasushi | 2009-07-03 20:20:07 +0200
changes
r6980 at Thesaurus (orig r6979): ribasushi | 2009-07-04 11:34:08 +0200
Hide devel documentation from the indexer
r6981 at Thesaurus (orig r6980): ribasushi | 2009-07-04 11:37:25 +0200
Add set_ansi_mode POD
r6982 at Thesaurus (orig r6981): ribasushi | 2009-07-04 11:45:24 +0200
Backout mysql changes for further polishing
r6985 at Thesaurus (orig r6984): ribasushi | 2009-07-04 12:08:16 +0200
Missing newline
r6986 at Thesaurus (orig r6985): ribasushi | 2009-07-04 12:11:18 +0200
typo
r6987 at Thesaurus (orig r6986): ribasushi | 2009-07-04 12:40:47 +0200
Fix POD
r6988 at Thesaurus (orig r6987): ribasushi | 2009-07-04 13:09:39 +0200
todos are shorter now
r6990 at Thesaurus (orig r6989): castaway | 2009-07-05 22:00:55 +0200
Added Pod::Inherit use to Makefile.PL at author-time, comments/suggestions as to whether its too "noisy" welcome.
r6991 at Thesaurus (orig r6990): ribasushi | 2009-07-06 00:06:52 +0200
Couple of makefile fixes:
use is compile time, use require
recommends is for distro maintainers only, push the dependency into the authors hash (it is not to be executed by mere mortals)
r6992 at Thesaurus (orig r6991): ribasushi | 2009-07-06 00:55:36 +0200
Forgotten pod exclusions
r6993 at Thesaurus (orig r6992): ribasushi | 2009-07-06 01:07:05 +0200
Temporarily backout Pod::Inherit changes
r6994 at Thesaurus (orig r6993): ribasushi | 2009-07-06 01:10:22 +0200
Put Pod::Inherit stuff back after proper copy
r7010 at Thesaurus (orig r7009): ribasushi | 2009-07-09 12:45:02 +0200
r6995 at Thesaurus (orig r6994): ribasushi | 2009-07-06 01:12:57 +0200
Where 08108 will come from
r7028 at Thesaurus (orig r7027): caelum | 2009-07-10 23:56:57 +0200
fix PodInherit call in Makefile.PL
r7030 at Thesaurus (orig r7029): robkinyon | 2009-07-11 00:03:07 +0200
Applied patch from kados regarding use of a DateTime::Format class to validate
r7031 at Thesaurus (orig r7030): caelum | 2009-07-11 11:26:40 +0200
reword IC::DT doc patch
r7038 at Thesaurus (orig r7037): dandv | 2009-07-13 14:06:08 +0200
PK::Auto has moved into Core since 2007
r7039 at Thesaurus (orig r7038): dandv | 2009-07-13 14:15:13 +0200
Fixed has_many example in Intro.pod
r7040 at Thesaurus (orig r7039): dandv | 2009-07-13 22:58:45 +0200
Fixed run-on sentences in FAQ
r7041 at Thesaurus (orig r7040): dandv | 2009-07-13 23:18:11 +0200
Minor POD fixes in Example.pod
r7042 at Thesaurus (orig r7041): dandv | 2009-07-13 23:48:18 +0200
Favored using ->single to get the topmost result over less readable ->slice(0)
r7043 at Thesaurus (orig r7042): dandv | 2009-07-14 00:56:31 +0200
Minor POD fixes in Cookbook
r7046 at Thesaurus (orig r7045): ribasushi | 2009-07-14 13:30:55 +0200
Minor logic cleanup
r7047 at Thesaurus (orig r7046): ribasushi | 2009-07-14 14:07:11 +0200
grouped prefetch fix
r7054 at Thesaurus (orig r7053): ijw | 2009-07-15 18:55:35 +0200
Added SQLA link for more comprehensive documentation of order_by options available
r7057 at Thesaurus (orig r7056): caelum | 2009-07-16 00:54:22 +0200
add "smalldatetime" support to IC::DT
r7060 at Thesaurus (orig r7059): ribasushi | 2009-07-16 06:29:41 +0200
r7013 at Thesaurus (orig r7012): jnapiorkowski | 2009-07-09 17:00:22 +0200
new branch
r7014 at Thesaurus (orig r7013): jnapiorkowski | 2009-07-09 20:06:44 +0200
changed the way transactions are detected for replication to work with the standard way to do this, minor doc updates, fix to the force pool so you can force a particular slave, changes to the way the debugging is created
r7015 at Thesaurus (orig r7014): jnapiorkowski | 2009-07-09 20:17:03 +0200
more changes to the way debug output works
r7016 at Thesaurus (orig r7015): jnapiorkowski | 2009-07-09 22:26:47 +0200
big update to the test suite so that we now check to make sure the storage that was expected was actually used
r7017 at Thesaurus (orig r7016): jnapiorkowski | 2009-07-09 23:23:37 +0200
set correct number of tests, changed the debuggin output to not warn on DDL, minor change to a test resultclass so we can deploy to mysql properly
r7018 at Thesaurus (orig r7017): jnapiorkowski | 2009-07-09 23:26:59 +0200
corrected the number of skipped tests
r7019 at Thesaurus (orig r7018): jnapiorkowski | 2009-07-09 23:52:22 +0200
fixed test resultclass formatting, added a few more DBIC::Storage::DBI methods that I might need to delegate.
r7020 at Thesaurus (orig r7019): jnapiorkowski | 2009-07-10 01:23:07 +0200
some documention updates and changed the way we find paths for the sqlite dbfiles to use File::Spec, which I hope will solve some of the Win32 error messages
r7023 at Thesaurus (orig r7022): jnapiorkowski | 2009-07-10 18:00:38 +0200
pod cleanup, fixed broken pod links, and new Introduction pod
r7024 at Thesaurus (orig r7023): jnapiorkowski | 2009-07-10 19:10:57 +0200
updated Changes file to reflect work completed
r7025 at Thesaurus (orig r7024): jnapiorkowski | 2009-07-10 19:37:53 +0200
a few more Moose Type related fixes and added diag to the replication test to report the moose and types version used, to help us debug some of the moose related errors being reported
r7058 at Thesaurus (orig r7057): ribasushi | 2009-07-16 06:28:44 +0200
A couple of typos, and general whitespace cleanup (ick)
r7063 at Thesaurus (orig r7062): jnapiorkowski | 2009-07-16 17:03:32 +0200
increased Moose version requirements due to changes in the way type constraints get validated, which is not backwardly compatible
r7064 at Thesaurus (orig r7063): dandv | 2009-07-17 03:37:28 +0200
Minor POD grammar: it's -> its where appropriate
r7075 at Thesaurus (orig r7074): tomboh | 2009-07-20 18:20:37 +0200
Fix POD changes from r7040.
r7078 at Thesaurus (orig r7077): norbi | 2009-07-21 00:59:30 +0200
r7079 at Thesaurus (orig r7078): norbi | 2009-07-21 00:59:58 +0200
r7232 at vger: mendel | 2009-07-21 00:58:12 +0200
Fixed documentation and added test for the "Arbitrary SQL through a custom ResultSource" Cookbook alternate (subclassing) recipe.
r7080 at Thesaurus (orig r7079): norbi | 2009-07-21 01:05:32 +0200
r7235 at vger: mendel | 2009-07-21 01:05:18 +0200
Fixed 'typo' (removed a word that I left there by accident).
r7081 at Thesaurus (orig r7080): norbi | 2009-07-21 10:06:21 +0200
r7237 at vger: mendel | 2009-07-21 10:06:05 +0200
Fixing what my svk client screwed up.
r7082 at Thesaurus (orig r7081): caelum | 2009-07-21 16:51:55 +0200
update Storage::Replicated prereqs
r7083 at Thesaurus (orig r7082): caelum | 2009-07-21 18:16:34 +0200
show Oracle datetime_setup alter session statements in debug output
r7086 at Thesaurus (orig r7085): ribasushi | 2009-07-22 03:50:57 +0200
Lazy folks do not run the whole test suite before merging >:(
r7100 at Thesaurus (orig r7097): caelum | 2009-07-23 20:14:11 +0200
r6092 at hlagh (orig r7090): caelum | 2009-07-23 08:24:39 -0400
new branch for fixing the MONEY type in MSSQL
r6093 at hlagh (orig r7091): caelum | 2009-07-23 08:34:01 -0400
add test
r6283 at hlagh (orig r7093): caelum | 2009-07-23 10:31:08 -0400
fix money columns
r6284 at hlagh (orig r7094): caelum | 2009-07-23 10:34:06 -0400
minor change
r6285 at hlagh (orig r7095): caelum | 2009-07-23 11:01:37 -0400
add test for updating money value to NULL
r6286 at hlagh (orig r7096): caelum | 2009-07-23 14:09:26 -0400
add money type tests to dbd::sybase+mssql tests
r7129 at Thesaurus (orig r7126): caelum | 2009-07-28 02:03:47 +0200
add postgres "timestamp without time zone" support
r7143 at Thesaurus (orig r7140): caelum | 2009-07-30 14:46:04 +0200
update sqlite test schema
r7148 at Thesaurus (orig r7145): robkinyon | 2009-07-30 16:13:21 +0200
Added prefetch caveats
r7149 at Thesaurus (orig r7146): robkinyon | 2009-07-30 16:20:02 +0200
Fixed caveats
r7152 at Thesaurus (orig r7149): caelum | 2009-07-30 17:56:01 +0200
make ::Oracle::Generic load without DBD::Oracle
r7153 at Thesaurus (orig r7150): caelum | 2009-07-30 18:04:47 +0200
make sure DBD::Oracle is loaded when using constants from it
r7157 at Thesaurus (orig r7154): castaway | 2009-07-30 22:17:33 +0200
Mangled Rob's example somewhat, still needs explaining whch circs exactly cause the borken results
r7161 at Thesaurus (orig r7158): mo | 2009-07-31 12:51:20 +0200
POD fix
r7162 at Thesaurus (orig r7159): mo | 2009-07-31 12:52:42 +0200
undo that attributes merge stuff
r7169 at Thesaurus (orig r7166): castaway | 2009-08-02 12:41:25 +0200
Mention ResultSet, ResultSource and Row in synopsis
r7170 at Thesaurus (orig r7167): castaway | 2009-08-02 14:10:53 +0200
Docs: Explainations of result sources and how to find them
r7175 at Thesaurus (orig r7172): ribasushi | 2009-08-03 11:01:44 +0200
Disable Pod::Inherit makefile calls, until we get to version 0.02
r7179 at Thesaurus (orig r7176): ribasushi | 2009-08-03 11:51:42 +0200
r6983 at Thesaurus (orig r6982): ribasushi | 2009-07-04 11:46:57 +0200
New branch to experiment with a sanifying mysql on_connect_call
r6984 at Thesaurus (orig r6983): ribasushi | 2009-07-04 11:49:44 +0200
Initial set_ansi_mode code - make sure to utilize _do_query instead of dbh->do, so the result is visible in the trace
r6987 at Thesaurus (orig r6986): ribasushi | 2009-07-04 12:40:47 +0200
Fix POD
r7178 at Thesaurus (orig r7175): ribasushi | 2009-08-03 11:51:15 +0200
Wrap up set_strict_mode for mysql
r7181 at Thesaurus (orig r7178): ribasushi | 2009-08-03 12:41:32 +0200
Sanify unqualified column bindtype handling
Silence a warning when using a custom {from}
r7201 at Thesaurus (orig r7198): caelum | 2009-08-04 22:18:27 +0200
update Changes
r7208 at Thesaurus (orig r7205): ribasushi | 2009-08-05 08:34:25 +0200
Bump dependencies:
Test::More for the new no_plan/done_testing goodies
File::Temp as per RT#48431
r7210 at Thesaurus (orig r7207): ribasushi | 2009-08-05 08:36:32 +0200
r7156 at Thesaurus (orig r7153): robkinyon | 2009-07-30 20:06:04 +0200
Create prefetch_redux branch
r7164 at Thesaurus (orig r7161): robkinyon | 2009-07-31 22:41:01 +0200
Added MooseX::Traits to Makefile.PL
r7172 at Thesaurus (orig r7169): robkinyon | 2009-08-03 05:49:59 +0200
Added two tests and marked one todo_skip
r7187 at Thesaurus (orig r7184): ribasushi | 2009-08-03 17:24:41 +0200
Use goto to preserve correct error-at-line reporting
r7189 at Thesaurus (orig r7186): ribasushi | 2009-08-04 12:34:58 +0200
Add an extra test specifically for distinct/prefetch
Remove duplicate test in count/prefetch
Switch to as_query instead of debug overloading
r7190 at Thesaurus (orig r7187): ribasushi | 2009-08-04 12:35:57 +0200
Fix how a distinct-induced group_by is calculated, taking in consideration the new prefetch mechanism
r7197 at Thesaurus (orig r7194): ribasushi | 2009-08-04 17:31:33 +0200
Traits not needed by anything currently in dbic
r7198 at Thesaurus (orig r7195): ribasushi | 2009-08-04 17:41:14 +0200
Move around tests a bit
r7199 at Thesaurus (orig r7196): mo | 2009-08-04 21:10:57 +0200
prefetch-grouped fails, again
r7204 at Thesaurus (orig r7201): ribasushi | 2009-08-04 22:50:51 +0200
Split the search_related prefetch tests into a standalone testfile
r7205 at Thesaurus (orig r7202): ribasushi | 2009-08-04 23:05:03 +0200
Move norbi's test to prefetch_redux - it's the same idea
r7209 at Thesaurus (orig r7206): ribasushi | 2009-08-05 08:35:48 +0200
Tadaaaa (even more prefetch insanity)
r7212 at Thesaurus (orig r7209): ribasushi | 2009-08-05 08:38:41 +0200
r7107 at Thesaurus (orig r7104): caelum | 2009-07-24 06:51:57 +0200
new branch to move common mssql functionality into the base class, and other tweaks
r7109 at Thesaurus (orig r7106): caelum | 2009-07-24 07:28:11 +0200
moved code to ::DBI::MSSQL and added DT inflation test
r7112 at Thesaurus (orig r7109): caelum | 2009-07-24 08:46:16 +0200
merge in some more MSSQL code, including odbc dynamic cursor support
r7113 at Thesaurus (orig r7110): caelum | 2009-07-24 08:49:54 +0200
fix a warning in SQLAHacks
r7114 at Thesaurus (orig r7111): caelum | 2009-07-24 09:22:33 +0200
add placeholder support detection for mssql through dbd::sybase
r7118 at Thesaurus (orig r7115): caelum | 2009-07-24 16:39:06 +0200
minor doc clarification
r7122 at Thesaurus (orig r7119): caelum | 2009-07-25 16:10:30 +0200
move placeholder support detection into ::Sybase::Base
r7123 at Thesaurus (orig r7120): caelum | 2009-07-25 16:12:01 +0200
add a comment
r7127 at Thesaurus (orig r7124): caelum | 2009-07-26 18:04:29 +0200
SAVEPOINT methods for MSSQL
r7140 at Thesaurus (orig r7137): caelum | 2009-07-30 10:12:45 +0200
better tests for "smalldatetime" support in MSSQL
r7142 at Thesaurus (orig r7139): caelum | 2009-07-30 13:29:19 +0200
MSSQL GUID support
r7147 at Thesaurus (orig r7144): caelum | 2009-07-30 15:38:33 +0200
update sqlite test schema
r7150 at Thesaurus (orig r7147): caelum | 2009-07-30 16:26:47 +0200
make sure the new mssql insert method works on an un-reblessed storage
r7151 at Thesaurus (orig r7148): caelum | 2009-07-30 16:55:35 +0200
better rebless check for insert
r7154 at Thesaurus (orig r7151): caelum | 2009-07-30 18:57:22 +0200
add missing file
r7155 at Thesaurus (orig r7152): caelum | 2009-07-30 19:00:40 +0200
fix syntax error
r7163 at Thesaurus (orig r7160): caelum | 2009-07-31 15:52:41 +0200
fix a bug in _determine_driver
r7166 at Thesaurus (orig r7163): caelum | 2009-08-01 18:10:23 +0200
default collist for storage _resolve_column_info
r7182 at Thesaurus (orig r7179): caelum | 2009-08-03 13:42:31 +0200
check that dynamic cursors are functional if enabled
r7184 at Thesaurus (orig r7181): ribasushi | 2009-08-03 14:23:37 +0200
Adjust expected sql to match the new 'Track' table definition
r7186 at Thesaurus (orig r7183): ribasushi | 2009-08-03 15:16:10 +0200
Simplify code and add some comments
r7200 at Thesaurus (orig r7197): caelum | 2009-08-04 21:31:16 +0200
update oracle tests for new "track" table
r7203 at Thesaurus (orig r7200): caelum | 2009-08-04 22:39:57 +0200
update Changes
r7214 at Thesaurus (orig r7211): ribasushi | 2009-08-05 08:40:39 +0200
r7213 at Thesaurus (orig r7210): ribasushi | 2009-08-05 08:40:20 +0200
Really sanify _resolve_column_info
r7216 at Thesaurus (orig r7213): ribasushi | 2009-08-05 10:19:37 +0200
Reminder about discard_changes and friends
r7217 at Thesaurus (orig r7214): ribasushi | 2009-08-05 10:26:20 +0200
Reformat and fill-in changes
r7218 at Thesaurus (orig r7215): caelum | 2009-08-05 10:37:12 +0200
rename connect_call_use_mars to connect_call_use_MARS
r7219 at Thesaurus (orig r7216): ribasushi | 2009-08-05 10:38:14 +0200
Silence a TODO test
r7220 at Thesaurus (orig r7217): caelum | 2009-08-05 10:46:11 +0200
minor Changes update
r7230 at Thesaurus (orig r7227): castaway | 2009-08-05 14:57:52 +0200
Minty's conversion of cookbook "arbitrary sql" to use ResultSource::View, plus some examples in ::View itself.
Some style tweaks of mine
r7231 at Thesaurus (orig r7228): ribasushi | 2009-08-05 15:41:28 +0200
Dynamically load necessary table classes
r7236 at Thesaurus (orig r7233): caelum | 2009-08-05 19:49:51 +0200
fix rounding issues in mssql money tests
r7237 at Thesaurus (orig r7234): caelum | 2009-08-05 20:09:03 +0200
better money value comparison in tests
r7239 at Thesaurus (orig r7236): frew | 2009-08-05 20:53:32 +0200
whitespace jfklds;ajfklds;a
r7240 at Thesaurus (orig r7237): frew | 2009-08-05 20:54:41 +0200
Fix testing bug. Windows only.
r7256 at Thesaurus (orig r7253): ribasushi | 2009-08-07 11:19:35 +0200
r7232 at Thesaurus (orig r7229): jnapiorkowski | 2009-08-05 16:56:32 +0200
added test for the new default force pool behavior in PK->discard_changes and cleaned up the related tests a bit to give more meaningful info
r7233 at Thesaurus (orig r7230): jnapiorkowski | 2009-08-05 16:57:45 +0200
opps typo in test status messages
r7234 at Thesaurus (orig r7231): jnapiorkowski | 2009-08-05 17:03:46 +0200
added the default attrs to solve the failing test recently commited
r7235 at Thesaurus (orig r7232): jnapiorkowski | 2009-08-05 17:58:44 +0200
added test to make sure you can override the default attributes to discard_changes
r7241 at Thesaurus (orig r7238): jnapiorkowski | 2009-08-05 22:00:58 +0200
added replication as an optional feature to make installing it easier
r7253 at Thesaurus (orig r7250): ribasushi | 2009-08-07 11:06:41 +0200
Streamline makefile dep handling
r7254 at Thesaurus (orig r7251): ribasushi | 2009-08-07 11:07:14 +0200
Switch to done_testing
r7255 at Thesaurus (orig r7252): ribasushi | 2009-08-07 11:19:13 +0200
Move discard_changes code to Row.pm, better docs
r7257 at Thesaurus (orig r7254): ribasushi | 2009-08-07 11:21:35 +0200
Remove merged branch
r7259 at Thesaurus (orig r7256): ribasushi | 2009-08-07 14:16:13 +0200
Fix bogus POD
r7261 at Thesaurus (orig r7258): ribasushi | 2009-08-07 17:22:58 +0200
per mst: no optional deps
r7262 at Thesaurus (orig r7259): ribasushi | 2009-08-08 17:02:39 +0200
Stop using discard_changes() in Ordered (if I knew it will be *that* complex I would not touch it)
r7265 at Thesaurus (orig r7262): ribasushi | 2009-08-08 17:49:19 +0200
r7032 at Thesaurus (orig r7031): caelum | 2009-07-11 11:28:52 +0200
new branch to reduce connected() calls
r7033 at Thesaurus (orig r7032): caelum | 2009-07-11 13:07:41 +0200
added failing test
r7034 at Thesaurus (orig r7033): caelum | 2009-07-11 14:36:53 +0200
minor optimization
r7048 at Thesaurus (orig r7047): caelum | 2009-07-14 15:09:47 +0200
substantially reduced ping count, dynamic cursors support for mssql through odbc
r7050 at Thesaurus (orig r7049): caelum | 2009-07-14 16:06:39 +0200
a couple more options for odbc/mssql
r7052 at Thesaurus (orig r7051): caelum | 2009-07-15 00:14:09 +0200
unfuck ensure_connected for odbc/mssql
r7055 at Thesaurus (orig r7054): caelum | 2009-07-15 21:10:27 +0200
rename _scope_identity to _identity for odbc/mssql
r7056 at Thesaurus (orig r7055): caelum | 2009-07-16 00:41:45 +0200
add IC::DT tests for odbc/mssql
r7069 at Thesaurus (orig r7068): caelum | 2009-07-17 11:47:31 +0200
don't run connection actions if ->_rebless does not connect
r7108 at Thesaurus (orig r7105): caelum | 2009-07-24 07:26:13 +0200
moving test to another branch
r7110 at Thesaurus (orig r7107): caelum | 2009-07-24 07:52:33 +0200
revert odbc/mssql code to trunk and move it to another branch
r7111 at Thesaurus (orig r7108): caelum | 2009-07-24 08:13:35 +0200
revert t/746mssql.t to trunk and move to another branch
r7224 at Thesaurus (orig r7221): caelum | 2009-08-05 11:48:04 +0200
update branch after pull
r7225 at Thesaurus (orig r7222): ribasushi | 2009-08-05 12:09:07 +0200
Rename last_dbh and turn it into a public method
r7226 at Thesaurus (orig r7223): ribasushi | 2009-08-05 12:12:20 +0200
Whoopsie - more renames
r7227 at Thesaurus (orig r7224): ribasushi | 2009-08-05 12:32:09 +0200
Changes and a deploy() fix
r7228 at Thesaurus (orig r7225): ribasushi | 2009-08-05 12:36:01 +0200
We do not count pings during deploy - they are expected
r7229 at Thesaurus (orig r7226): ribasushi | 2009-08-05 12:49:06 +0200
Clarify autocommit default
r7238 at Thesaurus (orig r7235): caelum | 2009-08-05 20:39:47 +0200
fix up txn_begin and the ping_count test
r7263 at Thesaurus (orig r7260): ribasushi | 2009-08-08 17:40:19 +0200
A more straightforward txn_begin fix, some more test fixes
r7270 at Thesaurus (orig r7267): ribasushi | 2009-08-09 00:34:31 +0200
r6822 at Thesaurus (orig r6821): caelum | 2009-06-28 14:38:12 +0200
branch
r6825 at Thesaurus (orig r6824): caelum | 2009-06-28 14:40:37 +0200
->table(\"table")
r6827 at Thesaurus (orig r6826): caelum | 2009-06-28 14:55:06 +0200
revert
r6829 at Thesaurus (orig r6828): caelum | 2009-06-28 15:57:40 +0200
r5742 at hlagh (orig r6819): ribasushi | 2009-06-28 04:00:03 -0700
The prefetch+group_by is a complex problem - branch
r6834 at Thesaurus (orig r6833): caelum | 2009-06-28 23:24:47 +0200
->table(\"foo") now works
r6835 at Thesaurus (orig r6834): caelum | 2009-06-29 03:54:31 +0200
another test
r6849 at Thesaurus (orig r6848): caelum | 2009-06-29 21:39:26 +0200
separated table ref test out, changed CDTableRef to a view with less rels
r6852 at Thesaurus (orig r6851): caelum | 2009-06-29 22:56:45 +0200
changed CD to ->table(\"cd")
r6853 at Thesaurus (orig r6852): caelum | 2009-06-29 23:13:48 +0200
fix t/80unique.t
r6857 at Thesaurus (orig r6856): caelum | 2009-06-29 23:45:19 +0200
branch pushed, removing
r6858 at Thesaurus (orig r6857): caelum | 2009-06-29 23:46:54 +0200
removing debug statement
r6860 at Thesaurus (orig r6859): ribasushi | 2009-06-30 00:03:21 +0200
Minor fixes
r6861 at Thesaurus (orig r6860): ribasushi | 2009-06-30 00:25:27 +0200
This is sloppy, but sqlt is sloppy too. All tests pass now, all we really need is to intercept name() set-calls, and use a virtual view (the only legit setter is the new() call in ResultSourceProxy::Table
r6867 at Thesaurus (orig r6866): caelum | 2009-06-30 03:34:02 +0200
forgot to use Scalar::Util ()
r7007 at Thesaurus (orig r7006): caelum | 2009-07-09 07:37:22 +0200
r5766 at hlagh (orig r6843): abraxxa | 2009-06-29 02:02:17 -0700
fixed typo in test
r5779 at hlagh (orig r6847): ribasushi | 2009-06-29 10:09:00 -0700
Minor Ordered optimization (don't use count)
r5787 at hlagh (orig r6855): caelum | 2009-06-29 14:42:11 -0700
r5451 at hlagh (orig r6605): caelum | 2009-06-10 09:23:44 -0700
new branch to implement on_connect_call
r5484 at hlagh (orig r6633): caelum | 2009-06-11 11:03:10 -0700
on_connect_call implementation and set_datetime_format support for Oracle
r5492 at hlagh (orig r6641): caelum | 2009-06-11 16:39:28 -0700
connect_call_set_datetime_format for Oracle, I have no idea why this didn't get committed before...
r5504 at hlagh (orig r6655): caelum | 2009-06-12 17:28:06 -0700
finished up on_connect_call stuff
r5507 at hlagh (orig r6658): caelum | 2009-06-13 04:03:36 -0700
fixup _setup_connect_do, other minor cleanups
r5508 at hlagh (orig r6659): caelum | 2009-06-13 04:35:33 -0700
make the on_(dis)?connect_do accessors returnn the original structure
r5509 at hlagh (orig r6660): caelum | 2009-06-13 08:31:52 -0700
allow undef for _setup_connect_do
r5522 at hlagh (orig r6679): caelum | 2009-06-14 09:56:40 -0700
rename connect_do store
r5621 at hlagh (orig r6769): caelum | 2009-06-23 07:38:33 -0700
minor doc update
r5628 at hlagh (orig r6777): caelum | 2009-06-23 16:36:12 -0700
properly test nanosecond precision with oracle and datetime_setup
r5669 at hlagh (orig r6784): caelum | 2009-06-24 10:49:25 -0700
IC::DT does support timestamp with timezone
r5768 at hlagh (orig r6846): caelum | 2009-06-29 08:20:32 -0700
remove DateTime from 73oracle.t
r5781 at hlagh (orig r6849): caelum | 2009-06-29 13:07:43 -0700
remove the _store stuff for on_connect_do
r5785 at hlagh (orig r6853): ribasushi | 2009-06-29 14:38:30 -0700
Some beautification
r5802 at hlagh (orig r6870): ribasushi | 2009-06-30 01:09:03 -0700
Cleanup dependency handling a bit
r5806 at hlagh (orig r6874): ribasushi | 2009-06-30 03:39:06 -0700
Allow broken resultsource-class-derived objects to still work
r5807 at hlagh (orig r6875): ribasushi | 2009-06-30 03:40:46 -0700
clarify
r5835 at hlagh (orig r6877): ash | 2009-06-30 04:48:13 -0700
Update POD on Dynamic sub-classing
r5837 at hlagh (orig r6882): ribasushi | 2009-06-30 08:36:38 -0700
r6815 at Thesaurus (orig r6814): ribasushi | 2009-06-28 10:32:42 +0200
Branch to explore double joins on search_related
r6816 at Thesaurus (orig r6815): ribasushi | 2009-06-28 10:34:16 +0200
Thetest case that started it all
r6817 at Thesaurus (orig r6816): ribasushi | 2009-06-28 10:35:11 +0200
The proposed fix (do not add an extra join if it is already present in the topmost join)
r6818 at Thesaurus (orig r6817): ribasushi | 2009-06-28 11:04:26 +0200
Minor omission
r6819 at Thesaurus (orig r6818): ribasushi | 2009-06-28 11:07:33 +0200
Adjust a couple of tests for new behavior (thus all of this might be backwards incompatible to the point of being useless):
The counts in t/90join_torture.t are now 5*3, not 5*3*3, as a second join is not induced by search_related
The raw sql scan in t/prefetch/standard.t is just silly, won't even try to understand it
Just to maintain the TreeLike folding, I add a 3rd children join which was inserted by search_related before the code changes
r5843 at hlagh (orig r6888): ribasushi | 2009-06-30 10:36:11 -0700
Todoify test for now
r5844 at hlagh (orig r6889): ribasushi | 2009-06-30 10:37:05 -0700
Todoify test for now (2)
r5846 at hlagh (orig r6891): ribasushi | 2009-06-30 10:52:31 -0700
Todoify test for now (3)
r5850 at hlagh (orig r6902): ribasushi | 2009-06-30 23:46:12 -0700
Fixed deadlock test
r5851 at hlagh (orig r6903): ribasushi | 2009-07-01 03:22:00 -0700
Clarify exception text
r5854 at hlagh (orig r6906): ribasushi | 2009-07-01 04:23:46 -0700
r6821 at Thesaurus (orig r6820): ribasushi | 2009-06-28 13:09:11 +0200
Branch for prefetch+group play
r6823 at Thesaurus (orig r6822): ribasushi | 2009-06-28 14:38:36 +0200
Normalize group_by
r6824 at Thesaurus (orig r6823): ribasushi | 2009-06-28 14:39:54 +0200
Proper prefetch+group test
r6826 at Thesaurus (orig r6825): ribasushi | 2009-06-28 14:42:48 +0200
Whoops
r6828 at Thesaurus (orig r6827): ribasushi | 2009-06-28 15:06:57 +0200
Lose the literal sql bits - castaway is right it's silly to support those
r6833 at Thesaurus (orig r6832): ribasushi | 2009-06-28 22:38:43 +0200
Rogue comments
r6837 at Thesaurus (orig r6836): ribasushi | 2009-06-29 09:44:25 +0200
A couple of test fixes
r6838 at Thesaurus (orig r6837): ribasushi | 2009-06-29 09:46:13 +0200
Support for -select/-as in SQLAHacks field selection
r6839 at Thesaurus (orig r6838): ribasushi | 2009-06-29 09:49:53 +0200
This is tested elsewhere
r6840 at Thesaurus (orig r6839): ribasushi | 2009-06-29 09:50:43 +0200
This is tested elsewhere (2)
r6841 at Thesaurus (orig r6840): ribasushi | 2009-06-29 10:07:09 +0200
Test cleanups
r6842 at Thesaurus (orig r6841): ribasushi | 2009-06-29 10:11:13 +0200
Most of the grouped prefetch solution
r6843 at Thesaurus (orig r6842): ribasushi | 2009-06-29 10:14:45 +0200
clearer
r6845 at Thesaurus (orig r6844): ribasushi | 2009-06-29 12:05:37 +0200
And score! (all works)
r6882 at Thesaurus (orig r6881): ribasushi | 2009-06-30 16:23:06 +0200
rs->get_column now properly recognizes prefetch and collapses if at all possible
r6886 at Thesaurus (orig r6885): ribasushi | 2009-06-30 17:39:58 +0200
Whoops
r5857 at hlagh (orig r6909): ribasushi | 2009-07-01 04:27:15 -0700
Optimize set_column on uninserted objects
r5867 at hlagh (orig r6920): caelum | 2009-07-01 08:40:32 -0700
r5859 at hlagh (orig r6912): caelum | 2009-07-01 06:21:30 -0700
new connected() for dbd::sybase users
r5860 at hlagh (orig r6913): caelum | 2009-07-01 06:25:46 -0700
add a couple of dbd::sybase reconnection tests
r5861 at hlagh (orig r6914): caelum | 2009-07-01 06:35:07 -0700
better connection test
r5862 at hlagh (orig r6915): caelum | 2009-07-01 06:45:05 -0700
use dbh->do for connected instead of prepare_cached
r5863 at hlagh (orig r6916): ribasushi | 2009-07-01 06:55:21 -0700
Segfault
r5864 at hlagh (orig r6917): caelum | 2009-07-01 07:03:22 -0700
use ->do instead of ->prepare_cached in oracle's connected() too
r5865 at hlagh (orig r6918): caelum | 2009-07-01 08:20:52 -0700
fix segfault with old DBD::Sybase
r5866 at hlagh (orig r6919): caelum | 2009-07-01 08:39:18 -0700
move connection tests into _ping()
r5873 at hlagh (orig r6923): ijw | 2009-07-01 10:34:32 -0700
Added a test for a resultset to related-resultset join for 0 related records
r5874 at hlagh (orig r6927): ijw | 2009-07-01 11:04:16 -0700
Additional tests on prefetch - illustrates the bug with left-join has_many (NULL row returned) and the one that results from the trivial fix (prefetch gives no artist)
r5876 at hlagh (orig r6931): ribasushi | 2009-07-01 23:08:33 -0700
Another candidate for somethingawful.com (fix left join-ed count)
r5877 at hlagh (orig r6933): ribasushi | 2009-07-02 00:04:13 -0700
Changelog
r5878 at hlagh (orig r6934): ribasushi | 2009-07-02 02:23:48 -0700
cleanup
r5879 at hlagh (orig r6935): ijw | 2009-07-02 03:41:01 -0700
Check fetched rows == count for related resultsets
r5880 at hlagh (orig r6936): ijw | 2009-07-02 03:43:47 -0700
Confirm prefetch doesn't affect main row fetch, and main row fetch works with and without counting
r5881 at hlagh (orig r6937): ribasushi | 2009-07-02 03:52:51 -0700
More fail (fix is known but needs work)
r5882 at hlagh (orig r6938): ribasushi | 2009-07-02 04:07:22 -0700
And more fail
r5883 at hlagh (orig r6939): ribasushi | 2009-07-02 04:16:46 -0700
These tests are in prefetch/count.t
r5884 at hlagh (orig r6940): ribasushi | 2009-07-02 04:38:31 -0700
cleanup
r5885 at hlagh (orig r6941): ribasushi | 2009-07-02 04:38:49 -0700
Solve more prefetch inflation crap
r5886 at hlagh (orig r6942): ribasushi | 2009-07-02 04:47:41 -0700
Make the code readable
r5887 at hlagh (orig r6943): ribasushi | 2009-07-02 06:52:35 -0700
Everything works, just need to fix join-path chaining over search_related (to guard against obscure db quirks)
r5889 at hlagh (orig r6945): caelum | 2009-07-02 12:06:32 -0700
add sybase reconnect test
r5891 at hlagh (orig r6947): ribasushi | 2009-07-02 13:20:21 -0700
Last part of the join handling puzzle
r5894 at hlagh (orig r6950): ribasushi | 2009-07-02 15:14:50 -0700
r6360 at Thesaurus (orig r6359): arcanez | 2009-05-21 20:18:52 +0200
branch to work on prefetch/select
r6361 at Thesaurus (orig r6360): arcanez | 2009-05-21 20:32:46 +0200
failing test
r6373 at Thesaurus (orig r6372): ribasushi | 2009-05-22 11:07:26 +0200
Simplify unresolvable test by arcanez
r6905 at Thesaurus (orig r6904): ribasushi | 2009-07-01 12:54:03 +0200
Extend test
r6950 at Thesaurus (orig r6949): ribasushi | 2009-07-03 00:14:09 +0200
Apparent fix - simply delay the in_storage flagging of the main object until all prefetched objects are inflated. The rest of the changes are just cosmetics, preparing for the collapse_result rewrite
r5896 at hlagh (orig r6952): ribasushi | 2009-07-02 15:17:22 -0700
Changes
r5909 at hlagh (orig r6964): ribasushi | 2009-07-03 04:19:27 -0700
Add set_ansi_mode on_connect_call for mysql
Also switch to _do_query instead of plain dbh->do (shows up in the trace)
r5910 at hlagh (orig r6965): ribasushi | 2009-07-03 04:37:06 -0700
Capitalize mysql commands
r5911 at hlagh (orig r6966): ribasushi | 2009-07-03 06:07:49 -0700
Double an existing might_have test as has_one
r5912 at hlagh (orig r6967): ribasushi | 2009-07-03 07:36:32 -0700
Extra test to demonstrate has_one working, and a POD clarification of multicreate
r5917 at hlagh (orig r6972): ribasushi | 2009-07-03 11:20:42 -0700
r6554 at Thesaurus (orig r6553): frew | 2009-06-09 00:06:42 +0200
branch for mssql top issues
r6572 at Thesaurus (orig r6571): frew | 2009-06-09 23:18:46 +0200
more tests for SQL Server!
r6573 at Thesaurus (orig r6572): frew | 2009-06-09 23:49:10 +0200
Added AmbiguousGlob.pm for silly servers like mssql and mysql. See docs for more info
r6574 at Thesaurus (orig r6573): frew | 2009-06-09 23:55:22 +0200
fix plan
r6602 at Thesaurus (orig r6601): frew | 2009-06-10 17:03:30 +0200
more failing tests
r6608 at Thesaurus (orig r6607): frew | 2009-06-10 20:05:53 +0200
don't use eval!
r6610 at Thesaurus (orig r6609): frew | 2009-06-10 20:07:49 +0200
beginning of DWIM for IDENTITY_INSERT
r6628 at Thesaurus (orig r6627): frew | 2009-06-11 18:13:02 +0200
still busted :-(
r6631 at Thesaurus (orig r6630): frew | 2009-06-11 19:39:00 +0200
general function to go from column names and ident to result source
r6632 at Thesaurus (orig r6631): frew | 2009-06-11 19:40:11 +0200
Use new _resolve_column_sources method and begin insert_bulk method
r6635 at Thesaurus (orig r6634): frew | 2009-06-11 20:12:38 +0200
updated _resolve_column_source to _resolve_column_info as per ribasushi's suggestion
r6650 at Thesaurus (orig r6649): frew | 2009-06-12 17:13:32 +0200
Now I just need to check if the actual values are set...
r6651 at Thesaurus (orig r6650): frew | 2009-06-12 17:26:53 +0200
Insert Identity works!
r6652 at Thesaurus (orig r6651): frew | 2009-06-12 17:34:13 +0200
silly warns.
r6684 at Thesaurus (orig r6683): frew | 2009-06-15 16:49:00 +0200
failing test
r6686 at Thesaurus (orig r6685): ribasushi | 2009-06-15 18:10:26 +0200
make all resolved attrs visible to sqla
r6698 at Thesaurus (orig r6697): ribasushi | 2009-06-17 02:31:37 +0200
Half way working stuff, needs a LOT of tweaking still
r6729 at Thesaurus (orig r6728): ribasushi | 2009-06-19 19:49:27 +0200
Merge badness
r6730 at Thesaurus (orig r6729): ribasushi | 2009-06-19 19:49:40 +0200
fix eol
r6731 at Thesaurus (orig r6730): ribasushi | 2009-06-19 19:55:47 +0200
augment inheritance
r6735 at Thesaurus (orig r6734): ribasushi | 2009-06-20 10:34:42 +0200
Maybe I've nailed it
r6746 at Thesaurus (orig r6745): ribasushi | 2009-06-20 23:53:55 +0200
Test and merge fixes
r6747 at Thesaurus (orig r6746): ribasushi | 2009-06-21 00:01:09 +0200
Really fix tests
r6748 at Thesaurus (orig r6747): ribasushi | 2009-06-21 00:01:54 +0200
Really fix tests
r6749 at Thesaurus (orig r6748): ribasushi | 2009-06-21 00:18:33 +0200
Now really final
r6750 at Thesaurus (orig r6749): ribasushi | 2009-06-21 00:22:23 +0200
whoops
r6751 at Thesaurus (orig r6750): ribasushi | 2009-06-21 00:42:18 +0200
That should be all
r6752 at Thesaurus (orig r6751): ribasushi | 2009-06-21 08:54:00 +0200
Make sure quoting works
r6755 at Thesaurus (orig r6754): ribasushi | 2009-06-21 15:21:23 +0200
Groundwork for sanification of the toplimit test
r6863 at Thesaurus (orig r6862): ribasushi | 2009-06-30 01:13:49 +0200
Make sure storage classes use c3, just like the rest of dbic (tested on 5.8 as well)
r6869 at Thesaurus (orig r6868): ribasushi | 2009-06-30 09:53:27 +0200
Some fixes after review
r6874 at Thesaurus (orig r6873): ribasushi | 2009-06-30 11:54:34 +0200
Fix borked next invocation
r6896 at Thesaurus (orig r6895): frew | 2009-06-30 21:38:26 +0200
silly misspells and trailing whitespace
r6955 at Thesaurus (orig r6954): ribasushi | 2009-07-03 01:21:28 +0200
Some hack consolidation
r6962 at Thesaurus (orig r6961): ribasushi | 2009-07-03 12:06:57 +0200
Fix some mssql shortcommings when confronted with the new subequeried prefetch sql
r6963 at Thesaurus (orig r6962): ribasushi | 2009-07-03 12:47:57 +0200
Ask for newer DBD::Pg in author mode, suggest the newer version otherwise (proper array support). Make test more resilient as well
r6964 at Thesaurus (orig r6963): ribasushi | 2009-07-03 12:49:16 +0200
Switch to C3 mro throughout the ::Storage hierarchy (DBIx::Class brings in MRO::Compat, and all ::Storage's are based on it, tested on 5.8
r6969 at Thesaurus (orig r6968): ribasushi | 2009-07-03 19:54:04 +0200
Duh
r6970 at Thesaurus (orig r6969): frew | 2009-07-03 19:59:48 +0200
fix tests for new codez
r6971 at Thesaurus (orig r6970): ribasushi | 2009-07-03 20:18:53 +0200
detabify
r6972 at Thesaurus (orig r6971): ribasushi | 2009-07-03 20:20:07 +0200
changes
r5920 at hlagh (orig r6979): ribasushi | 2009-07-04 02:34:08 -0700
Hide devel documentation from the indexer
r5921 at hlagh (orig r6980): ribasushi | 2009-07-04 02:37:25 -0700
Add set_ansi_mode POD
r5922 at hlagh (orig r6981): ribasushi | 2009-07-04 02:45:24 -0700
Backout mysql changes for further polishing
r5925 at hlagh (orig r6984): ribasushi | 2009-07-04 03:08:16 -0700
Missing newline
r5926 at hlagh (orig r6985): ribasushi | 2009-07-04 03:11:18 -0700
typo
r5927 at hlagh (orig r6986): ribasushi | 2009-07-04 03:40:47 -0700
Fix POD
r5928 at hlagh (orig r6987): ribasushi | 2009-07-04 04:09:39 -0700
todos are shorter now
r5929 at hlagh (orig r6989): castaway | 2009-07-05 13:00:55 -0700
Added Pod::Inherit use to Makefile.PL at author-time, comments/suggestions as to whether its too "noisy" welcome.
r5930 at hlagh (orig r6990): ribasushi | 2009-07-05 15:06:52 -0700
Couple of makefile fixes:
use is compile time, use require
recommends is for distro maintainers only, push the dependency into the authors hash (it is not to be executed by mere mortals)
r5931 at hlagh (orig r6991): ribasushi | 2009-07-05 15:55:36 -0700
Forgotten pod exclusions
r5932 at hlagh (orig r6992): ribasushi | 2009-07-05 16:07:05 -0700
Temporarily backout Pod::Inherit changes
r5933 at hlagh (orig r6993): ribasushi | 2009-07-05 16:10:22 -0700
Put Pod::Inherit stuff back after proper copy
r7027 at Thesaurus (orig r7026): caelum | 2009-07-10 23:25:56 +0200
r5941 at hlagh (orig r7009): ribasushi | 2009-07-09 03:45:02 -0700
r6995 at Thesaurus (orig r6994): ribasushi | 2009-07-06 01:12:57 +0200
Where 08108 will come from
r7029 at Thesaurus (orig r7028): caelum | 2009-07-10 23:59:31 +0200
r5959 at hlagh (orig r7027): caelum | 2009-07-10 14:56:57 -0700
fix PodInherit call in Makefile.PL
r7067 at Thesaurus (orig r7066): caelum | 2009-07-17 10:18:24 +0200
r5961 at hlagh (orig r7029): robkinyon | 2009-07-10 18:03:07 -0400
Applied patch from kados regarding use of a DateTime::Format class to validate
r5962 at hlagh (orig r7030): caelum | 2009-07-11 05:26:40 -0400
reword IC::DT doc patch
r6009 at hlagh (orig r7037): dandv | 2009-07-13 08:06:08 -0400
PK::Auto has moved into Core since 2007
r6010 at hlagh (orig r7038): dandv | 2009-07-13 08:15:13 -0400
Fixed has_many example in Intro.pod
r6011 at hlagh (orig r7039): dandv | 2009-07-13 16:58:45 -0400
Fixed run-on sentences in FAQ
r6012 at hlagh (orig r7040): dandv | 2009-07-13 17:18:11 -0400
Minor POD fixes in Example.pod
r6013 at hlagh (orig r7041): dandv | 2009-07-13 17:48:18 -0400
Favored using ->single to get the topmost result over less readable ->slice(0)
r6014 at hlagh (orig r7042): dandv | 2009-07-13 18:56:31 -0400
Minor POD fixes in Cookbook
r6015 at hlagh (orig r7045): ribasushi | 2009-07-14 07:30:55 -0400
Minor logic cleanup
r6016 at hlagh (orig r7046): ribasushi | 2009-07-14 08:07:11 -0400
grouped prefetch fix
r6023 at hlagh (orig r7053): ijw | 2009-07-15 12:55:35 -0400
Added SQLA link for more comprehensive documentation of order_by options available
r6026 at hlagh (orig r7056): caelum | 2009-07-15 18:54:22 -0400
add "smalldatetime" support to IC::DT
r6029 at hlagh (orig r7059): ribasushi | 2009-07-16 00:29:41 -0400
r7013 at Thesaurus (orig r7012): jnapiorkowski | 2009-07-09 17:00:22 +0200
new branch
r7014 at Thesaurus (orig r7013): jnapiorkowski | 2009-07-09 20:06:44 +0200
changed the way transactions are detected for replication to work with the standard way to do this, minor doc updates, fix to the force pool so you can force a particular slave, changes to the way the debugging is created
r7015 at Thesaurus (orig r7014): jnapiorkowski | 2009-07-09 20:17:03 +0200
more changes to the way debug output works
r7016 at Thesaurus (orig r7015): jnapiorkowski | 2009-07-09 22:26:47 +0200
big update to the test suite so that we now check to make sure the storage that was expected was actually used
r7017 at Thesaurus (orig r7016): jnapiorkowski | 2009-07-09 23:23:37 +0200
set correct number of tests, changed the debuggin output to not warn on DDL, minor change to a test resultclass so we can deploy to mysql properly
r7018 at Thesaurus (orig r7017): jnapiorkowski | 2009-07-09 23:26:59 +0200
corrected the number of skipped tests
r7019 at Thesaurus (orig r7018): jnapiorkowski | 2009-07-09 23:52:22 +0200
fixed test resultclass formatting, added a few more DBIC::Storage::DBI methods that I might need to delegate.
r7020 at Thesaurus (orig r7019): jnapiorkowski | 2009-07-10 01:23:07 +0200
some documention updates and changed the way we find paths for the sqlite dbfiles to use File::Spec, which I hope will solve some of the Win32 error messages
r7023 at Thesaurus (orig r7022): jnapiorkowski | 2009-07-10 18:00:38 +0200
pod cleanup, fixed broken pod links, and new Introduction pod
r7024 at Thesaurus (orig r7023): jnapiorkowski | 2009-07-10 19:10:57 +0200
updated Changes file to reflect work completed
r7025 at Thesaurus (orig r7024): jnapiorkowski | 2009-07-10 19:37:53 +0200
a few more Moose Type related fixes and added diag to the replication test to report the moose and types version used, to help us debug some of the moose related errors being reported
r7058 at Thesaurus (orig r7057): ribasushi | 2009-07-16 06:28:44 +0200
A couple of typos, and general whitespace cleanup (ick)
r6031 at hlagh (orig r7062): jnapiorkowski | 2009-07-16 11:03:32 -0400
increased Moose version requirements due to changes in the way type constraints get validated, which is not backwardly compatible
r6032 at hlagh (orig r7063): dandv | 2009-07-16 21:37:28 -0400
Minor POD grammar: it's -> its where appropriate
r7105 at Thesaurus (orig r7102): caelum | 2009-07-24 06:34:56 +0200
r6075 at hlagh (orig r7074): tomboh | 2009-07-20 12:20:37 -0400
Fix POD changes from r7040.
r6081 at hlagh (orig r7077): norbi | 2009-07-20 18:59:30 -0400
r6082 at hlagh (orig r7078): norbi | 2009-07-20 18:59:58 -0400
r7232 at vger: mendel | 2009-07-21 00:58:12 +0200
Fixed documentation and added test for the "Arbitrary SQL through a custom ResultSource" Cookbook alternate (subclassing) recipe.
r6083 at hlagh (orig r7079): norbi | 2009-07-20 19:05:32 -0400
r7235 at vger: mendel | 2009-07-21 01:05:18 +0200
Fixed 'typo' (removed a word that I left there by accident).
r6084 at hlagh (orig r7080): norbi | 2009-07-21 04:06:21 -0400
r7237 at vger: mendel | 2009-07-21 10:06:05 +0200
Fixing what my svk client screwed up.
r6085 at hlagh (orig r7081): caelum | 2009-07-21 10:51:55 -0400
update Storage::Replicated prereqs
r6086 at hlagh (orig r7082): caelum | 2009-07-21 12:16:34 -0400
show Oracle datetime_setup alter session statements in debug output
r6088 at hlagh (orig r7085): ribasushi | 2009-07-21 21:50:57 -0400
Lazy folks do not run the whole test suite before merging >:(
r6287 at hlagh (orig r7097): caelum | 2009-07-23 14:14:11 -0400
r6092 at hlagh (orig r7090): caelum | 2009-07-23 08:24:39 -0400
new branch for fixing the MONEY type in MSSQL
r6093 at hlagh (orig r7091): caelum | 2009-07-23 08:34:01 -0400
add test
r6283 at hlagh (orig r7093): caelum | 2009-07-23 10:31:08 -0400
fix money columns
r6284 at hlagh (orig r7094): caelum | 2009-07-23 10:34:06 -0400
minor change
r6285 at hlagh (orig r7095): caelum | 2009-07-23 11:01:37 -0400
add test for updating money value to NULL
r6286 at hlagh (orig r7096): caelum | 2009-07-23 14:09:26 -0400
add money type tests to dbd::sybase+mssql tests
r7135 at Thesaurus (orig r7132): caelum | 2009-07-28 19:10:40 +0200
r6365 at hlagh (orig r7126): caelum | 2009-07-27 20:03:47 -0400
add postgres "timestamp without time zone" support
r7244 at Thesaurus (orig r7241): caelum | 2009-08-06 17:12:49 +0200
add warning for custom resultsources through ->name(SCALARREF) on ->deploy
r7245 at Thesaurus (orig r7242): caelum | 2009-08-06 17:54:33 +0200
improve the ->name(REF) warning code
r7268 at Thesaurus (orig r7265): ribasushi | 2009-08-09 00:23:24 +0200
Clarify POD and cleanup the ->name-hack warning
r7269 at Thesaurus (orig r7266): ribasushi | 2009-08-09 00:34:09 +0200
Fix a corner case and improve comments
r7279 at Thesaurus (orig r7276): ribasushi | 2009-08-09 15:25:34 +0200
r6535 at Thesaurus (orig r6534): ribasushi | 2009-06-06 11:12:03 +0200
Let's try again
r6536 at Thesaurus (orig r6535): ribasushi | 2009-06-06 11:32:00 +0200
Two failing MC tests
r6624 at Thesaurus (orig r6623): ribasushi | 2009-06-11 16:54:09 +0200
Another multicreate failing test - has_many should not do find_or_create
r6625 at Thesaurus (orig r6624): ribasushi | 2009-06-11 16:54:49 +0200
r6538 at Thesaurus (orig r6537): ribasushi | 2009-06-07 23:07:55 +0200
Fix for mysql subquery problem
r6539 at Thesaurus (orig r6538): ribasushi | 2009-06-07 23:36:43 +0200
Make empty/default inserts use standard SQL
r6540 at Thesaurus (orig r6539): ribasushi | 2009-06-08 00:59:21 +0200
Add mysql empty insert SQL override
Make SQLAHacks parts loadable at runtime via ensure_class_loaded
r6541 at Thesaurus (orig r6540): ribasushi | 2009-06-08 01:03:04 +0200
Make podcoverage happy
r6542 at Thesaurus (orig r6541): ribasushi | 2009-06-08 01:24:06 +0200
Fix find_or_new/create to stop returning random rows when default value insert is requested
r6543 at Thesaurus (orig r6542): ribasushi | 2009-06-08 11:36:56 +0200
Simply order_by/_virtual_order_by handling
r6553 at Thesaurus (orig r6552): ribasushi | 2009-06-08 23:56:41 +0200
duh
r6557 at Thesaurus (orig r6556): ash | 2009-06-09 12:20:34 +0200
Addjust bug to show problem with rows => 1 + child rel
r6558 at Thesaurus (orig r6557): ribasushi | 2009-06-09 13:12:46 +0200
Require a recent bugfixed Devel::Cycle
r6560 at Thesaurus (orig r6559): ash | 2009-06-09 15:07:30 +0200
Make IC::DT extra warning state the column name too
r6575 at Thesaurus (orig r6574): ribasushi | 2009-06-10 00:19:48 +0200
AuthorCheck fixes
r6579 at Thesaurus (orig r6578): ribasushi | 2009-06-10 00:52:17 +0200
r6522 at Thesaurus (orig r6521): ribasushi | 2009-06-05 19:27:55 +0200
New branch to try resultsource related stuff
r6545 at Thesaurus (orig r6544): ribasushi | 2009-06-08 13:00:54 +0200
First stab at adding resultsources to each join in select - works won-der-ful-ly
r6546 at Thesaurus (orig r6545): ribasushi | 2009-06-08 13:14:08 +0200
Commit failing test and thoughts on search arg deflation
r6576 at Thesaurus (orig r6575): ribasushi | 2009-06-10 00:31:55 +0200
Todoify DT in search deflation test until after 0.09
r6577 at Thesaurus (orig r6576): ribasushi | 2009-06-10 00:48:07 +0200
Factor out the $ident resolver
r6581 at Thesaurus (orig r6580): ribasushi | 2009-06-10 01:21:50 +0200
Move as_query out of the cursor
r6582 at Thesaurus (orig r6581): ribasushi | 2009-06-10 01:27:19 +0200
Think before commit
r6583 at Thesaurus (orig r6582): ribasushi | 2009-06-10 09:37:19 +0200
Clarify and disable rows/prefetch test - fix is easy, but architecturally unsound - need more time
r6591 at Thesaurus (orig r6590): ribasushi | 2009-06-10 13:33:37 +0200
r6544 at Thesaurus (orig r6543): ribasushi | 2009-06-08 11:44:59 +0200
Attempt to figure out why do we repeat joins on complex search_related
r6586 at Thesaurus (orig r6585): ribasushi | 2009-06-10 11:22:05 +0200
Move the rs preservation test to a more suitable place
r6589 at Thesaurus (orig r6588): ribasushi | 2009-06-10 13:15:48 +0200
Finally commit trully failing test
r6590 at Thesaurus (orig r6589): ribasushi | 2009-06-10 13:33:14 +0200
Duh, this was a pretty simple bug
r6593 at Thesaurus (orig r6592): ribasushi | 2009-06-10 13:43:31 +0200
What was I thinking - resultsource does not have an ->alias
r6598 at Thesaurus (orig r6597): ribasushi | 2009-06-10 14:48:39 +0200
Adjust changelog
r6601 at Thesaurus (orig r6600): ribasushi | 2009-06-10 15:50:43 +0200
Release 0.08104
r6615 at Thesaurus (orig r6614): ribasushi | 2009-06-11 14:29:48 +0200
Move around inflation tests
r6616 at Thesaurus (orig r6615): ribasushi | 2009-06-11 14:32:07 +0200
explicitly remove manifest on author mode make
r6617 at Thesaurus (orig r6616): ribasushi | 2009-06-11 15:02:41 +0200
IC::DT changes:
Switch SQLite storage to DT::F::SQLite
Fix exception when undef_if_invalid and timezone are both set on a column
Split t/89inflate_datetime into separate tests
Adjust makefile author dependencies
r6618 at Thesaurus (orig r6617): ribasushi | 2009-06-11 15:07:41 +0200
Move file_column test to inflate/ too
r6621 at Thesaurus (orig r6620): ribasushi | 2009-06-11 16:16:20 +0200
r5713 at Thesaurus (orig r5712): ribasushi | 2009-03-08 23:53:28 +0100
Branch for datatype-aware updates
r6604 at Thesaurus (orig r6603): ribasushi | 2009-06-10 18:08:25 +0200
Test for type-aware update
r6607 at Thesaurus (orig r6606): ribasushi | 2009-06-10 19:57:04 +0200
Datatype aware update works
r6609 at Thesaurus (orig r6608): ribasushi | 2009-06-10 20:06:40 +0200
Whoops
r6614 at Thesaurus (orig r6613): ribasushi | 2009-06-11 09:23:54 +0200
Add attribute doc
r6620 at Thesaurus (orig r6619): ribasushi | 2009-06-11 16:15:53 +0200
Use equality, not comparison
r6623 at Thesaurus (orig r6622): ribasushi | 2009-06-11 16:21:53 +0200
Changes
r6626 at Thesaurus (orig r6625): ribasushi | 2009-06-11 17:00:06 +0200
Adjust renamed relationship
r6646 at Thesaurus (orig r6645): ribasushi | 2009-06-12 09:00:02 +0200
This is not update_or_create - create any non-belongs_to without asking many questions
r7194 at Thesaurus (orig r7191): ribasushi | 2009-08-04 15:20:35 +0200
fix merge fallout
r7195 at Thesaurus (orig r7192): ribasushi | 2009-08-04 15:39:05 +0200
Remove bogus test - the real test is in t/multi_create/has_many.t
r7196 at Thesaurus (orig r7193): ribasushi | 2009-08-04 15:48:33 +0200
Separate the diamond MC test
Use the new Test::More's no_plan ability
r7274 at Thesaurus (orig r7271): ribasushi | 2009-08-09 14:39:29 +0200
Fix an arcane case with pk==fk tables (use the relationship direction specification if it is available
r7275 at Thesaurus (orig r7272): ribasushi | 2009-08-09 14:45:20 +0200
Optimize handling of {_rel_in_storage}, greatly reducing the amounf ot find_or_create calls (as indicated by the TODOs in t/multi_create/reentrance_count.t
r7277 at Thesaurus (orig r7274): ribasushi | 2009-08-09 15:23:24 +0200
Comment and todoify remaining test - too much of an undertaking / needs discussion
r7278 at Thesaurus (orig r7275): ribasushi | 2009-08-09 15:24:58 +0200
newline
r7282 at Thesaurus (orig r7279): ribasushi | 2009-08-09 16:17:03 +0200
Whoops, missed a line
r7283 at Thesaurus (orig r7280): mo | 2009-08-09 19:10:56 +0200
added TODO test: call accessors when create()ing a row
r7284 at Thesaurus (orig r7281): ribasushi | 2009-08-10 08:01:59 +0200
Fix bogus test
r7291 at Thesaurus (orig r7288): caelum | 2009-08-10 10:13:19 +0200
make _determine_driver more reentrant
r7297 at Thesaurus (orig r7294): michaelr | 2009-08-10 22:40:33 +0200
Added exception when resultset called without an argument
r7298 at Thesaurus (orig r7295): andyg | 2009-08-11 00:34:13 +0200
Add failing test for RT 47779, group_by as a scalar ref
r7301 at Thesaurus (orig r7298): ribasushi | 2009-08-11 09:52:03 +0200
Extra intro pod
r7302 at Thesaurus (orig r7299): mo | 2009-08-11 13:20:37 +0200
removed TODO test
r7303 at Thesaurus (orig r7300): ribasushi | 2009-08-11 14:16:28 +0200
Sanify group_by handling in complex prefetch rewrites
r7304 at Thesaurus (orig r7301): ribasushi | 2009-08-11 17:52:49 +0200
cleanup
r7305 at Thesaurus (orig r7302): ribasushi | 2009-08-11 19:40:59 +0200
Whitespace
r7306 at Thesaurus (orig r7303): ribasushi | 2009-08-11 20:00:11 +0200
Fix an obscure regression when inserting an object with a serialize-deflating column set
r7314 at Thesaurus (orig r7311): ribasushi | 2009-08-12 16:11:24 +0200
Remove needless inflate in Ordered
r7315 at Thesaurus (orig r7312): ribasushi | 2009-08-12 16:13:48 +0200
Remove leftovers from frew's tests
r7316 at Thesaurus (orig r7313): ribasushi | 2009-08-12 16:16:08 +0200
Grrrr
r7317 at Thesaurus (orig r7314): ribasushi | 2009-08-13 07:40:44 +0200
Caelum was right to make _get_dbh private - reverting (and some code refactoring)
r7318 at Thesaurus (orig r7315): ribasushi | 2009-08-13 07:41:43 +0200
Add a db/txn_do retry debugger (interesting results)
r7319 at Thesaurus (orig r7316): ribasushi | 2009-08-13 07:42:51 +0200
Adjust the storage DESTROY and the tests to accomodate the new global RaiseError=1
r7320 at Thesaurus (orig r7317): ribasushi | 2009-08-13 08:12:08 +0200
Last bit
r7322 at Thesaurus (orig r7319): ribasushi | 2009-08-17 11:09:39 +0200
Allow select AS specification for functions only via the -as hash-key (no pod yet)
r7323 at Thesaurus (orig r7320): ribasushi | 2009-08-17 11:41:08 +0200
Cookbook entry for -as and syntax tests
r7324 at Thesaurus (orig r7321): ribasushi | 2009-08-17 11:51:21 +0200
Changes
r7326 at Thesaurus (orig r7323): ribasushi | 2009-08-17 12:37:14 +0200
examples should be correct
r7332 at Thesaurus (orig r7329): caelum | 2009-08-18 06:19:12 +0200
always reconnect in odbc:mssql:connect_call_use_dynamic_cursors
r7333 at Thesaurus (orig r7330): caelum | 2009-08-18 06:43:35 +0200
minor change
r7335 at Thesaurus (orig r7332): ribasushi | 2009-08-18 08:51:20 +0200
r7248 at Thesaurus (orig r7245): rbuels | 2009-08-06 21:39:05 +0200
making topic branch for "currval undefined" problem when not qualifying tables with their schema names
r7249 at Thesaurus (orig r7246): rbuels | 2009-08-06 21:40:39 +0200
failing (crashing, really) test for this strange pg thing. could not figure out a way to make a non-crashing test
r7250 at Thesaurus (orig r7247): rbuels | 2009-08-06 21:42:30 +0200
fix for pg non-schema-qualified thing, with a nice vague commit message. performance should be the same as before, for the common (schema-qualified) case
r7251 at Thesaurus (orig r7248): rbuels | 2009-08-06 22:41:19 +0200
woops, pg search path fix needed support for quoted schema names in search paths
r7295 at Thesaurus (orig r7292): rbuels | 2009-08-10 20:45:50 +0200
added caching of pg search path in Pg storage object
r7296 at Thesaurus (orig r7293): rbuels | 2009-08-10 22:37:31 +0200
added test for empty table before non-schema-qualified pg sequence test in 72pg.t
r7299 at Thesaurus (orig r7296): rbuels | 2009-08-11 00:46:35 +0200
added blub to Changes for pg_unqualified_schema branch
r7300 at Thesaurus (orig r7297): rbuels | 2009-08-11 00:48:53 +0200
added me (rbuels) to contributors
r7328 at Thesaurus (orig r7325): rbuels | 2009-08-17 23:46:21 +0200
added POD section about schema support to DBIx::Class::Storage::Pg
r7329 at Thesaurus (orig r7326): rbuels | 2009-08-17 23:51:40 +0200
added more tests for multi-schema support in 72pg.t
r7334 at Thesaurus (orig r7331): ribasushi | 2009-08-18 08:49:03 +0200
Un-plan test and fix authorship
r7341 at Thesaurus (orig r7338): ribasushi | 2009-08-18 10:55:23 +0200
r7337 at Thesaurus (orig r7334): ribasushi | 2009-08-18 09:00:03 +0200
Pre-release branch
r7338 at Thesaurus (orig r7335): ribasushi | 2009-08-18 10:32:13 +0200
Disambiguate POD
r7339 at Thesaurus (orig r7336): ribasushi | 2009-08-18 10:32:53 +0200
Release 0.08109
r7346 at Thesaurus (orig r7343): robkinyon | 2009-08-19 21:44:48 +0200
Applied doc patch by spb
r7347 at Thesaurus (orig r7344): ribasushi | 2009-08-20 07:50:49 +0200
Fix a weird-ass sqlt invocation in deployment_statements()
r7348 at Thesaurus (orig r7345): ribasushi | 2009-08-20 08:19:07 +0200
Apply pod patch by arthas (slightly modified)
r7353 at Thesaurus (orig r7350): abraxxa | 2009-08-20 15:07:29 +0200
pod patch for 'Tracing SQL' examples
r7356 at Thesaurus (orig r7353): spb | 2009-08-20 19:53:02 +0200
Minor fix to the previous doc patch
r7357 at Thesaurus (orig r7354): frew | 2009-08-20 23:54:04 +0200
add some basic guards to get rid of warnings
r7361 at Thesaurus (orig r7358): ribasushi | 2009-08-21 11:18:43 +0200
Because prefetch uses the cache system, it is not possible to set HRI on a prefetched rs without upsetting the tests - don't compare
Property changes on: DBIx-Class/0.08/branches/prefetch
___________________________________________________________________
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/count_distinct:6218
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/count_rs:6741
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/diamond_relationships:6310
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/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/joined_count:6323
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/multi_stuff:5565
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mystery_join:6589
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle-tweaks:6222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle_sequence:4173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/order_by_refactor:6475
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/parser_fk_index:4485
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch_limit:6724
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/replication_dedux:4600
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/rsrc_in_storage:6577
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/rt_bug_41083:5437
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/savepoints:4223
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sqla_1.50_compat:5321
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-ms-access:4142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-tweaks:6262
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/subclassed_rsset:5930
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/subquery:5617
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase:5651
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_mssql:6125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/top_limit_altfix:6429
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/type_aware_update:6619
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/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:6763
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:7237
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class:32260
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class-CDBICompat:54993
9c88509d-e914-0410-b01c-b9530614cbfe:/vendor/DBIx-Class:31122
ab17426e-7cd3-4704-a2a2-80b7c0a611bb:/local/dbic_column_attr:10946
ab17426e-7cd3-4704-a2a2-80b7c0a611bb:/local/dbic_trunk:11788
bd5ac9a7-f185-4d95-9186-dbb8b392a572:/local/os/bast/DBIx-Class/0.08/trunk:2798
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/_abandoned_but_possibly_useful/table_name_ref:7266
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/belongs_to_null_col_fix:5244
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/cdbicompat_integration:4160
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/column_attr:5074
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/complex_join_rels:4589
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/count_distinct:6218
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/count_rs:6741
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/diamond_relationships:6310
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/discard_changes_replication_fix:7252
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/file_column:3920
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/fix-update-and-delete-as_query:6162
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/grouped_prefetch:6885
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/joined_count:6323
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mc_fixes:6645
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_money_type:7096
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_storage_minor_refactor:7210
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_top_fixes:6971
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/multi_stuff:5565
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/multicreate_fixes:7275
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mysql_ansi:7175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mystery_join:6589
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/new_replication_transaction_fixup:7058
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_connect_call:6854
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle-tweaks:6222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle_sequence:4173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/order_by_refactor:6475
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/parser_fk_index:4485
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/pg_unqualified_schema:7331
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch_limit:6724
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch_redux:7206
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/reduce_pings:7261
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/replication_dedux:4600
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/rsrc_in_storage:6577
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/rt_bug_41083:5437
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/savepoints:4223
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/search_related_prefetch:6818
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sqla_1.50_compat:5321
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-ms-access:4142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-tweaks:6262
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/subclassed_rsset:5930
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/subquery:5617
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/syb_connected:6919
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase:5651
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_mssql:6125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/table_name_ref:7132
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/top_limit_altfix:6429
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/type_aware_update:6619
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/unresolvable_prefetch:6949
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioned_enhancements:4125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioning:4578
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/views:5585
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/tags/0.08108_prerelease_please_do_not_pull_into_it:7008
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/tags/pre_0.08109_please_do_not_merge:7336
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/trunk:7358
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
Name: svn:mergeinfo
+
Modified: DBIx-Class/0.08/branches/prefetch/Changes
===================================================================
--- DBIx-Class/0.08/branches/prefetch/Changes 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/Changes 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,14 +1,83 @@
Revision history for DBIx::Class
+0.08109 2009-08-18 08:35:00 (UTC)
+ - Replication updates:
+ - Improved the replication tests so that they are more reliable
+ and accurate, and hopefully solve some cross platform issues.
+ - Bugfixes related to naming particular replicants in a
+ 'force_pool' attribute.
+ - Lots of documentation updates, including a new Introduction.pod
+ file.
+ - Fixed the way we detect transaction to make this more reliable
+ and forward looking.
+ - Fixed some trouble with the way Moose Types are used.
+ - Made discard_chages/get_from_storage replication aware (they
+ now read from the master storage by default)
+ - Refactor of MSSQL storage drivers, with some new features:
+ - Support for placeholders for MSSQL via DBD::Sybase with proper
+ autodetection
+ - 'uniqueidentifier' support with auto newid()
+ - Dynamic cursor support and other MARS options for ODBC
+ - savepoints with auto_savepoint => 1
+ - Support for MSSQL 'money' type
+ - Support for 'smalldatetime' type used in MSSQL and Sybase for
+ InflateColumn::DateTime
+ - support for Postgres 'timestamp without timezone' type in
+ InflateColumn::DateTime (RT#48389)
+ - Added new MySQL specific on_connect_call macro 'set_strict_mode'
+ (also known as make_mysql_not_suck_as_much)
+ - Multiple prefetch-related fixes:
+ - Adjust overly agressive subquery join-chain pruning
+ - Always preserve the outer join-chain - fixes numerous
+ problems with search_related chaining
+ - Deal with the distinct => 1 attribute properly when using
+ prefetch
+ - An extension of the select-hashref syntax, allowing labeling
+ SQL-side aliasing: select => [ { max => 'foo', -as => 'bar' } ]
+ - Massive optimization of the DBI storage layer - reduce the
+ amount of connected() ping-calls
+ - Some fixes of multi-create corner cases
+ - Multiple POD improvements
+ - Added exception when resultset is called without an argument
+ - Improved support for non-schema-qualified tables under
+ Postgres (fixed last_insert_id sequence name auto-detection)
+
+0.08108 2009-07-05 23:15:00 (UTC)
+ - Fixed the has_many prefetch with limit/group deficiency -
+ it is now possible to select "top 5 commenters" while
+ prefetching all their comments
+ - New resultsed method count_rs, returns a ::ResultSetColumn
+ which in turn returns a single count value
+ - Even better support of count with limit
+ - New on_connect_call/on_disconnect_call functionality (check
+ POD of Storage::DBI)
+ - Automatic datetime handling environment/session setup for
+ Oracle via connect_call_datetime_setup()
+ - count/all on related left-joined empty resultsets now correctly
+ returns 0/()
- Fixed regression when both page and offset are specified on
a resultset
- Fixed HRI returning too many empty results on multilevel
nonexisting prefetch
- - Fixed the prefetch with limit bug
- - New resultsed method count_rs, returns a ::ResultSetColumn
- which in turn returns a single count value
- make_column_dirty() now overwrites the deflated value with an
inflated one if such exists
+ - Fixed set_$rel with where restriction deleting rows outside
+ the restriction
+ - populate() returns the created objects or an arrayref of the
+ created objects depending on scalar vs. list context
+ - Fixed find_related on 'single' relationships - the former
+ implementation would overspecify the WHERE condition, reporting
+ no related objects when there in fact is one
+ - SQL::Translator::Parser::DBIx::Class now attaches tables to the
+ central schema object in relationship dependency order
+ - Fixed regression in set_column() preventing sourceless object
+ manipulations
+ - Fixed a bug in search_related doubling a join if the original
+ $rs already joins/prefetches the same relation
+ - Storage::DBI::connected() improvements for Oracle and Sybase
+ - Fixed prefetch+incomplete select regression introduced in
+ 0.08100
+ - MSSQL limit (TOP emulation) fixes and improvements
0.08107 2009-06-14 08:21:00 (UTC)
- Fix serialization regression introduced in 0.08103 (affects
@@ -25,8 +94,8 @@
- Update of numeric columns now properly uses != to determine
dirtyness instead of the usual eq
- Fixes to IC::DT tests
- - Fixed exception when undef_if_invalid and timezone are both set on
- an invalid datetime column
+ - Fixed exception when undef_if_invalid and timezone are both set
+ on an invalid datetime column
0.08104 2009-06-10 13:38:00 (UTC)
- order_by now can take \[$sql, @bind] as in
Modified: DBIx-Class/0.08/branches/prefetch/Features_09
===================================================================
--- DBIx-Class/0.08/branches/prefetch/Features_09 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/Features_09 2009-08-21 09:22:51 UTC (rev 7359)
@@ -14,12 +14,8 @@
- "belongs_to" to "contains/refers/something"
Using inflated objects/references as values in searches
- - Goes together with subselects above
- should deflate then run search
-FilterColumn - like Inflate, only for changing scalar values
- - This seems to be vaporware atm..
-
SQL/API feature complete?
- UNION
- proper join conditions!
@@ -27,17 +23,16 @@
Moosification - ouch
+Metamodel stuff - introspection
+
Prefetch improvements
- slow on mysql, speedup?
- multi has_many prefetch
- - paging working with prefetch
Magically "discover" needed joins/prefetches and add them
- eg $books->search({ 'author.name' => 'Fred'}), autoadds: join => 'author'
- also guess aliases when supplying column names that are on joined/related tables
-Metamodel stuff - introspection
-
Storage API/restructure
- call update/insert etc on the ResultSource, which then calls to storage
- handle different storages/db-specific code better
@@ -52,4 +47,3 @@
Documentation - improvements
- better indexing for finding of stuff in general
- more cross-referencing of docs
-
Modified: DBIx-Class/0.08/branches/prefetch/Makefile.PL
===================================================================
--- DBIx-Class/0.08/branches/prefetch/Makefile.PL 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/Makefile.PL 2009-08-21 09:22:51 UTC (rev 7359)
@@ -9,22 +9,16 @@
perl_version '5.006001';
all_from 'lib/DBIx/Class.pm';
-requires 'DBD::SQLite' => 1.25;
-requires 'Data::Page' => 2.00;
-requires 'SQL::Abstract' => 1.56;
-requires 'SQL::Abstract::Limit' => 0.13;
-requires 'Class::C3::Componentised' => 1.0005;
-requires 'Carp::Clan' => 6.0;
-requires 'DBI' => 1.605;
-requires 'Module::Find' => 0.06;
-requires 'Class::Inspector' => 1.24;
-requires 'Class::Accessor::Grouped' => 0.08003;
-requires 'JSON::Any' => 1.18;
-requires 'Scope::Guard' => 0.03;
-requires 'Path::Class' => 0.16;
-requires 'Sub::Name' => 0.04;
-requires 'MRO::Compat' => 0.09;
+test_requires 'Test::Builder' => 0.33;
+test_requires 'Test::Deep' => 0;
+test_requires 'Test::Exception' => 0;
+test_requires 'Test::More' => 0.92;
+test_requires 'Test::Warn' => 0.11;
+
+test_requires 'File::Temp' => 0.22;
+
+
# Core
requires 'List::Util' => 0;
requires 'Scalar::Util' => 0;
@@ -33,33 +27,39 @@
# Perl 5.8.0 doesn't have utf8::is_utf8()
requires 'Encode' => 0 if ($] <= 5.008000);
-test_requires 'Test::More' => 0.82;
-test_requires 'Test::Builder' => 0.33;
-test_requires 'Test::Warn' => 0.11;
-test_requires 'Test::Exception' => 0;
-test_requires 'Test::Deep' => 0;
+# Dependencies (keep in alphabetical order)
+requires 'Carp::Clan' => 6.0;
+requires 'Class::Accessor::Grouped' => 0.08003;
+requires 'Class::C3::Componentised' => 1.0005;
+requires 'Class::Inspector' => 1.24;
+requires 'Data::Page' => 2.00;
+requires 'DBD::SQLite' => 1.25;
+requires 'DBI' => 1.605;
+requires 'JSON::Any' => 1.18;
+requires 'MRO::Compat' => 0.09;
+requires 'Module::Find' => 0.06;
+requires 'Path::Class' => 0.16;
+requires 'Scope::Guard' => 0.03;
+requires 'SQL::Abstract' => 1.56;
+requires 'SQL::Abstract::Limit' => 0.13;
+requires 'Sub::Name' => 0.04;
recommends 'SQL::Translator' => 0.09004;
-install_script (qw|
- script/dbicadmin
-|);
+my %replication_requires = (
+ 'Moose', => 0.87,
+ 'MooseX::AttributeHelpers' => 0.21,
+ 'MooseX::Types', => 0.16,
+ 'namespace::clean' => 0.11,
+ 'Hash::Merge', => 0.11,
+);
-tests_recursive (qw|
- t
-|);
+my %force_requires_if_author = (
+ %replication_requires,
-resources 'IRC' => 'irc://irc.perl.org/#dbix-class';
-resources 'license' => 'http://dev.perl.org/licenses/';
-resources 'repository' => 'http://dev.catalyst.perl.org/svnweb/bast/browse/DBIx-Class/';
-resources 'MailingList' => 'http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class';
-
-
-# re-build README and require extra modules for testing if we're in a checkout
-
-my %force_requires_if_author = (
+# 'Module::Install::Pod::Inherit' => 0.01,
'Test::Pod::Coverage' => 1.04,
- 'SQL::Translator' => 0.09004,
+ 'SQL::Translator' => 0.09007,
# CDBI-compat related
'DBIx::ContextualFetch' => 0,
@@ -73,32 +73,59 @@
'Test::Memory::Cycle' => 0,
'Devel::Cycle' => 1.10,
- # t/inflate/datetime*.t
- # t/72.pg
# t/36datetime.t
# t/60core.t
'DateTime::Format::SQLite' => 0,
- 'DateTime::Format::MySQL' => 0,
- 'DateTime::Format::Pg' => 0,
# t/96_is_deteministic_value.t
- 'DateTime::Format::Strptime' => 0,
+ 'DateTime::Format::Strptime'=> 0,
- # t/72pg.t
+ # database-dependent reqs
+ #
$ENV{DBICTEST_PG_DSN}
- ? ('Sys::SigAction'=> 0)
- : ()
+ ? (
+ 'Sys::SigAction' => 0,
+ 'DBD::Pg' => 2.009002,
+ 'DateTime::Format::Pg' => 0,
+ ) : ()
,
- # t/93storage_replication.t
- 'Moose', => 0.77,
- 'MooseX::AttributeHelpers' => 0.12,
- 'MooseX::Types', => 0.10,
- 'namespace::clean' => 0.11,
- 'Hash::Merge', => 0.11,
+ $ENV{DBICTEST_MYSQL_DSN}
+ ? (
+ 'DateTime::Format::MySQL' => 0,
+ ) : ()
+ ,
+ $ENV{DBICTEST_ORACLE_DSN}
+ ? (
+ 'DateTime::Format::Oracle' => 0,
+ ) : ()
+ ,
);
+
+install_script (qw|
+ script/dbicadmin
+|);
+
+tests_recursive (qw|
+ t
+|);
+
+resources 'IRC' => 'irc://irc.perl.org/#dbix-class';
+resources 'license' => 'http://dev.perl.org/licenses/';
+resources 'repository' => 'http://dev.catalyst.perl.org/svnweb/bast/browse/DBIx-Class/';
+resources 'MailingList' => 'http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class';
+
+no_index 'DBIx::Class::Storage::DBI::Sybase::Base';
+no_index 'DBIx::Class::SQLAHacks';
+no_index 'DBIx::Class::SQLAHacks::MSSQL';
+no_index 'DBIx::Class::Storage::DBI::AmbiguousGlob';
+no_index 'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server';
+no_index 'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars';
+
+# re-build README and require extra modules for testing if we're in a checkout
+
if ($Module::Install::AUTHOR) {
warn <<'EOW';
******************************************************************************
@@ -111,7 +138,7 @@
EOW
- foreach my $module (keys %force_requires_if_author) {
+ foreach my $module (sort keys %force_requires_if_author) {
build_requires ($module => $force_requires_if_author{$module});
}
@@ -122,6 +149,9 @@
print "Removing MANIFEST\n";
unlink 'MANIFEST';
}
+
+# require Module::Install::Pod::Inherit;
+# PodInherit();
}
auto_install();
Modified: DBIx-Class/0.08/branches/prefetch/TODO
===================================================================
--- DBIx-Class/0.08/branches/prefetch/TODO 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/TODO 2009-08-21 09:22:51 UTC (rev 7359)
@@ -3,12 +3,8 @@
- ResultSource objects caching ->resultset causes interesting problems
- find why XSUB dumper kills schema in Catalyst (may be Pg only?)
-2006-04-11 by castaway
- - docs of copy() should say that is_auto_increment is essential for auto_incrementing keys
-
2006-03-25 by mst
- find a way to un-wantarray search without breaking compat
- - audit logging component
- delay relationship setup if done via ->load_classes
- double-sided relationships
- make short form of class specifier in relationships work
@@ -21,9 +17,6 @@
We should still support the old inflate/deflate syntax, but this new
way should be recommended.
-2006-02-07 by castaway
- - Extract DBIC::SQL::Abstract into a separate module for CPAN
-
2006-03-18 by bluefeet
- Support table locking.
@@ -47,18 +40,8 @@
if you haven't specified one of the others
2008-10-30 by ribasushi
- Leftovers for next dev-release
- Rewrite the test suite to rely on $schema->deploy, allowing for seamless
testing of various RDBMS using the same tests
- - Proper support of default create (i.e. create({}) ), with proper workarounds
- for different Storage's
- Automatically infer quote_char/name_sep from $schema->storage
- - Finally incorporate View support (needs real tests)
- Fix and properly test chained search attribute merging
-
-2008-11-07 by ribasushi
- - Be loud when a relationship resolution fails because we did not select/as
- a neccessary pk
- Recursive update() (all code seems to be already available)
- - $rs->populate changes its syntax depending on wantarray context (BAD)
- Also the interface differs from $schema->populate (not so good)
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ColumnCase.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ColumnCase.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ColumnCase.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -16,10 +16,10 @@
sub has_a {
my($self, $col, @rest) = @_;
-
+
$self->_declare_has_a(lc $col, @rest);
$self->_mk_inflated_column_accessor($col);
-
+
return 1;
}
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ColumnGroups.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ColumnGroups.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -73,7 +73,7 @@
sub _has_custom_accessor {
my($class, $name) = @_;
-
+
no strict 'refs';
my $existing_accessor = *{$class .'::'. $name}{CODE};
return $existing_accessor && !$our_accessors{$existing_accessor};
@@ -90,7 +90,7 @@
my $fullname = join '::', $class, $name;
*$fullname = Sub::Name::subname $fullname, $accessor;
}
-
+
$our_accessors{$accessor}++;
return 1;
@@ -120,7 +120,7 @@
# warn " $field $alias\n";
{
no strict 'refs';
-
+
$class->_deploy_accessor($name, $accessor);
$class->_deploy_accessor($alias, $accessor);
}
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ColumnsAsHash.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -39,16 +39,16 @@
my $class = shift;
my $new = $class->next::method(@_);
-
+
$new->_make_columns_as_hash;
-
+
return $new;
}
sub _make_columns_as_hash {
my $self = shift;
-
+
for my $col ($self->columns) {
if( exists $self->{$col} ) {
warn "Skipping mapping $col to a hash key because it exists";
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Copy.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Copy.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Copy.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -25,7 +25,7 @@
sub copy {
my($self, $arg) = @_;
return $self->next::method($arg) if ref $arg;
-
+
my @primary_columns = $self->primary_columns;
croak("Need hash-ref to edit copied column values")
if @primary_columns > 1;
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ImaDBI.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ImaDBI.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/ImaDBI.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -59,7 +59,7 @@
$rel_obj->{cond}, $to, $from) );
return $join;
}
-
+
} );
sub db_Main {
@@ -115,7 +115,7 @@
sub transform_sql {
my ($class, $sql, @args) = @_;
-
+
my $tclass = $class->sql_transformer_class;
$class->ensure_class_loaded($tclass);
my $t = $tclass->new($class, $sql, @args);
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Iterator.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Iterator.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Iterator.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -25,7 +25,7 @@
sub _init_result_source_instance {
my $class = shift;
-
+
my $table = $class->next::method(@_);
$table->resultset_class("DBIx::Class::CDBICompat::Iterator::ResultSet");
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/LazyLoading.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/LazyLoading.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/LazyLoading.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -16,12 +16,12 @@
# request in case the database modifies the new value (say, via a trigger)
sub update {
my $self = shift;
-
+
my @dirty_columns = keys %{$self->{_dirty_columns}};
-
+
my $ret = $self->next::method(@_);
$self->_clear_column_data(@dirty_columns);
-
+
return $ret;
}
@@ -30,12 +30,12 @@
sub create {
my $class = shift;
my($data) = @_;
-
+
my @columns = keys %$data;
-
+
my $obj = $class->next::method(@_);
return $obj unless defined $obj;
-
+
my %primary_cols = map { $_ => 1 } $class->primary_columns;
my @data_cols = grep !$primary_cols{$_}, @columns;
$obj->_clear_column_data(@data_cols);
@@ -46,7 +46,7 @@
sub _clear_column_data {
my $self = shift;
-
+
delete $self->{_column_data}{$_} for @_;
delete $self->{_inflated_column}{$_} for @_;
}
@@ -71,7 +71,7 @@
for my $col ($self->primary_columns) {
$changes->{$col} = undef unless exists $changes->{$col};
}
-
+
return $self->next::method($changes);
}
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/LiveObjectIndex.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/LiveObjectIndex.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/LiveObjectIndex.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -20,9 +20,9 @@
sub nocache {
my $class = shift;
-
+
return $class->__nocache(@_) if @_;
-
+
return 1 if $Class::DBI::Weaken_Is_Available == 0;
return $class->__nocache;
}
@@ -74,9 +74,9 @@
sub inflate_result {
my ($class, @rest) = @_;
my $new = $class->next::method(@rest);
-
+
return $new if $new->nocache;
-
+
if (my $key = $new->ID) {
#warn "Key $key";
my $live = $class->live_object_index;
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Relationship.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Relationship.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Relationship.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -25,7 +25,7 @@
sub new {
my($class, $args) = @_;
-
+
return bless $args, $class;
}
@@ -34,7 +34,7 @@
my $code = sub {
$_[0]->{$key};
};
-
+
no strict 'refs';
*{$method} = Sub::Name::subname $method, $code;
}
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Relationships.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Relationships.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Relationships.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -24,10 +24,10 @@
sub has_a {
my($self, $col, @rest) = @_;
-
+
$self->_declare_has_a($col, @rest);
$self->_mk_inflated_column_accessor($col);
-
+
return 1;
}
@@ -37,7 +37,7 @@
$self->throw_exception( "No such column ${col}" )
unless $self->has_column($col);
$self->ensure_class_loaded($f_class);
-
+
my $rel_info;
if ($args{'inflate'} || $args{'deflate'}) { # Non-database has_a
@@ -50,7 +50,7 @@
$args{'deflate'} = sub { shift->$meth; };
}
$self->inflate_column($col, \%args);
-
+
$rel_info = {
class => $f_class
};
@@ -59,9 +59,9 @@
$self->belongs_to($col, $f_class);
$rel_info = $self->result_source_instance->relationship_info($col);
}
-
+
$rel_info->{args} = \%args;
-
+
$self->_extend_meta(
has_a => $col,
$rel_info
@@ -72,7 +72,7 @@
sub _mk_inflated_column_accessor {
my($class, $col) = @_;
-
+
return $class->mk_group_accessors('inflated_column' => $col);
}
@@ -137,7 +137,7 @@
sub might_have {
my ($class, $rel, $f_class, @columns) = @_;
-
+
my $ret;
if (ref $columns[0] || !defined $columns[0]) {
$ret = $class->next::method($rel, $f_class, @columns);
@@ -153,7 +153,7 @@
might_have => $rel,
$rel_info
);
-
+
return $ret;
}
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Retrieve.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Retrieve.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/Retrieve.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -74,7 +74,7 @@
my $class = shift;
my $obj = $class->resultset_instance->new_result(@_);
$obj->in_storage(1);
-
+
return $obj;
}
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/TempColumns.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/TempColumns.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat/TempColumns.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -11,7 +11,7 @@
sub _add_column_group {
my ($class, $group, @cols) = @_;
-
+
return $class->next::method($group, @cols) unless $group eq 'TEMP';
my %new_cols = map { $_ => 1 } @cols;
@@ -61,11 +61,11 @@
sub set {
my($self, %data) = @_;
-
+
my $temp_data = $self->_extract_temp_data(\%data);
-
+
$self->set_temp($_, $temp_data->{$_}) for keys %$temp_data;
-
+
return $self->next::method(%data);
}
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/CDBICompat.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -11,7 +11,7 @@
DBIx::ContextualFetch
Clone
);
-
+
my @didnt_load;
for my $module (@Extra_Modules) {
push @didnt_load, $module unless eval qq{require $module};
@@ -149,13 +149,13 @@
package Foo;
use base qw(Class::DBI);
-
+
Foo->table("foo");
Foo->columns( All => qw(this that bar) );
package Bar;
use base qw(Class::DBI);
-
+
Bar->table("bar");
Bar->columns( All => qw(up down) );
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/DB.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/DB.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/DB.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -174,7 +174,7 @@
sub result_source_instance {
my $class = shift;
$class = ref $class || $class;
-
+
if (@_) {
my $source = $_[0];
$class->_result_source_instance([$source, $class]);
@@ -186,7 +186,7 @@
return unless Scalar::Util::blessed($source);
if ($result_class ne $class) { # new class
- # Give this new class it's own source and register it.
+ # Give this new class its own source and register it.
$source = $source->new({
%$source,
source_name => $class,
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Exception.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Exception.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Exception.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -61,7 +61,7 @@
else {
$msg = Carp::longmess($msg);
}
-
+
my $self = { msg => $msg };
bless $self => $class;
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/InflateColumn/DateTime.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/InflateColumn/DateTime.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/InflateColumn/DateTime.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -18,6 +18,7 @@
__PACKAGE__->load_components(qw/InflateColumn::DateTime Core/);
__PACKAGE__->add_columns(
starts_when => { data_type => 'datetime' }
+ create_date => { data_type => 'date' }
);
NOTE: You B<must> load C<InflateColumn::DateTime> B<before> C<Core>. See
@@ -40,17 +41,26 @@
__PACKAGE__->add_columns(
starts_when => { data_type => 'varchar', inflate_datetime => 1 }
);
-
+
__PACKAGE__->add_columns(
starts_when => { data_type => 'varchar', inflate_date => 1 }
);
It's also possible to explicitly skip inflation:
-
+
__PACKAGE__->add_columns(
starts_when => { data_type => 'datetime', inflate_datetime => 0 }
);
+NOTE: Don't rely on C<InflateColumn::DateTime> to parse date strings for you.
+The column is set directly for any non-references and C<InflateColumn::DateTime>
+is completely bypassed. Instead, use an input parser to create a DateTime
+object. For instance, if your user input comes as a 'YYYY-MM-DD' string, you can
+use C<DateTime::Format::ISO8601> thusly:
+
+ use DateTime::Format::ISO8601;
+ my $dt = DateTime::Format::ISO8601->parse_datetime('YYYY-MM-DD');
+
=head1 DESCRIPTION
This module figures out the type of DateTime::Format::* class to
@@ -60,6 +70,16 @@
that this feature is new as of 0.07, so it may not be perfect yet - bug
reports to the list very much welcome).
+If the data_type of a field is C<date>, C<datetime> or C<timestamp> (or
+a derivative of these datatypes, e.g. C<timestamp with timezone>, this
+module will automatically call the appropriate parse/format method for
+deflation/inflation as defined in the storage class. For instance, for
+a C<datetime> field the methods C<parse_datetime> and C<format_datetime>
+would be called on deflation/inflation. If the storage class does not
+provide a specialized inflator/deflator, C<[parse|format]_datetime> will
+be used as a fallback. See L<DateTime::Format> for more information on
+date formatting.
+
For more help with using components, see L<DBIx::Class::Manual::Component/USING>.
=cut
@@ -77,7 +97,7 @@
In the case of an invalid date, L<DateTime> will throw an exception. To
bypass these exceptions and just have the inflation return undef, use
the C<datetime_undef_if_invalid> option in the column info:
-
+
"broken_date",
{
data_type => "datetime",
@@ -110,6 +130,12 @@
if ($type eq "timestamp with time zone" || $type eq "timestamptz") {
$type = "timestamp";
$info->{_ic_dt_method} ||= "timestamp_with_timezone";
+ } elsif ($type eq "timestamp without time zone") {
+ $type = "timestamp";
+ $info->{_ic_dt_method} ||= "timestamp_without_timezone";
+ } elsif ($type eq "smalldatetime") {
+ $type = "datetime";
+ $info->{_ic_dt_method} ||= "datetime";
}
}
@@ -126,7 +152,7 @@
"please put it directly into the '$column' column definition.";
$locale = $info->{extra}{locale};
}
-
+
$locale = $info->{locale} if defined $info->{locale};
$timezone = $info->{timezone} if defined $info->{timezone};
@@ -211,7 +237,7 @@
=head1 USAGE NOTES
-If you have a datetime column with the C<timezone> extra setting, and subsenquently
+If you have a datetime column with an associated C<timezone>, and subsequently
create/update this column with a DateTime object in the L<DateTime::TimeZone::Floating>
timezone, you will get a warning (as there is a very good chance this will not have the
result you expect). For example:
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/InflateColumn/File.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/InflateColumn/File.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/InflateColumn/File.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -58,7 +58,7 @@
sub insert {
my $self = shift;
-
+
# cache our file columns so we can write them to the fs
# -after- we have a PK
my %file_column;
@@ -114,7 +114,7 @@
In your L<DBIx::Class> table class:
__PACKAGE__->load_components( "PK::Auto", "InflateColumn::File", "Core" );
-
+
# define your columns
__PACKAGE__->add_columns(
"id",
@@ -136,8 +136,8 @@
size => 255,
},
);
-
+
In your L<Catalyst::Controller> class:
FileColumn requires a hash that contains L<IO::File> as handle and the file's
@@ -152,15 +152,15 @@
body => '....'
});
$c->stash->{entry}=$entry;
-
+
And Place the following in your TT template
-
+
Article Subject: [% entry.subject %]
Uploaded File:
<a href="/static/files/[% entry.id %]/[% entry.filename.filename %]">File</a>
Body: [% entry.body %]
-
+
The file will be stored on the filesystem for later retrieval. Calling delete
on your resultset will delete the file from the filesystem. Retrevial of the
record automatically inflates the column back to the set hash with the
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Cookbook.pod
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Cookbook.pod 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Cookbook.pod 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,4 +1,4 @@
-=head1 NAME
+=head1 NAME
DBIx::Class::Manual::Cookbook - Miscellaneous recipes
@@ -19,6 +19,8 @@
return $rs->all(); # all records for page 1
+ return $rs->page(2); # records for page 2
+
You can get a L<Data::Page> object for the resultset (suitable for use
in e.g. a template) using the C<pager> method:
@@ -59,28 +61,30 @@
=head2 Retrieve one and only one row from a resultset
-Sometimes you need only the first "top" row of a resultset. While this can be
-easily done with L<< $rs->first|DBIx::Class::ResultSet/first >>, it is suboptimal,
-as a full blown cursor for the resultset will be created and then immediately
-destroyed after fetching the first row object.
-L<< $rs->single|DBIx::Class::ResultSet/single >> is
-designed specifically for this case - it will grab the first returned result
-without even instantiating a cursor.
+Sometimes you need only the first "top" row of a resultset. While this
+can be easily done with L<< $rs->first|DBIx::Class::ResultSet/first
+>>, it is suboptimal, as a full blown cursor for the resultset will be
+created and then immediately destroyed after fetching the first row
+object. L<< $rs->single|DBIx::Class::ResultSet/single >> is designed
+specifically for this case - it will grab the first returned result
+without even instantiating a cursor.
-Before replacing all your calls to C<first()> with C<single()> please observe the
+Before replacing all your calls to C<first()> with C<single()> please observe the
following CAVEATS:
=over
=item *
+
While single() takes a search condition just like search() does, it does
_not_ accept search attributes. However one can always chain a single() to
a search():
- my $top_cd = $cd_rs -> search({}, { order_by => 'rating' }) -> single;
+ my $top_cd = $cd_rs->search({}, { order_by => 'rating' })->single;
=item *
+
Since single() is the engine behind find(), it is designed to fetch a
single row per database query. Thus a warning will be issued when the
underlying SELECT returns more than one row. Sometimes however this usage
@@ -88,7 +92,7 @@
at the top of the charts at any given time. If you know what you are doing,
you can silence the warning by explicitly limiting the resultset size:
- my $top_cd = $cd_rs -> search ({}, { order_by => 'rating', rows => 1 }) -> single;
+ my $top_cd = $cd_rs->search ({}, { order_by => 'rating', rows => 1 })->single;
=back
@@ -96,80 +100,64 @@
Sometimes you have to run arbitrary SQL because your query is too complex
(e.g. it contains Unions, Sub-Selects, Stored Procedures, etc.) or has to
-be optimized for your database in a special way, but you still want to
-get the results as a L<DBIx::Class::ResultSet>.
-The recommended way to accomplish this is by defining a separate ResultSource
-for your query. You can then inject complete SQL statements using a scalar
-reference (this is a feature of L<SQL::Abstract>).
+be optimized for your database in a special way, but you still want to
+get the results as a L<DBIx::Class::ResultSet>.
-Say you want to run a complex custom query on your user data, here's what
-you have to add to your User class:
+This is accomplished by defining a
+L<ResultSource::View|DBIx::Class::ResultSource::View> for your query,
+almost like you would define a regular ResultSource.
- package My::Schema::Result::User;
-
+ package My::Schema::Result::UserFriendsComplex;
+ use strict;
+ use warnings;
use base qw/DBIx::Class/;
-
- # ->load_components, ->table, ->add_columns, etc.
- # Make a new ResultSource based on the User class
- my $source = __PACKAGE__->result_source_instance();
- my $new_source = $source->new( $source );
- $new_source->source_name( 'UserFriendsComplex' );
-
- # Hand in your query as a scalar reference
- # It will be added as a sub-select after FROM,
- # so pay attention to the surrounding brackets!
- $new_source->name( \<<SQL );
- ( SELECT u.* FROM user u
- INNER JOIN user_friends f ON u.id = f.user_id
- WHERE f.friend_user_id = ?
- UNION
- SELECT u.* FROM user u
- INNER JOIN user_friends f ON u.id = f.friend_user_id
- WHERE f.user_id = ? )
- SQL
+ __PACKAGE__->load_components('Core');
+ __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
- # Finally, register your new ResultSource with your Schema
- My::Schema->register_extra_source( 'UserFriendsComplex' => $new_source );
+ # ->table, ->add_columns, etc.
+ # do not attempt to deploy() this view
+ __PACKAGE__->result_source_instance->is_virtual(1);
+
+ __PACKAGE__->result_source_instance->view_definition(q[
+ SELECT u.* FROM user u
+ INNER JOIN user_friends f ON u.id = f.user_id
+ WHERE f.friend_user_id = ?
+ UNION
+ SELECT u.* FROM user u
+ INNER JOIN user_friends f ON u.id = f.friend_user_id
+ WHERE f.user_id = ?
+ ]);
+
Next, you can execute your complex query using bind parameters like this:
- my $friends = [ $schema->resultset( 'UserFriendsComplex' )->search( {},
+ my $friends = $schema->resultset( 'UserFriendsComplex' )->search( {},
{
bind => [ 12345, 12345 ]
}
- ) ];
-
+ );
+
... and you'll get back a perfect L<DBIx::Class::ResultSet> (except, of course,
that you cannot modify the rows it contains, ie. cannot call L</update>,
L</delete>, ... on it).
-If you prefer to have the definitions of these custom ResultSources in separate
-files (instead of stuffing all of them into the same resultset class), you can
-achieve the same with subclassing the resultset class and defining the
-ResultSource there:
+Note that you cannot have bind parameters unless is_virtual is set to true.
- package My::Schema::Result::UserFriendsComplex;
+=over
- use My::Schema::Result::User;
- use base qw/My::Schema::Result::User/;
+=item * NOTE
- __PACKAGE__->table('dummy'); # currently must be called before anything else
+If you're using the old deprecated C<< $rsrc_instance->name(\'( SELECT ...') >>
+method for custom SQL execution, you are highly encouraged to update your code
+to use a virtual view as above. If you do not want to change your code, and just
+want to suppress the deprecation warning when you call
+L<DBIx::Class::Schema/deploy>, add this line to your source definition, so that
+C<deploy> will exclude this "table":
- # Hand in your query as a scalar reference
- # It will be added as a sub-select after FROM,
- # so pay attention to the surrounding brackets!
- __PACKAGE__->name( \<<SQL );
- ( SELECT u.* FROM user u
- INNER JOIN user_friends f ON u.id = f.user_id
- WHERE f.friend_user_id = ?
- UNION
- SELECT u.* FROM user u
- INNER JOIN user_friends f ON u.id = f.friend_user_id
- WHERE f.user_id = ? )
- SQL
+ sub sqlt_deploy_hook { $_[1]->schema->drop_table ($_[1]) }
-TIMTOWDI.
+=back
=head2 Using specific columns
@@ -211,13 +199,34 @@
# SELECT name name, LENGTH( name )
# FROM artist
-Note that the C< as > attribute has absolutely nothing to with the sql
-syntax C< SELECT foo AS bar > (see the documentation in
-L<DBIx::Class::ResultSet/ATTRIBUTES>). If your alias exists as a
-column in your base class (i.e. it was added with C<add_columns>), you
-just access it as normal. Our C<Artist> class has a C<name> column, so
-we just use the C<name> accessor:
+Note that the C<as> attribute B<has absolutely nothing to do> with the sql
+syntax C< SELECT foo AS bar > (see the documentation in
+L<DBIx::Class::ResultSet/ATTRIBUTES>). You can control the C<AS> part of the
+generated SQL via the C<-as> field attribute as follows:
+ my $rs = $schema->resultset('Artist')->search(
+ {},
+ {
+ join => 'cds',
+ distinct => 1,
+ '+select' => [ { count => 'cds.cdid', -as => 'amount_of_cds' } ],
+ '+as' => [qw/num_cds/],
+ order_by => { -desc => 'amount_of_cds' },
+ }
+ );
+
+ # Equivalent SQL
+ # SELECT me.artistid, me.name, me.rank, me.charfield, COUNT( cds.cdid ) AS amount_of_cds
+ # FROM artist me LEFT JOIN cd cds ON cds.artist = me.artistid
+ # GROUP BY me.artistid, me.name, me.rank, me.charfield
+ # ORDER BY amount_of_cds DESC
+
+
+If your alias exists as a column in your base class (i.e. it was added with
+L<add_columns|DBIx::Class::ResultSource/add_columns>), you just access it as
+normal. Our C<Artist> class has a C<name> column, so we just use the C<name>
+accessor:
+
my $artist = $rs->first();
my $name = $artist->name();
@@ -231,7 +240,7 @@
# Define accessor manually:
sub name_length { shift->get_column('name_length'); }
-
+
# Or use DBIx::Class::AccessorGroup:
__PACKAGE__->mk_group_accessors('column' => 'name_length');
@@ -240,23 +249,23 @@
my $rs = $schema->resultset('Artist')->search(
{},
{
- columns => [ qw/artistid name rank/ ],
+ columns => [ qw/artist_id name rank/ ],
distinct => 1
- }
+ }
);
my $rs = $schema->resultset('Artist')->search(
{},
{
- columns => [ qw/artistid name rank/ ],
- group_by => [ qw/artistid name rank/ ],
+ columns => [ qw/artist_id name rank/ ],
+ group_by => [ qw/artist_id name rank/ ],
}
);
# Equivalent SQL:
- # SELECT me.artistid, me.name, me.rank
+ # SELECT me.artist_id, me.name, me.rank
# FROM artist me
- # GROUP BY artistid, name, rank
+ # GROUP BY artist_id, name, rank
=head2 SELECT COUNT(DISTINCT colname)
@@ -279,7 +288,7 @@
my $count = $rs->count;
# Equivalent SQL:
- # SELECT COUNT( * ) FROM (SELECT me.name FROM artist me GROUP BY me.name) count_subq:
+ # SELECT COUNT( * ) FROM (SELECT me.name FROM artist me GROUP BY me.name) count_subq:
=head2 Grouping results
@@ -336,7 +345,7 @@
my $rs = $cdrs->search({
year => {
'=' => $cdrs->search(
- { artistid => { '=' => \'me.artistid' } },
+ { artist_id => { '=' => \'me.artist_id' } },
{ alias => 'inner' }
)->get_column('year')->max_rs->as_query,
},
@@ -349,7 +358,7 @@
WHERE year = (
SELECT MAX(inner.year)
FROM cd inner
- WHERE artistid = me.artistid
+ WHERE artist_id = me.artist_id
)
=head3 EXPERIMENTAL
@@ -359,7 +368,7 @@
=head2 Predefined searches
You can write your own L<DBIx::Class::ResultSet> class by inheriting from it
-and define often used searches as methods:
+and defining often used searches as methods:
package My::DBIC::ResultSet::CD;
use strict;
@@ -429,15 +438,20 @@
=head2 Using joins and prefetch
You can use the C<join> attribute to allow searching on, or sorting your
-results by, one or more columns in a related table. To return all CDs matching
-a particular artist name:
+results by, one or more columns in a related table.
+This requires that you have defined the L<DBIx::Class::Relationship>. For example :
+
+ My::Schema::CD->has_many( artists => 'My::Schema::Artist', 'artist_id');
+
+To return all CDs matching a particular artist name, you specify the name of the relationship ('artists'):
+
my $rs = $schema->resultset('CD')->search(
{
- 'artist.name' => 'Bob Marley'
+ 'artists.name' => 'Bob Marley'
},
{
- join => 'artist', # join the artist table
+ join => 'artists', # join the artist table
}
);
@@ -446,16 +460,19 @@
# JOIN artist ON cd.artist = artist.id
# WHERE artist.name = 'Bob Marley'
+In that example both the join, and the condition use the relationship name rather than the table name
+(see L<DBIx::Class::Manual::Joining> for more details on aliasing ).
+
If required, you can now sort on any column in the related tables by including
-it in your C<order_by> attribute:
+it in your C<order_by> attribute, (again using the aliased relation name rather than table name) :
my $rs = $schema->resultset('CD')->search(
{
- 'artist.name' => 'Bob Marley'
+ 'artists.name' => 'Bob Marley'
},
{
- join => 'artist',
- order_by => [qw/ artist.name /]
+ join => 'artists',
+ order_by => [qw/ artists.name /]
}
);
@@ -492,12 +509,12 @@
my $rs = $schema->resultset('CD')->search(
{
- 'artist.name' => 'Bob Marley'
+ 'artists.name' => 'Bob Marley'
},
{
- join => 'artist',
- order_by => [qw/ artist.name /],
- prefetch => 'artist' # return artist data too!
+ join => 'artists',
+ order_by => [qw/ artists.name /],
+ prefetch => 'artists' # return artist data too!
}
);
@@ -665,7 +682,7 @@
my $schema = $cd->result_source->schema;
# use the schema as normal:
- my $artist_rs = $schema->resultset('Artist');
+ my $artist_rs = $schema->resultset('Artist');
This can be useful when you don't want to pass around a Schema object to every
method.
@@ -685,7 +702,7 @@
=head2 Stringification
-Employ the standard stringification technique by using the C<overload>
+Employ the standard stringification technique by using the L<overload>
module.
To make an object stringify itself as a single column, use something
@@ -733,17 +750,17 @@
# do whatever else you wanted if it was a new row
}
-=head2 Static sub-classing DBIx::Class result classes
+=head2 Static sub-classing DBIx::Class result classes
AKA adding additional relationships/methods/etc. to a model for a
specific usage of the (shared) model.
-B<Schema definition>
-
- package My::App::Schema;
-
- use base DBIx::Class::Schema;
+B<Schema definition>
+ package My::App::Schema;
+
+ use base DBIx::Class::Schema;
+
# load subclassed classes from My::App::Schema::Result/ResultSet
__PACKAGE__->load_namespaces;
@@ -755,35 +772,35 @@
/]});
1;
-
-B<Result-Subclass definition>
-
+
+B<Result-Subclass definition>
+
package My::App::Schema::Result::Baz;
-
- use strict;
- use warnings;
- use base My::Shared::Model::Result::Baz;
-
+
+ use strict;
+ use warnings;
+ use base My::Shared::Model::Result::Baz;
+
# WARNING: Make sure you call table() again in your subclass,
# otherwise DBIx::Class::ResultSourceProxy::Table will not be called
# and the class name is not correctly registered as a source
- __PACKAGE__->table('baz');
-
- sub additional_method {
- return "I'm an additional method only needed by this app";
+ __PACKAGE__->table('baz');
+
+ sub additional_method {
+ return "I'm an additional method only needed by this app";
}
1;
-
-=head2 Dynamic Sub-classing DBIx::Class proxy classes
+=head2 Dynamic Sub-classing DBIx::Class proxy classes
+
AKA multi-class object inflation from one table
-
+
L<DBIx::Class> classes are proxy classes, therefore some different
techniques need to be employed for more than basic subclassing. In
this example we have a single user table that carries a boolean bit
for admin. We would like like to give the admin users
-objects(L<DBIx::Class::Row>) the same methods as a regular user but
+objects (L<DBIx::Class::Row>) the same methods as a regular user but
also special admin only methods. It doesn't make sense to create two
seperate proxy-class files for this. We would be copying all the user
methods into the Admin class. There is a cleaner way to accomplish
@@ -795,125 +812,128 @@
grab the object being returned, inspect the values we are looking for,
bless it if it's an admin object, and then return it. See the example
below:
-
-B<Schema Definition>
-
- package My::Schema;
-
- use base qw/DBIx::Class::Schema/;
-
+
+B<Schema Definition>
+
+ package My::Schema;
+
+ use base qw/DBIx::Class::Schema/;
+
__PACKAGE__->load_namespaces;
1;
-
-
-B<Proxy-Class definitions>
-
- package My::Schema::Result::User;
-
- use strict;
- use warnings;
- use base qw/DBIx::Class/;
-
- ### Defined what our admin class is for ensure_class_loaded
- my $admin_class = __PACKAGE__ . '::Admin';
-
- __PACKAGE__->load_components(qw/Core/);
-
- __PACKAGE__->table('users');
-
- __PACKAGE__->add_columns(qw/user_id email password
- firstname lastname active
- admin/);
-
- __PACKAGE__->set_primary_key('user_id');
-
- sub inflate_result {
- my $self = shift;
- my $ret = $self->next::method(@_);
- if( $ret->admin ) {### If this is an admin rebless for extra functions
- $self->ensure_class_loaded( $admin_class );
- bless $ret, $admin_class;
- }
- return $ret;
- }
-
- sub hello {
- print "I am a regular user.\n";
- return ;
- }
-
+
+
+B<Proxy-Class definitions>
+
+ package My::Schema::Result::User;
+
+ use strict;
+ use warnings;
+ use base qw/DBIx::Class/;
+
+ ### Define what our admin class is, for ensure_class_loaded()
+ my $admin_class = __PACKAGE__ . '::Admin';
+
+ __PACKAGE__->load_components(qw/Core/);
+
+ __PACKAGE__->table('users');
+
+ __PACKAGE__->add_columns(qw/user_id email password
+ firstname lastname active
+ admin/);
+
+ __PACKAGE__->set_primary_key('user_id');
+
+ sub inflate_result {
+ my $self = shift;
+ my $ret = $self->next::method(@_);
+ if( $ret->admin ) {### If this is an admin, rebless for extra functions
+ $self->ensure_class_loaded( $admin_class );
+ bless $ret, $admin_class;
+ }
+ return $ret;
+ }
+
+ sub hello {
+ print "I am a regular user.\n";
+ return ;
+ }
+
1;
-
- package My::Schema::Result::User::Admin;
-
- use strict;
- use warnings;
- use base qw/My::Schema::Result::User/;
-
- sub hello
- {
- print "I am an admin.\n";
- return;
- }
-
- sub do_admin_stuff
- {
- print "I am doing admin stuff\n";
- return ;
+
+ package My::Schema::Result::User::Admin;
+
+ use strict;
+ use warnings;
+ use base qw/My::Schema::Result::User/;
+
+ # This line is important
+ __PACKAGE__->table('users');
+
+ sub hello
+ {
+ print "I am an admin.\n";
+ return;
}
+ sub do_admin_stuff
+ {
+ print "I am doing admin stuff\n";
+ return ;
+ }
+
1;
-
-B<Test File> test.pl
-
- use warnings;
- use strict;
- use My::Schema;
-
- my $user_data = { email => 'someguy at place.com',
- password => 'pass1',
- admin => 0 };
-
- my $admin_data = { email => 'someadmin at adminplace.com',
- password => 'pass2',
- admin => 1 };
-
- my $schema = My::Schema->connection('dbi:Pg:dbname=test');
-
- $schema->resultset('User')->create( $user_data );
- $schema->resultset('User')->create( $admin_data );
-
- ### Now we search for them
- my $user = $schema->resultset('User')->single( $user_data );
- my $admin = $schema->resultset('User')->single( $admin_data );
-
- print ref $user, "\n";
- print ref $admin, "\n";
-
- print $user->password , "\n"; # pass1
- print $admin->password , "\n";# pass2; inherited from User
- print $user->hello , "\n";# I am a regular user.
- print $admin->hello, "\n";# I am an admin.
-
- ### The statement below will NOT print
- print "I can do admin stuff\n" if $user->can('do_admin_stuff');
- ### The statement below will print
- print "I can do admin stuff\n" if $admin->can('do_admin_stuff');
+B<Test File> test.pl
+
+ use warnings;
+ use strict;
+ use My::Schema;
+
+ my $user_data = { email => 'someguy at place.com',
+ password => 'pass1',
+ admin => 0 };
+
+ my $admin_data = { email => 'someadmin at adminplace.com',
+ password => 'pass2',
+ admin => 1 };
+
+ my $schema = My::Schema->connection('dbi:Pg:dbname=test');
+
+ $schema->resultset('User')->create( $user_data );
+ $schema->resultset('User')->create( $admin_data );
+
+ ### Now we search for them
+ my $user = $schema->resultset('User')->single( $user_data );
+ my $admin = $schema->resultset('User')->single( $admin_data );
+
+ print ref $user, "\n";
+ print ref $admin, "\n";
+
+ print $user->password , "\n"; # pass1
+ print $admin->password , "\n";# pass2; inherited from User
+ print $user->hello , "\n";# I am a regular user.
+ print $admin->hello, "\n";# I am an admin.
+
+ ### The statement below will NOT print
+ print "I can do admin stuff\n" if $user->can('do_admin_stuff');
+ ### The statement below will print
+ print "I can do admin stuff\n" if $admin->can('do_admin_stuff');
+
=head2 Skip row object creation for faster results
DBIx::Class is not built for speed, it's built for convenience and
ease of use, but sometimes you just need to get the data, and skip the
fancy objects.
-
+
To do this simply use L<DBIx::Class::ResultClass::HashRefInflator>.
-
+
my $rs = $schema->resultset('CD');
-
+
$rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
-
+
my $hash_ref = $rs->find(1);
Wasn't that easy?
@@ -957,7 +977,7 @@
my $rs = $schema->resultset('Items')->search(
{},
- {
+ {
select => [ { sum => 'Cost' } ],
as => [ 'total_cost' ], # remember this 'as' is for DBIx::Class::ResultSet not SQL
}
@@ -986,7 +1006,7 @@
print $c;
}
-C<ResultSetColumn> only has a limited number of built-in functions, if
+C<ResultSetColumn> only has a limited number of built-in functions. If
you need one that it doesn't have, then you can use the C<func> method
instead:
@@ -1001,7 +1021,7 @@
=head2 Creating a result set from a set of rows
-Sometimes you have a (set of) row objects that you want to put into a
+Sometimes you have a (set of) row objects that you want to put into a
resultset without the need to hit the DB again. You can do that by using the
L<set_cache|DBIx::Class::Resultset/set_cache> method:
@@ -1036,7 +1056,7 @@
=head2 Ordering a relationship result set
-If you always want a relation to be ordered, you can specify this when you
+If you always want a relation to be ordered, you can specify this when you
create the relationship.
To order C<< $book->pages >> by descending page_number, create the relation
@@ -1097,11 +1117,11 @@
package MyDatabase::Main::Artist;
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/PK::Auto Core/);
-
+
__PACKAGE__->table('database1.artist'); # will use "database1.artist" in FROM clause
-
- __PACKAGE__->add_columns(qw/ artistid name /);
- __PACKAGE__->set_primary_key('artistid');
+
+ __PACKAGE__->add_columns(qw/ artist_id name /);
+ __PACKAGE__->set_primary_key('artist_id');
__PACKAGE__->has_many('cds' => 'MyDatabase::Main::Cd');
1;
@@ -1120,16 +1140,16 @@
package MyDatabase::Schema;
use Moose;
-
+
extends 'DBIx::Class::Schema';
-
+
around connection => sub {
my ( $inner, $self, $dsn, $username, $pass, $attr ) = ( shift, @_ );
-
+
my $postfix = delete $attr->{schema_name_postfix};
-
+
$inner->(@_);
-
+
if ( $postfix ) {
$self->append_db_name($postfix);
}
@@ -1137,18 +1157,18 @@
sub append_db_name {
my ( $self, $postfix ) = @_;
-
- my @sources_with_db
- = grep
- { $_->name =~ /^\w+\./mx }
- map
- { $self->source($_) }
+
+ my @sources_with_db
+ = grep
+ { $_->name =~ /^\w+\./mx }
+ map
+ { $self->source($_) }
$self->sources;
-
+
foreach my $source (@sources_with_db) {
my $name = $source->name;
$name =~ s{^(\w+)\.}{${1}${postfix}\.}mx;
-
+
$source->name($name);
}
}
@@ -1160,17 +1180,17 @@
then simply iterate over all the Schema's ResultSources, renaming them as
needed.
-To use this facility, simply add or modify the \%attr hashref that is passed to
+To use this facility, simply add or modify the \%attr hashref that is passed to
L<connection|DBIx::Class::Schama/connect>, as follows:
- my $schema
+ my $schema
= MyDatabase::Schema->connect(
- $dsn,
- $user,
+ $dsn,
+ $user,
$pass,
{
schema_name_postfix => '_dev'
- # ... Other options as desired ...
+ # ... Other options as desired ...
})
Obviously, one could accomplish even more advanced mapping via a hash map or a
@@ -1216,14 +1236,14 @@
transactions (for databases that support them) will hopefully be added
in the future.
-=head1 SQL
+=head1 SQL
=head2 Creating Schemas From An Existing Database
-L<DBIx::Class::Schema::Loader> will connect to a database and create a
+L<DBIx::Class::Schema::Loader> will connect to a database and create a
L<DBIx::Class::Schema> and associated sources by examining the database.
-The recommend way of achieving this is to use the
+The recommend way of achieving this is to use the
L<make_schema_at|DBIx::Class::Schema::Loader/make_schema_at> method:
perl -MDBIx::Class::Schema::Loader=make_schema_at,dump_to_dir:./lib \
@@ -1285,7 +1305,7 @@
your database.
Make a table class as you would for any other table
-
+
package MyAppDB::Dual;
use strict;
use warnings;
@@ -1296,34 +1316,34 @@
"dummy",
{ data_type => "VARCHAR2", is_nullable => 0, size => 1 },
);
-
+
Once you've loaded your table class select from it using C<select>
and C<as> instead of C<columns>
-
+
my $rs = $schema->resultset('Dual')->search(undef,
{ select => [ 'sydate' ],
as => [ 'now' ]
},
);
-
+
All you have to do now is be careful how you access your resultset, the below
will not work because there is no column called 'now' in the Dual table class
-
+
while (my $dual = $rs->next) {
print $dual->now."\n";
}
# Can't locate object method "now" via package "MyAppDB::Dual" at headshot.pl line 23.
-
+
You could of course use 'dummy' in C<as> instead of 'now', or C<add_columns> to
your Dual class for whatever you wanted to select from dual, but that's just
silly, instead use C<get_column>
-
+
while (my $dual = $rs->next) {
print $dual->get_column('now')."\n";
}
-
+
Or use C<cursor>
-
+
my $cursor = $rs->cursor;
while (my @vals = $cursor->next) {
print $vals[0]."\n";
@@ -1340,48 +1360,48 @@
parser_args => { sources => [ grep $_ ne 'Dual', schema->sources ] },
};
$schema->create_ddl_dir( [qw/Oracle/], undef, './sql', undef, $sqlt_args );
-
+
Or use L<DBIx::Class::ResultClass::HashRefInflator>
-
+
$rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
while ( my $dual = $rs->next ) {
print $dual->{now}."\n";
}
-
+
Here are some example C<select> conditions to illustrate the different syntax
-you could use for doing stuff like
+you could use for doing stuff like
C<oracles.heavily(nested(functions_can('take', 'lots'), OF), 'args')>
-
+
# get a sequence value
select => [ 'A_SEQ.nextval' ],
-
+
# get create table sql
select => [ { 'dbms_metadata.get_ddl' => [ "'TABLE'", "'ARTIST'" ]} ],
-
+
# get a random num between 0 and 100
select => [ { "trunc" => [ { "dbms_random.value" => [0,100] } ]} ],
-
+
# what year is it?
select => [ { 'extract' => [ \'year from sysdate' ] } ],
-
+
# do some math
select => [ {'round' => [{'cos' => [ \'180 * 3.14159265359/180' ]}]}],
-
+
# which day of the week were you born on?
select => [{'to_char' => [{'to_date' => [ "'25-DEC-1980'", "'dd-mon-yyyy'" ]}, "'day'"]}],
-
+
# select 16 rows from dual
select => [ "'hello'" ],
as => [ 'world' ],
group_by => [ 'cube( 1, 2, 3, 4 )' ],
-
-
+
+
=head2 Adding Indexes And Functions To Your SQL
Often you will want indexes on columns on your table to speed up searching. To
-do this, create a method called C<sqlt_deploy_hook> in the relevant source
-class (refer to the advanced
+do this, create a method called C<sqlt_deploy_hook> in the relevant source
+class (refer to the advanced
L<callback system|DBIx::Class::ResultSource/sqlt_deploy_callback> if you wish
to share a hook between multiple sources):
@@ -1398,13 +1418,13 @@
1;
-Sometimes you might want to change the index depending on the type of the
+Sometimes you might want to change the index depending on the type of the
database for which SQL is being generated:
my ($db_type = $sqlt_table->schema->translator->producer_type)
=~ s/^SQL::Translator::Producer:://;
-You can also add hooks to the schema level to stop certain tables being
+You can also add hooks to the schema level to stop certain tables being
created:
package My::Schema;
@@ -1497,24 +1517,24 @@
Alternatively, you can send the conversion sql scripts to your
customers as above.
-=head2 Setting quoting for the generated SQL.
+=head2 Setting quoting for the generated SQL.
If the database contains column names with spaces and/or reserved words, they
need to be quoted in the SQL queries. This is done using:
- __PACKAGE__->storage->sql_maker->quote_char([ qw/[ ]/] );
- __PACKAGE__->storage->sql_maker->name_sep('.');
+ $schema->storage->sql_maker->quote_char([ qw/[ ]/] );
+ $schema->storage->sql_maker->name_sep('.');
The first sets the quote characters. Either a pair of matching
brackets, or a C<"> or C<'>:
-
- __PACKAGE__->storage->sql_maker->quote_char('"');
+ $schema->storage->sql_maker->quote_char('"');
+
Check the documentation of your database for the correct quote
characters to use. C<name_sep> needs to be set to allow the SQL
generator to put the quotes the correct place.
-In most cases you should set these as part of the arguments passed to
+In most cases you should set these as part of the arguments passed to
L<DBIx::Class::Schema/connect>:
my $schema = My::Schema->connect(
@@ -1527,6 +1547,17 @@
}
)
+In some cases, quoting will be required for all users of a schema. To enforce
+this, you can also overload the C<connection> method for your schema class:
+
+ sub connection {
+ my $self = shift;
+ my $rv = $self->next::method( @_ );
+ $rv->storage->sql_maker->quote_char([ qw/[ ]/ ]);
+ $rv->storage->sql_maker->name_sep('.');
+ return $rv;
+ }
+
=head2 Setting limit dialect for SQL::Abstract::Limit
In some cases, SQL::Abstract::Limit cannot determine the dialect of
@@ -1542,7 +1573,7 @@
The JDBC bridge is one way of getting access to a MSSQL server from a platform
that Microsoft doesn't deliver native client libraries for. (e.g. Linux)
-The limit dialect can also be set at connect time by specifying a
+The limit dialect can also be set at connect time by specifying a
C<limit_dialect> key in the final hash as shown above.
=head2 Working with PostgreSQL array types
@@ -1583,7 +1614,7 @@
arrayrefs together with the column name, like this: C<< [column_name => value]
>>.
-=head1 BOOTSTRAPPING/MIGRATING
+=head1 BOOTSTRAPPING/MIGRATING
=head2 Easy migration from class-based to schema-based setup
@@ -1594,10 +1625,10 @@
use MyDB;
use SQL::Translator;
-
+
my $schema = MyDB->schema_instance;
-
- my $translator = SQL::Translator->new(
+
+ my $translator = SQL::Translator->new(
debug => $debug || 0,
trace => $trace || 0,
no_comments => $no_comments || 0,
@@ -1611,13 +1642,13 @@
'prefix' => 'My::Schema',
},
);
-
+
$translator->parser('SQL::Translator::Parser::DBIx::Class');
$translator->producer('SQL::Translator::Producer::DBIx::Class::File');
-
+
my $output = $translator->translate(@args) or die
"Error: " . $translator->error;
-
+
print $output;
You could use L<Module::Find> to search for all subclasses in the MyDB::*
@@ -1646,16 +1677,16 @@
return $new;
}
-For more information about C<next::method>, look in the L<Class::C3>
+For more information about C<next::method>, look in the L<Class::C3>
documentation. See also L<DBIx::Class::Manual::Component> for more
ways to write your own base classes to do this.
People looking for ways to do "triggers" with DBIx::Class are probably
-just looking for this.
+just looking for this.
=head2 Changing one field whenever another changes
-For example, say that you have three columns, C<id>, C<number>, and
+For example, say that you have three columns, C<id>, C<number>, and
C<squared>. You would like to make changes to C<number> and have
C<squared> be automagically set to the value of C<number> squared.
You can accomplish this by overriding C<store_column>:
@@ -1673,7 +1704,7 @@
=head2 Automatically creating related objects
-You might have a class C<Artist> which has many C<CD>s. Further, if you
+You might have a class C<Artist> which has many C<CD>s. Further, you
want to create a C<CD> object every time you insert an C<Artist> object.
You can accomplish this by overriding C<insert> on your objects:
@@ -1870,7 +1901,7 @@
If this preamble is moved into a common base class:-
package MyDBICbase;
-
+
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/InflateColumn::DateTime Core/);
1;
@@ -1891,7 +1922,7 @@
to load the result classes. This will use L<Module::Find|Module::Find>
to find and load the appropriate modules. Explicitly defining the
classes you wish to load will remove the overhead of
-L<Module::Find|Module::Find> and the related directory operations:-
+L<Module::Find|Module::Find> and the related directory operations:
__PACKAGE__->load_classes(qw/ CD Artist Track /);
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Example.pod
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Example.pod 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Example.pod 2009-08-21 09:22:51 UTC (rev 7359)
@@ -43,7 +43,7 @@
CREATE TABLE artist (
artistid INTEGER PRIMARY KEY,
- name TEXT NOT NULL
+ name TEXT NOT NULL
);
CREATE TABLE cd (
@@ -60,7 +60,7 @@
and create the sqlite database file:
-sqlite3 example.db < example.sql
+ sqlite3 example.db < example.sql
=head3 Set up DBIx::Class::Schema
@@ -78,7 +78,7 @@
Then, create the following DBIx::Class::Schema classes:
MyDatabase/Main.pm:
-
+
package MyDatabase::Main;
use base qw/DBIx::Class::Schema/;
__PACKAGE__->load_namespaces;
@@ -90,7 +90,7 @@
package MyDatabase::Main::Result::Artist;
use base qw/DBIx::Class/;
- __PACKAGE__->load_components(qw/PK::Auto Core/);
+ __PACKAGE__->load_components(qw/Core/);
__PACKAGE__->table('artist');
__PACKAGE__->add_columns(qw/ artistid name /);
__PACKAGE__->set_primary_key('artistid');
@@ -103,7 +103,7 @@
package MyDatabase::Main::Result::Cd;
use base qw/DBIx::Class/;
- __PACKAGE__->load_components(qw/PK::Auto Core/);
+ __PACKAGE__->load_components(qw/Core/);
__PACKAGE__->table('cd');
__PACKAGE__->add_columns(qw/ cdid artist title/);
__PACKAGE__->set_primary_key('cdid');
@@ -117,7 +117,7 @@
package MyDatabase::Main::Result::Track;
use base qw/DBIx::Class/;
- __PACKAGE__->load_components(qw/PK::Auto Core/);
+ __PACKAGE__->load_components(qw/Core/);
__PACKAGE__->table('track');
__PACKAGE__->add_columns(qw/ trackid cd title/);
__PACKAGE__->set_primary_key('trackid');
@@ -137,7 +137,7 @@
my $schema = MyDatabase::Main->connect('dbi:SQLite:db/example.db');
- # here's some of the sql that is going to be generated by the schema
+ # here's some of the SQL that is going to be generated by the schema
# INSERT INTO artist VALUES (NULL,'Michael Jackson');
# INSERT INTO artist VALUES (NULL,'Eminem');
@@ -248,8 +248,8 @@
}
print "\n";
}
-
-
+
+
sub get_cd_by_track {
my $tracktitle = shift;
print "get_cd_by_track($tracktitle):\n";
@@ -264,7 +264,7 @@
my $cd = $rs->first;
print $cd->title . "\n\n";
}
-
+
sub get_cds_by_artist {
my $artistname = shift;
print "get_cds_by_artist($artistname):\n";
@@ -349,20 +349,20 @@
A reference implentation of the database and scripts in this example
are available in the main distribution for DBIx::Class under the
-directory t/examples/Schema
+directory F<t/examples/Schema>.
With these scripts we're relying on @INC looking in the current
working directory. You may want to add the MyDatabase namespaces to
@INC in a different way when it comes to deployment.
-The testdb.pl script is an excellent start for testing your database
+The F<testdb.pl> script is an excellent start for testing your database
model.
-This example uses load_namespaces to load in the appropriate Row classes
-from the MyDatabase::Main::Result namespace, and any required resultset
-classes from the MyDatabase::Main::ResultSet namespace (although we
-created the directory in the directions above we did not add, or need to
-add, any resultset classes).
+This example uses L<DBIx::Class::Schema/load_namespaces> to load in the
+appropriate L<Row|DBIx::Class::Row> classes from the MyDatabase::Main::Result namespace,
+and any required resultset classes from the MyDatabase::Main::ResultSet
+namespace (although we created the directory in the directions above we
+did not add, or need to add, any resultset classes).
=head1 TODO
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/FAQ.pod
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/FAQ.pod 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/FAQ.pod 2009-08-21 09:22:51 UTC (rev 7359)
@@ -87,7 +87,7 @@
to connect with rights to read/write all the schemas/tables as
necessary.
-=back
+=back
=head2 Relationships
@@ -112,7 +112,7 @@
Create a C<belongs_to> relationship for the field containing the
foreign key. See L<DBIx::Class::Relationship/belongs_to>.
-=item .. define a foreign key relationship where the key field may contain NULL?
+=item .. define a foreign key relationship where the key field may contain NULL?
Just create a C<belongs_to> relationship, as above. If the column is
NULL then the inflation to the foreign object will not happen. This
@@ -307,8 +307,8 @@
=item .. fetch a whole column of data instead of a row?
-Call C<get_column> on a L<DBIx::Class::ResultSet>, this returns a
-L<DBIx::Class::ResultSetColumn>, see it's documentation and the
+Call C<get_column> on a L<DBIx::Class::ResultSet>. This returns a
+L<DBIx::Class::ResultSetColumn>. See its documentation and the
L<Cookbook|DBIx::Class::Manual::Cookbook> for details.
=item .. fetch a formatted column?
@@ -324,22 +324,17 @@
=item .. fetch a single (or topmost) row?
-Sometimes you many only want a single record back from a search. A quick
-way to get that single row is to first run your search as usual:
+See L<DBIx::Class::Manual::Cookbook/Retrieve_one_and_only_one_row_from_a_resultset>.
- ->search->(undef, { order_by => "id DESC" })
+A less readable way is to ask a regular search to return 1 row, using
+L<DBIx::Class::ResultSet/slice>:
-Then call L<DBIx::Class::ResultSet/slice> and ask it only to return 1 row:
-
- ->slice(0)
-
-These two calls can be combined into a single statement:
-
->search->(undef, { order_by => "id DESC" })->slice(0)
-Why slice instead of L<DBIx::Class::ResultSet/first> or L<DBIx::Class::ResultSet/single>?
-If supported by the database, slice will use LIMIT/OFFSET to hint to the database that we
-really only need one row. This can result in a significant speed improvement.
+which (if supported by the database) will use LIMIT/OFFSET to hint to the
+database that we really only need one row. This can result in a significant
+speed improvement. The method using L<DBIx::Class::ResultSet/single> mentioned
+in the cookbook can do the same if you pass a C<rows> attribute to the search.
=item .. refresh a row from storage?
@@ -410,17 +405,17 @@
But note that when using a scalar reference the column in the database
will be updated but when you read the value from the object with e.g.
-
+
->somecolumn()
-
+
you still get back the scalar reference to the string, B<not> the new
value in the database. To get that you must refresh the row from storage
using C<discard_changes()>. Or chain your function calls like this:
->update->discard_changes
-
- to update the database and refresh the object in one step.
-
+
+to update the database and refresh the object in one step.
+
=item .. store JSON/YAML in a column and have it deflate/inflate automatically?
You can use L<DBIx::Class::InflateColumn> to accomplish YAML/JSON storage transparently.
@@ -474,7 +469,7 @@
package MyTable;
use Moose; # import Moose
- use Moose::Util::TypeConstraint; # import Moose accessor type constraints
+ use Moose::Util::TypeConstraint; # import Moose accessor type constraints
extends 'DBIx::Class'; # Moose changes the way we define our parent (base) package
@@ -486,7 +481,7 @@
my $row;
- # assume that some where in here $row will get assigned to a MyTable row
+ # assume that somewhere in here $row will get assigned to a MyTable row
$row->non_column_data('some string'); # would set the non_column_data accessor
@@ -494,7 +489,7 @@
$row->update(); # would not inline the non_column_data accessor into the update
-
+
=item How do I use DBIx::Class objects in my TT templates?
Like normal objects, mostly. However you need to watch out for TT
@@ -536,7 +531,7 @@
=item How do I reduce the overhead of database queries?
You can reduce the overhead of object creation within L<DBIx::Class>
-using the tips in L<DBIx::Class::Manual::Cookbook/"Skip row object creation for faster results">
+using the tips in L<DBIx::Class::Manual::Cookbook/"Skip row object creation for faster results">
and L<DBIx::Class::Manual::Cookbook/"Get raw data for blindingly fast results">
=back
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Intro.pod
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Intro.pod 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Intro.pod 2009-08-21 09:22:51 UTC (rev 7359)
@@ -11,7 +11,7 @@
=head1 THE DBIx::Class WAY
Here are a few simple tips that will help you get your bearings with
-DBIx::Class.
+DBIx::Class.
=head2 Tables become Result classes
@@ -29,7 +29,7 @@
=head2 It's all about the ResultSet
So, we've got some ResultSources defined. Now, we want to actually use those
-definitions to help us translate the queries we need into handy perl objects!
+definitions to help us translate the queries we need into handy perl objects!
Let's say we defined a ResultSource for an "album" table with three columns:
"albumid", "artist", and "title". Any time we want to query this table, we'll
@@ -39,18 +39,18 @@
SELECT albumid, artist, title FROM album;
Would be retrieved by creating a ResultSet object from the album table's
-ResultSource, likely by using the "search" method.
+ResultSource, likely by using the "search" method.
DBIx::Class doesn't limit you to creating only simple ResultSets -- if you
wanted to do something like:
SELECT title FROM album GROUP BY title;
-You could easily achieve it.
+You could easily achieve it.
-The important thing to understand:
+The important thing to understand:
- Any time you would reach for a SQL query in DBI, you are
+ Any time you would reach for a SQL query in DBI, you are
creating a DBIx::Class::ResultSet.
=head2 Search is like "prepare"
@@ -109,13 +109,10 @@
Load any components required by each class with the load_components() method.
This should consist of "Core" plus any additional components you want to use.
-For example, if you want serial/auto-incrementing primary keys:
+For example, if you want to force columns to use UTF-8 encoding:
- __PACKAGE__->load_components(qw/ PK::Auto Core /);
+ __PACKAGE__->load_components(qw/ ForceUTF8 Core /);
-C<PK::Auto> is supported for many databases; see L<DBIx::Class::Storage::DBI>
-for more information.
-
Set the table for your class:
__PACKAGE__->table('album');
@@ -142,7 +139,7 @@
is_auto_increment => 0,
default_value => '',
},
- title =>
+ title =>
{ data_type => 'varchar',
size => 256,
is_nullable => 0,
@@ -176,7 +173,8 @@
make a predefined accessor for fetching objects that contain this Table's
foreign key:
- __PACKAGE__->has_many('albums', 'My::Schema::Result::Artist', 'album_id');
+ # in My::Schema::Result::Artist
+ __PACKAGE__->has_many('albums', 'My::Schema::Result::Album', 'artist');
See L<DBIx::Class::Relationship> for more information about the various types of
available relationships and how you can design your own.
@@ -202,9 +200,13 @@
=head2 Connecting
-To connect to your Schema, you need to provide the connection details. The
-arguments are the same as for L<DBI/connect>:
+To connect to your Schema, you need to provide the connection details or a
+database handle.
+=head3 Via connection details
+
+The arguments are the same as for L<DBI/connect>:
+
my $schema = My::Schema->connect('dbi:SQLite:/home/me/myapp/my.db');
You can create as many different schema instances as you need. So if you have a
@@ -229,6 +231,16 @@
See L<DBIx::Class::Schema::Storage::DBI/connect_info> for more information about
this and other special C<connect>-time options.
+=head3 Via a database handle
+
+The supplied coderef is expected to return a single connected database handle
+(e.g. a L<DBI> C<$dbh>)
+
+ my $schema = My::Schema->connect (
+ sub { Some::DBH::Factory->connect },
+ \%extra_attrs,
+ );
+
=head2 Basic usage
Once you've defined the basic classes, either manually or using
@@ -255,8 +267,8 @@
$album->set_column('title', 'Presence');
$title = $album->get_column('title');
-Just like with L<Class::DBI>, you call C<update> to commit your changes to the
-database:
+Just like with L<Class::DBI>, you call C<update> to save your changes to the
+database (by executing the actual C<UPDATE> statement):
$album->update;
@@ -273,7 +285,7 @@
returns an instance of C<My::Schema::Result::Album> that can be used to access the data
in the new record:
- my $new_album = $schema->resultset('Album')->create({
+ my $new_album = $schema->resultset('Album')->create({
title => 'Wish You Were Here',
artist => 'Pink Floyd'
});
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Troubleshooting.pod
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Troubleshooting.pod 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Manual/Troubleshooting.pod 2009-08-21 09:22:51 UTC (rev 7359)
@@ -17,11 +17,11 @@
Alternatively use the C<< storage->debug >> class method:-
- $class->storage->debug(1);
+ $schema->storage->debug(1);
To send the output somewhere else set debugfh:-
- $class->storage->debugfh(IO::File->new('/tmp/trace.out', 'w');
+ $schema->storage->debugfh(IO::File->new('/tmp/trace.out', 'w');
Alternatively you can do this with the environment variable too:-
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Ordered.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Ordered.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Ordered.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -60,20 +60,20 @@
#!/use/bin/perl
use My::Item;
-
+
my $item = My::Item->create({ name=>'Matt S. Trout' });
# If using grouping_column:
my $item = My::Item->create({ name=>'Matt S. Trout', group_id=>1 });
-
+
my $rs = $item->siblings();
my @siblings = $item->siblings();
-
+
my $sibling;
$sibling = $item->first_sibling();
$sibling = $item->last_sibling();
$sibling = $item->previous_sibling();
$sibling = $item->next_sibling();
-
+
$item->move_previous();
$item->move_next();
$item->move_first();
@@ -272,14 +272,14 @@
return defined $lsib ? $lsib : 0;
}
-# an optimised method to get the last sibling position without inflating a row object
-sub _last_sibling_pos {
+# an optimized method to get the last sibling position value without inflating a row object
+sub _last_sibling_posval {
my $self = shift;
my $position_column = $self->position_column;
my $cursor = $self->next_siblings->search(
{},
- { rows => 1, order_by => { '-desc' => $position_column }, columns => $position_column },
+ { rows => 1, order_by => { '-desc' => $position_column }, select => $position_column },
)->cursor;
my ($pos) = $cursor->next;
@@ -313,7 +313,7 @@
sub move_next {
my $self = shift;
- return 0 unless $self->next_siblings->count;
+ return 0 unless defined $self->_last_sibling_posval; # quick way to check for no more siblings
return $self->move_to ($self->_position + 1);
}
@@ -341,7 +341,11 @@
sub move_last {
my $self = shift;
- return $self->move_to( $self->_group_rs->count );
+ my $last_posval = $self->_last_sibling_posval;
+
+ return 0 unless defined $last_posval;
+
+ return $self->move_to( $self->_position_from_value ($last_posval) );
}
=head2 move_to
@@ -358,38 +362,58 @@
my( $self, $to_position ) = @_;
return 0 if ( $to_position < 1 );
- my $from_position = $self->_position;
- return 0 if ( $from_position == $to_position );
-
my $position_column = $self->position_column;
- {
- my $guard = $self->result_source->schema->txn_scope_guard;
+ my $guard;
- my ($direction, @between);
- if ( $from_position < $to_position ) {
- $direction = -1;
- @between = map { $self->_position_value ($_) } ( $from_position + 1, $to_position );
- }
- else {
- $direction = 1;
- @between = map { $self->_position_value ($_) } ( $to_position, $from_position - 1 );
- }
+ if ($self->is_column_changed ($position_column) ) {
+ # something changed our position, we have no idea where we
+ # used to be - requery without using discard_changes
+ # (we need only a specific column back)
- my $new_pos_val = $self->_position_value ($to_position); # record this before the shift
+ $guard = $self->result_source->schema->txn_scope_guard;
- # we need to null-position the moved row if the position column is part of a constraint
- if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $self->result_source->unique_constraints }} ) ) ) {
- $self->_ordered_internal_update({ $position_column => $self->null_position_value });
- }
+ my $cursor = $self->result_source->resultset->search(
+ $self->ident_condition,
+ { select => $position_column },
+ )->cursor;
- $self->_shift_siblings ($direction, @between);
- $self->_ordered_internal_update({ $position_column => $new_pos_val });
+ my ($pos) = $cursor->next;
+ $self->$position_column ($pos);
+ delete $self->{_dirty_columns}{$position_column};
+ }
- $guard->commit;
+ my $from_position = $self->_position;
- return 1;
+ if ( $from_position == $to_position ) { # FIXME this will not work for non-numeric order
+ $guard->commit if $guard;
+ return 0;
}
+
+ $guard ||= $self->result_source->schema->txn_scope_guard;
+
+ my ($direction, @between);
+ if ( $from_position < $to_position ) {
+ $direction = -1;
+ @between = map { $self->_position_value ($_) } ( $from_position + 1, $to_position );
+ }
+ else {
+ $direction = 1;
+ @between = map { $self->_position_value ($_) } ( $to_position, $from_position - 1 );
+ }
+
+ my $new_pos_val = $self->_position_value ($to_position); # record this before the shift
+
+ # we need to null-position the moved row if the position column is part of a constraint
+ if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $self->result_source->unique_constraints }} ) ) ) {
+ $self->_ordered_internal_update({ $position_column => $self->null_position_value });
+ }
+
+ $self->_shift_siblings ($direction, @between);
+ $self->_ordered_internal_update({ $position_column => $new_pos_val });
+
+ $guard->commit;
+ return 1;
}
=head2 move_to_group
@@ -424,40 +448,72 @@
my $position_column = $self->position_column;
return 0 if ( defined($to_position) and $to_position < 1 );
+
+ # check if someone changed the _grouping_columns - this will
+ # prevent _is_in_group working, so we need to requery the db
+ # for the original values
+ my (@dirty_cols, %values, $guard);
+ for ($self->_grouping_columns) {
+ $values{$_} = $self->get_column ($_);
+ push @dirty_cols, $_ if $self->is_column_changed ($_);
+ }
+
+ # re-query only the dirty columns, and restore them on the
+ # object (subsequent code will update them to the correct
+ # after-move values)
+ if (@dirty_cols) {
+ $guard = $self->result_source->schema->txn_scope_guard;
+
+ my $cursor = $self->result_source->resultset->search(
+ $self->ident_condition,
+ { select => \@dirty_cols },
+ )->cursor;
+
+ my @original_values = $cursor->next;
+ $self->set_inflated_columns ({ %values, map { $_ => shift @original_values } (@dirty_cols) });
+ delete $self->{_dirty_columns}{$_} for (@dirty_cols);
+ }
+
if ($self->_is_in_group ($to_group) ) {
- return 0 if not defined $to_position;
- return $self->move_to ($to_position);
+ my $ret;
+ if (defined $to_position) {
+ $ret = $self->move_to ($to_position);
+ }
+
+ $guard->commit if $guard;
+ return $ret||0;
}
- {
- my $guard = $self->result_source->schema->txn_scope_guard;
+ $guard ||= $self->result_source->schema->txn_scope_guard;
- # Move to end of current group to adjust siblings
- $self->move_last;
+ # Move to end of current group to adjust siblings
+ $self->move_last;
- $self->set_inflated_columns({ %$to_group, $position_column => undef });
- my $new_group_count = $self->_group_rs->count;
+ $self->set_inflated_columns({ %$to_group, $position_column => undef });
+ my $new_group_last_posval = $self->_last_sibling_posval;
+ my $new_group_last_position = $self->_position_from_value (
+ $new_group_last_posval
+ );
- if ( not defined($to_position) or $to_position > $new_group_count) {
- $self->set_column(
- $position_column => $new_group_count
- ? $self->_next_position_value ( $self->_last_sibling_pos )
- : $self->_initial_position_value
- );
- }
- else {
- my $bumped_pos_val = $self->_position_value ($to_position);
- my @between = ($to_position, $new_group_count);
- $self->_shift_siblings (1, @between); #shift right
- $self->set_column( $position_column => $bumped_pos_val );
- }
+ if ( not defined($to_position) or $to_position > $new_group_last_position) {
+ $self->set_column(
+ $position_column => $new_group_last_position
+ ? $self->_next_position_value ( $new_group_last_posval )
+ : $self->_initial_position_value
+ );
+ }
+ else {
+ my $bumped_pos_val = $self->_position_value ($to_position);
+ my @between = ($to_position, $new_group_last_position);
+ $self->_shift_siblings (1, @between); #shift right
+ $self->set_column( $position_column => $bumped_pos_val );
+ }
- $self->_ordered_internal_update;
+ $self->_ordered_internal_update;
- $guard->commit;
+ $guard->commit;
- return 1;
- }
+ return 1;
}
=head2 insert
@@ -473,10 +529,10 @@
my $position_column = $self->position_column;
unless ($self->get_column($position_column)) {
- my $lsib_pos = $self->_last_sibling_pos;
+ my $lsib_posval = $self->_last_sibling_posval;
$self->set_column(
- $position_column => (defined $lsib_pos
- ? $self->_next_position_value ( $lsib_pos )
+ $position_column => (defined $lsib_posval
+ ? $self->_next_position_value ( $lsib_posval )
: $self->_initial_position_value
)
);
@@ -501,16 +557,47 @@
# this is set by _ordered_internal_update()
return $self->next::method(@_) if $self->{_ORDERED_INTERNAL_UPDATE};
- my $upd = shift;
- $self->set_inflated_columns($upd) if $upd;
- my %changes = $self->get_dirty_columns;
- $self->discard_changes;
-
my $position_column = $self->position_column;
+ my @ordering_columns = ($self->_grouping_columns, $position_column);
+
+ # these steps are necessary to keep the external appearance of
+ # ->update($upd) so that other things overloading update() will
+ # work properly
+ my %original_values = $self->get_columns;
+ my %existing_changes = $self->get_dirty_columns;
+
+ # See if any of the *supplied* changes would affect the ordering
+ # The reason this is so contrived, is that we want to leverage
+ # the datatype aware value comparing, while at the same time
+ # keep the original value intact (it will be updated later by the
+ # corresponding routine)
+
+ my %upd = %{shift || {}};
+ my %changes = %existing_changes;
+
+ for (@ordering_columns) {
+ next unless exists $upd{$_};
+
+ # we do not want to keep propagating this to next::method
+ # as it will be a done deal by the time get there
+ my $value = delete $upd{$_};
+ $self->set_inflated_columns ({ $_ => $value });
+
+ # see if an update resulted in a dirty column
+ # it is important to preserve the old value, as it
+ # will be needed to carry on a successfull move()
+ # operation without re-querying the database
+ if ($self->is_column_changed ($_) && not exists $existing_changes{$_}) {
+ $changes{$_} = $value;
+ $self->set_inflated_columns ({ $_ => $original_values{$_} });
+ delete $self->{_dirty_columns}{$_};
+ }
+ }
+
# if nothing group/position related changed - short circuit
- if (not grep { exists $changes{$_} } ($self->_grouping_columns, $position_column) ) {
- return $self->next::method( \%changes, @_ );
+ if (not grep { exists $changes{$_} } ( @ordering_columns ) ) {
+ return $self->next::method( \%upd, @_ );
}
{
@@ -522,37 +609,37 @@
# create new_group by taking the current group and inserting changes
my $new_group = {$self->_grouping_clause};
foreach my $col (keys %$new_group) {
- if (exists $changes{$col}) {
- $new_group->{$col} = delete $changes{$col}; # don't want to pass this on to next::method
- }
+ $new_group->{$col} = $changes{$col} if exists $changes{$col};
}
$self->move_to_group(
$new_group,
(exists $changes{$position_column}
- # The FIXME bit contradicts the documentation: when changing groups without supplying explicit
- # positions in move_to_group(), we push the item to the end of the group.
- # However when I was rewriting this, the position from the old group was clearly passed to the new one
+ # The FIXME bit contradicts the documentation: POD states that
+ # when changing groups without supplying explicit positions in
+ # move_to_group(), we push the item to the end of the group.
+ # However when I was rewriting this, the position from the old
+ # group was clearly passed to the new one
# Probably needs to go away (by ribasushi)
- ? delete $changes{$position_column} # means there was a position change supplied with the update too
- : $self->_position # FIXME!
+ ? $changes{$position_column} # means there was a position change supplied with the update too
+ : $self->_position # FIXME! (replace with undef)
),
);
}
elsif (exists $changes{$position_column}) {
- $self->move_to(delete $changes{$position_column});
+ $self->move_to($changes{$position_column});
}
my @res;
my $want = wantarray();
if (not defined $want) {
- $self->next::method( \%changes, @_ );
+ $self->next::method( \%upd, @_ );
}
elsif ($want) {
- @res = $self->next::method( \%changes, @_ );
+ @res = $self->next::method( \%upd, @_ );
}
else {
- $res[0] = $self->next::method( \%changes, @_ );
+ $res[0] = $self->next::method( \%upd, @_ );
}
$guard->commit;
@@ -616,6 +703,27 @@
return $self->get_column ($self->position_column);
}
+=head2 _position_from_value
+
+ my $num_pos = $item->_position_of_value ( $pos_value )
+
+Returns the B<absolute numeric position> of an object with a B<position
+value> set to C<$pos_value>. By default simply returns C<$pos_value>.
+
+=cut
+sub _position_from_value {
+ my ($self, $val) = @_;
+
+ return 0 unless defined $val;
+
+# #the right way to do this
+# return $self -> _group_rs
+# -> search({ $self->position_column => { '<=', $val } })
+# -> count
+
+ return $val;
+}
+
=head2 _position_value
my $pos_value = $item->_position_value ( $pos )
@@ -762,8 +870,8 @@
=head2 _grouping_clause
This method returns one or more name=>value pairs for limiting a search
-by the grouping column(s). If the grouping column is not
-defined then this will return an empty list.
+by the grouping column(s). If the grouping column is not defined then
+this will return an empty list.
=cut
sub _grouping_clause {
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/PK.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/PK.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/PK.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -20,45 +20,6 @@
=cut
-sub _ident_values {
- my ($self) = @_;
- return (map { $self->{_column_data}{$_} } $self->primary_columns);
-}
-
-=head2 discard_changes ($attrs)
-
-Re-selects the row from the database, losing any changes that had
-been made.
-
-This method can also be used to refresh from storage, retrieving any
-changes made since the row was last read from storage.
-
-$attrs is expected to be a hashref of attributes suitable for passing as the
-second argument to $resultset->search($cond, $attrs);
-
-=cut
-
-sub discard_changes {
- my ($self, $attrs) = @_;
- delete $self->{_dirty_columns};
- return unless $self->in_storage; # Don't reload if we aren't real!
-
- if( my $current_storage = $self->get_from_storage($attrs)) {
-
- # Set $self to the current.
- %$self = %$current_storage;
-
- # Avoid a possible infinite loop with
- # sub DESTROY { $_[0]->discard_changes }
- bless $current_storage, 'Do::Not::Exist';
-
- return $self;
- } else {
- $self->in_storage(0);
- return $self;
- }
-}
-
=head2 id
Returns the primary key(s) for a row. Can't be called as
@@ -74,12 +35,28 @@
return (wantarray ? @pk : $pk[0]);
}
+sub _ident_values {
+ my ($self) = @_;
+ return (map { $self->{_column_data}{$_} } $self->primary_columns);
+}
+
=head2 ID
Returns a unique id string identifying a row object by primary key.
Used by L<DBIx::Class::CDBICompat::LiveObjectIndex> and
L<DBIx::Class::ObjectCache>.
+=over
+
+=item WARNING
+
+The default C<_create_ID> method used by this function orders the returned
+values by the alphabetical order of the primary column names, B<unlike>
+the L</id> method, which follows the same order in which columns were fed
+to L<DBIx::Class::ResultSource/set_primary_key>.
+
+=back
+
=cut
sub ID {
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/Accessor.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/Accessor.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/Accessor.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -6,6 +6,11 @@
use Sub::Name ();
use Class::Inspector ();
+our %_pod_inherit_config =
+ (
+ class_map => { 'DBIx::Class::Relationship::Accessor' => 'DBIx::Class::Relationship' }
+ );
+
sub register_relationship {
my ($class, $rel, $info) = @_;
if (my $acc_type = $info->{attrs}{accessor}) {
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/Base.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/Base.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/Base.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -83,18 +83,18 @@
An arrayref containing a list of accessors in the foreign class to create in
the main class. If, for example, you do the following:
-
+
MyDB::Schema::CD->might_have(liner_notes => 'MyDB::Schema::LinerNotes',
undef, {
proxy => [ qw/notes/ ],
});
-
+
Then, assuming MyDB::Schema::LinerNotes has an accessor named notes, you can do:
my $cd = MyDB::Schema::CD->find(1);
$cd->notes('Notes go here'); # set notes -- LinerNotes object is
# created if it doesn't exist
-
+
=item accessor
Specifies the type of accessor that should be created for the relationship.
@@ -176,13 +176,13 @@
$self->throw_exception("Can't call *_related as class methods")
unless ref $self;
my $rel = shift;
- my $rel_obj = $self->relationship_info($rel);
+ my $rel_info = $self->relationship_info($rel);
$self->throw_exception( "No such relationship ${rel}" )
- unless $rel_obj;
-
+ unless $rel_info;
+
return $self->{related_resultsets}{$rel} ||= do {
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
- $attrs = { %{$rel_obj->{attrs} || {}}, %$attrs };
+ $attrs = { %{$rel_info->{attrs} || {}}, %$attrs };
$self->throw_exception( "Invalid query: @_" )
if (@_ > 1 && (@_ % 2 == 1));
@@ -190,7 +190,7 @@
my $source = $self->result_source;
my $cond = $source->_resolve_condition(
- $rel_obj->{cond}, $rel, $self
+ $rel_info->{cond}, $rel, $self
);
if ($cond eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
my $reverse = $source->reverse_relationship_info($rel);
@@ -390,22 +390,22 @@
sub set_from_related {
my ($self, $rel, $f_obj) = @_;
- my $rel_obj = $self->relationship_info($rel);
- $self->throw_exception( "No such relationship ${rel}" ) unless $rel_obj;
- my $cond = $rel_obj->{cond};
+ my $rel_info = $self->relationship_info($rel);
+ $self->throw_exception( "No such relationship ${rel}" ) unless $rel_info;
+ my $cond = $rel_info->{cond};
$self->throw_exception(
"set_from_related can only handle a hash condition; the ".
"condition for $rel is of type ".
(ref $cond ? ref $cond : 'plain scalar')
) unless ref $cond eq 'HASH';
if (defined $f_obj) {
- my $f_class = $rel_obj->{class};
+ my $f_class = $rel_info->{class};
$self->throw_exception( "Object $f_obj isn't a ".$f_class )
unless Scalar::Util::blessed($f_obj) and $f_obj->isa($f_class);
}
$self->set_columns(
$self->result_source->_resolve_condition(
- $rel_obj->{cond}, $f_obj, $rel));
+ $rel_info->{cond}, $f_obj, $rel));
return 1;
}
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/BelongsTo.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/BelongsTo.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/BelongsTo.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -7,6 +7,11 @@
use strict;
use warnings;
+our %_pod_inherit_config =
+ (
+ class_map => { 'DBIx::Class::Relationship::BelongsTo' => 'DBIx::Class::Relationship' }
+ );
+
sub belongs_to {
my ($class, $rel, $f_class, $cond, $attrs) = @_;
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/CascadeActions.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/CascadeActions.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/CascadeActions.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -4,6 +4,11 @@
use strict;
use warnings;
+our %_pod_inherit_config =
+ (
+ class_map => { 'DBIx::Class::Relationship::CascadeActions' => 'DBIx::Class::Relationship' }
+ );
+
sub delete {
my ($self, @rest) = @_;
return $self->next::method(@rest) unless ref $self;
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/HasMany.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/HasMany.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/HasMany.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -4,6 +4,11 @@
use strict;
use warnings;
+our %_pod_inherit_config =
+ (
+ class_map => { 'DBIx::Class::Relationship::HasMany' => 'DBIx::Class::Relationship' }
+ );
+
sub has_many {
my ($class, $rel, $f_class, $cond, $attrs) = @_;
@@ -35,7 +40,7 @@
$class->throw_exception(
"No such column ${f_key} on foreign class ${f_class} ($guess)"
) if $f_class_loaded && !$f_class->has_column($f_key);
-
+
$cond = { "foreign.${f_key}" => "self.${pri}" };
}
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/HasOne.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/HasOne.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/HasOne.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -4,6 +4,11 @@
use strict;
use warnings;
+our %_pod_inherit_config =
+ (
+ class_map => { 'DBIx::Class::Relationship::HasOne' => 'DBIx::Class::Relationship' }
+ );
+
sub might_have {
shift->_has_one('LEFT' => @_);
}
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/ManyToMany.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/ManyToMany.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/ManyToMany.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -7,6 +7,11 @@
use Carp::Clan qw/^DBIx::Class/;
use Sub::Name ();
+our %_pod_inherit_config =
+ (
+ class_map => { 'DBIx::Class::Relationship::ManyToMany' => 'DBIx::Class::Relationship' }
+ );
+
sub many_to_many {
my ($class, $meth, $rel, $f_rel, $rel_attrs) = @_;
@@ -107,7 +112,14 @@
"{$set_meth} needs a list of objects or hashrefs"
);
my @to_set = (ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_);
- $self->search_related($rel, {})->delete;
+ # if there is a where clause in the attributes, ensure we only delete
+ # rows that are within the where restriction
+ if ($rel_attrs && $rel_attrs->{where}) {
+ $self->search_related( $rel, $rel_attrs->{where},{join => $f_rel})->delete;
+ } else {
+ $self->search_related( $rel, {} )->delete;
+ }
+ # add in the set rel objects
$self->$add_meth($_, ref($_[1]) ? $_[1] : {}) for (@to_set);
};
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/ProxyMethods.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/ProxyMethods.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship/ProxyMethods.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -6,6 +6,11 @@
use Sub::Name ();
use base qw/DBIx::Class/;
+our %_pod_inherit_config =
+ (
+ class_map => { 'DBIx::Class::Relationship::ProxyMethods' => 'DBIx::Class::Relationship' }
+ );
+
sub register_relationship {
my ($class, $rel, $info) = @_;
if (my $proxy_list = $info->{attrs}{proxy}) {
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Relationship.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -106,7 +106,7 @@
All helper methods are called similar to the following template:
__PACKAGE__->$method_name('relname', 'Foreign::Class', \%cond | \@cond, \%attrs);
-
+
Both C<$cond> and C<$attrs> are optional. Pass C<undef> for C<$cond> if
you want to use the default value for it, but still want to set C<\%attrs>.
@@ -297,7 +297,7 @@
'My::DBIC::Schema::Book',
{ 'foreign.author_id' => 'self.id' },
);
-
+
# OR (similar result, assuming related_class is storing our PK, in "author")
# (the "author" is guessed at from "Author" in the class namespace)
My::DBIC::Schema::Author->has_many(
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSet.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSet.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -513,6 +513,14 @@
my $unique_query = $self->_build_unique_query($input_query, \@unique_cols);
$query = $self->_add_alias($unique_query, $alias);
}
+ elsif ($self->{attrs}{accessor} and $self->{attrs}{accessor} eq 'single') {
+ # This means that we got here after a merger of relationship conditions
+ # in ::Relationship::Base::search_related (the row method), and furthermore
+ # the relationship is of the 'single' type. This means that the condition
+ # provided by the relationship (already attached to $self) is sufficient,
+ # as there can be only one row in the databse that would satisfy the
+ # relationship
+ }
else {
my @unique_queries = $self->_unique_queries($input_query, $attrs);
$query = @unique_queries
@@ -521,27 +529,14 @@
}
# Run the query
- if (keys %$attrs) {
- my $rs = $self->search($query, $attrs);
- if (keys %{$rs->_resolved_attrs->{collapse}}) {
- my $row = $rs->next;
- carp "Query returned more than one row" if $rs->next;
- return $row;
- }
- else {
- return $rs->single;
- }
+ my $rs = $self->search ($query, $attrs);
+ if (keys %{$rs->_resolved_attrs->{collapse}}) {
+ my $row = $rs->next;
+ carp "Query returned more than one row" if $rs->next;
+ return $row;
}
else {
- if (keys %{$self->_resolved_attrs->{collapse}}) {
- my $rs = $self->search($query);
- my $row = $rs->next;
- carp "Query returned more than one row" if $rs->next;
- return $row;
- }
- else {
- return $self->single($query);
- }
+ return $rs->single;
}
}
@@ -962,7 +957,9 @@
sub _construct_object {
my ($self, @row) = @_;
- my $info = $self->_collapse_result($self->{_attrs}{as}, \@row);
+
+ my $info = $self->_collapse_result($self->{_attrs}{as}, \@row)
+ or return ();
my @new = $self->result_class->inflate_result($self->result_source, @$info);
@new = $self->{_attrs}{record_filter}->(@new)
if exists $self->{_attrs}{record_filter};
@@ -972,6 +969,19 @@
sub _collapse_result {
my ($self, $as_proto, $row) = @_;
+ # if the first row that ever came in is totally empty - this means we got
+ # hit by a smooth^Wempty left-joined resultset. Just noop in that case
+ # instead of producing a {}
+ #
+ my $has_def;
+ for (@$row) {
+ if (defined $_) {
+ $has_def++;
+ last;
+ }
+ }
+ return undef unless $has_def;
+
my @copy = @$row;
# 'foo' => [ undef, 'foo' ]
@@ -1232,6 +1242,11 @@
$tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $tmp_attrs);
$tmp_attrs->{as} = 'count';
+ # read the comment on top of the actual function to see what this does
+ $tmp_attrs->{from} = $self->_switch_to_inner_join_if_needed (
+ $tmp_attrs->{from}, $tmp_attrs->{alias}
+ );
+
my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count');
return $tmp_rs;
@@ -1248,19 +1263,31 @@
my $sub_attrs = { %$attrs };
- # these can not go in the subquery, and there is no point of ordering it
- delete $sub_attrs->{$_} for qw/collapse select as order_by/;
+ # extra selectors do not go in the subquery and there is no point of ordering it
+ delete $sub_attrs->{$_} for qw/collapse select _prefetch_select as order_by/;
- # if we prefetch, we group_by primary keys only as this is what we would get out of the rs via ->next/->all
- # clobber old group_by regardless
+ # if we prefetch, we group_by primary keys only as this is what we would get out
+ # of the rs via ->next/->all. We DO WANT to clobber old group_by regardless
if ( keys %{$attrs->{collapse}} ) {
$sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->primary_columns) ]
}
$sub_attrs->{select} = $rsrc->storage->_subq_count_select ($rsrc, $sub_attrs);
+ # read the comment on top of the actual function to see what this does
+ $sub_attrs->{from} = $self->_switch_to_inner_join_if_needed (
+ $sub_attrs->{from}, $sub_attrs->{alias}
+ );
+
+ # this is so that ordering can be thrown away in things like Top limit
+ $sub_attrs->{-for_count_only} = 1;
+
+ my $sub_rs = $rsrc->resultset_class->new ($rsrc, $sub_attrs);
+
$attrs->{from} = [{
- count_subq => $rsrc->resultset_class->new ($rsrc, $sub_attrs )->as_query
+ -alias => 'count_subq',
+ -source_handle => $rsrc->handle,
+ count_subq => $sub_rs->as_query,
}];
# the subquery replaces this
@@ -1270,6 +1297,76 @@
}
+# The DBIC relationship chaining implementation is pretty simple - every
+# new related_relationship is pushed onto the {from} stack, and the {select}
+# window simply slides further in. This means that when we count somewhere
+# in the middle, we got to make sure that everything in the join chain is an
+# actual inner join, otherwise the count will come back with unpredictable
+# results (a resultset may be generated with _some_ rows regardless of if
+# the relation which the $rs currently selects has rows or not). E.g.
+# $artist_rs->cds->count - normally generates:
+# SELECT COUNT( * ) FROM artist me LEFT JOIN cd cds ON cds.artist = me.artistid
+# which actually returns the number of artists * (number of cds || 1)
+#
+# So what we do here is crawl {from}, determine if the current alias is at
+# the top of the stack, and if not - make sure the chain is inner-joined down
+# to the root.
+#
+sub _switch_to_inner_join_if_needed {
+ my ($self, $from, $alias) = @_;
+
+ # subqueries and other oddness is naturally not supported
+ return $from if (
+ ref $from ne 'ARRAY'
+ ||
+ @$from <= 1
+ ||
+ ref $from->[0] ne 'HASH'
+ ||
+ ! $from->[0]{-alias}
+ ||
+ $from->[0]{-alias} eq $alias
+ );
+
+ my $switch_branch;
+ JOINSCAN:
+ for my $j (@{$from}[1 .. $#$from]) {
+ if ($j->[0]{-alias} eq $alias) {
+ $switch_branch = $j->[0]{-join_path};
+ last JOINSCAN;
+ }
+ }
+
+ # something else went wrong
+ return $from unless $switch_branch;
+
+ # So it looks like we will have to switch some stuff around.
+ # local() is useless here as we will be leaving the scope
+ # anyway, and deep cloning is just too fucking expensive
+ # So replace the inner hashref manually
+ my @new_from = ($from->[0]);
+ my $sw_idx = { map { $_ => 1 } @$switch_branch };
+
+ for my $j (@{$from}[1 .. $#$from]) {
+ my $jalias = $j->[0]{-alias};
+
+ if ($sw_idx->{$jalias}) {
+ my %attrs = %{$j->[0]};
+ delete $attrs{-join_type};
+ push @new_from, [
+ \%attrs,
+ @{$j}[ 1 .. $#$j ],
+ ];
+ }
+ else {
+ push @new_from, $j;
+ }
+ }
+
+ return \@new_from;
+}
+
+
sub _bool {
return 1;
}
@@ -1316,13 +1413,12 @@
my @obj;
- # TODO: don't call resolve here
if (keys %{$self->_resolved_attrs->{collapse}}) {
-# if ($self->{attrs}{prefetch}) {
- # Using $self->cursor->all is really just an optimisation.
- # If we're collapsing has_many prefetches it probably makes
- # very little difference, and this is cleaner than hacking
- # _construct_object to survive the approach
+ # Using $self->cursor->all is really just an optimisation.
+ # If we're collapsing has_many prefetches it probably makes
+ # very little difference, and this is cleaner than hacking
+ # _construct_object to survive the approach
+ $self->cursor->reset;
my @row = $self->cursor->next;
while (@row) {
push(@obj, $self->_construct_object(@row));
@@ -1335,6 +1431,7 @@
}
$self->set_cache(\@obj) if $self->{attrs}{cache};
+
return @obj;
}
@@ -1349,6 +1446,8 @@
=back
Resets the resultset's cursor, so you can iterate through the elements again.
+Implicitly resets the storage cursor, so a subsequent L</next> will trigger
+another query.
=cut
@@ -1410,7 +1509,8 @@
if (my $g = $attrs->{group_by}) {
my @current_group_by = map
{ $_ =~ /\./ ? $_ : "$attrs->{alias}.$_" }
- (ref $g eq 'ARRAY' ? @$g : $g );
+ @$g
+ ;
if (
join ("\x00", sort @current_group_by)
@@ -1930,16 +2030,25 @@
# of the attributes supplied
#
# used to determine if a subquery is neccessary
+#
+# supports some virtual attributes:
+# -join
+# This will scan for any joins being present on the resultset.
+# It is not a mere key-search but a deep inspection of {from}
+#
sub _has_resolved_attr {
my ($self, @attr_names) = @_;
my $attrs = $self->_resolved_attrs;
- my $join_check_req;
+ my %extra_checks;
for my $n (@attr_names) {
- ++$join_check_req if $n eq '-join';
+ if (grep { $n eq $_ } (qw/-join/) ) {
+ $extra_checks{$n}++;
+ next;
+ }
my $attr = $attrs->{$n};
@@ -1958,7 +2067,7 @@
# a resolved join is expressed as a multi-level from
return 1 if (
- $join_check_req
+ $extra_checks{-join}
and
ref $attrs->{from} eq 'ARRAY'
and
@@ -2124,13 +2233,16 @@
can also be passed an object representing the foreign row, and the
value will be set to its primary key.
-To create related objects, pass a hashref for the value if the related
-item is a foreign key relationship (L<DBIx::Class::Relationship/belongs_to>),
-and use the name of the relationship as the key. (NOT the name of the field,
-necessarily). For C<has_many> and C<has_one> relationships, pass an arrayref
-of hashrefs containing the data for each of the rows to create in the foreign
-tables, again using the relationship name as the key.
+To create related objects, pass a hashref of related-object column values
+B<keyed on the relationship name>. If the relationship is of type C<multi>
+(L<DBIx::Class::Relationship/has_many>) - pass an arrayref of hashrefs.
+The process will correctly identify columns holding foreign keys, and will
+transparrently populate them from the keys of the corresponding relation.
+This can be applied recursively, and will work correctly for a structure
+with an arbitrary depth and width, as long as the relationships actually
+exists and the correct column data has been supplied.
+
Instead of hashrefs of plain related data (key/value pairs), you may
also pass new or inserted objects. New objects (not inserted yet, see
L</new>), will be inserted into their appropriate tables.
@@ -2186,7 +2298,7 @@
=back
$cd->cd_to_producer->find_or_create({ producer => $producer },
- { key => 'primary });
+ { key => 'primary' });
Tries to find a record based on its primary key or unique constraints; if none
is found, creates one and returns that instead.
@@ -2448,14 +2560,14 @@
$self->{related_resultsets} ||= {};
return $self->{related_resultsets}{$rel} ||= do {
- my $rel_obj = $self->result_source->relationship_info($rel);
+ my $rel_info = $self->result_source->relationship_info($rel);
$self->throw_exception(
"search_related: result source '" . $self->result_source->source_name .
"' has no such relationship $rel")
- unless $rel_obj;
+ unless $rel_info;
- my ($from,$seen) = $self->_resolve_from($rel);
+ my ($from,$seen) = $self->_chain_relationship($rel);
my $join_count = $seen->{$rel};
my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel);
@@ -2553,8 +2665,13 @@
# in order to properly resolve prefetch aliases (any alias
# with a relation_chain_depth less than the depth of the
# current prefetch is not considered)
-sub _resolve_from {
- my ($self, $extra_join) = @_;
+#
+# The increments happen in 1/2s to make it easier to correlate the
+# join depth with the join path. An integer means a relationship
+# specified via a search_related, whereas a fraction means an added
+# join/prefetch via attributes
+sub _chain_relationship {
+ my ($self, $rel) = @_;
my $source = $self->result_source;
my $attrs = $self->{attrs};
@@ -2569,19 +2686,63 @@
}];
my $seen = { %{$attrs->{seen_join} || {} } };
+ my $jpath = ($attrs->{seen_join} && keys %{$attrs->{seen_join}})
+ ? $from->[-1][0]{-join_path}
+ : [];
+
# we need to take the prefetch the attrs into account before we
# ->_resolve_join as otherwise they get lost - captainL
my $merged = $self->_merge_attr( $attrs->{join}, $attrs->{prefetch} );
- push @$from, $source->_resolve_join($merged, $attrs->{alias}, $seen) if ($merged);
+ my @requested_joins = $source->_resolve_join(
+ $merged,
+ $attrs->{alias},
+ $seen,
+ $jpath,
+ );
- ++$seen->{-relation_chain_depth};
+ push @$from, @requested_joins;
- push @$from, $source->_resolve_join($extra_join, $attrs->{alias}, $seen);
+ $seen->{-relation_chain_depth} += 0.5;
- ++$seen->{-relation_chain_depth};
+ # if $self already had a join/prefetch specified on it, the requested
+ # $rel might very well be already included. What we do in this case
+ # is effectively a no-op (except that we bump up the chain_depth on
+ # the join in question so we could tell it *is* the search_related)
+ my $already_joined;
+
+ # we consider the last one thus reverse
+ for my $j (reverse @requested_joins) {
+ if ($rel eq $j->[0]{-join_path}[-1]) {
+ $j->[0]{-relation_chain_depth} += 0.5;
+ $already_joined++;
+ last;
+ }
+ }
+
+# alternative way to scan the entire chain - not backwards compatible
+# for my $j (reverse @$from) {
+# next unless ref $j eq 'ARRAY';
+# if ($j->[0]{-join_path} && $j->[0]{-join_path}[-1] eq $rel) {
+# $j->[0]{-relation_chain_depth} += 0.5;
+# $already_joined++;
+# last;
+# }
+# }
+
+ unless ($already_joined) {
+ push @$from, $source->_resolve_join(
+ $rel,
+ $attrs->{alias},
+ $seen,
+ $jpath,
+ );
+ }
+
+ $seen->{-relation_chain_depth} += 0.5;
+
return ($from,$seen);
}
@@ -2692,30 +2853,35 @@
[
@{ $attrs->{from} },
$source->_resolve_join(
- $join, $alias, { %{ $attrs->{seen_join} || {} } }
+ $join,
+ $alias,
+ { %{ $attrs->{seen_join} || {} } },
+ ($attrs->{seen_join} && keys %{$attrs->{seen_join}})
+ ? $attrs->{from}[-1][0]{-join_path}
+ : []
+ ,
)
];
}
- if ( $attrs->{order_by} ) {
+ if ( defined $attrs->{order_by} ) {
$attrs->{order_by} = (
ref( $attrs->{order_by} ) eq 'ARRAY'
? [ @{ $attrs->{order_by} } ]
- : [ $attrs->{order_by} ]
+ : [ $attrs->{order_by} || () ]
);
}
- else {
- $attrs->{order_by} = [];
+
+ if ($attrs->{group_by} and ref $attrs->{group_by} ne 'ARRAY') {
+ $attrs->{group_by} = [ $attrs->{group_by} ];
}
- # If the order_by is otherwise empty - we will use this for TOP limit
- # emulation and the like.
- # Although this is needed only if the order_by is not defined, it is
- # actually cheaper to just populate this rather than properly examining
- # order_by (stuf like [ {} ] and the like)
- $attrs->{_virtual_order_by} = [ $self->result_source->primary_columns ];
+ # generate the distinct induced group_by early, as prefetch will be carried via a
+ # subquery (since a group_by is present)
+ if (delete $attrs->{distinct}) {
+ $attrs->{group_by} ||= [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ];
+ }
-
$attrs->{collapse} ||= {};
if ( my $prefetch = delete $attrs->{prefetch} ) {
$prefetch = $self->_merge_attr( {}, $prefetch );
@@ -2727,24 +2893,25 @@
my @prefetch =
$source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} );
- push( @{ $attrs->{select} }, map { $_->[0] } @prefetch );
- push( @{ $attrs->{as} }, map { $_->[1] } @prefetch );
+ # we need to somehow mark which columns came from prefetch
+ $attrs->{_prefetch_select} = [ map { $_->[0] } @prefetch ];
- push( @{ $attrs->{order_by} }, @$prefetch_ordering );
+ push @{ $attrs->{select} }, @{$attrs->{_prefetch_select}};
+ push @{ $attrs->{as} }, (map { $_->[1] } @prefetch);
+
+ push( @{$attrs->{order_by}}, @$prefetch_ordering );
$attrs->{_collapse_order_by} = \@$prefetch_ordering;
}
-
- if (delete $attrs->{distinct}) {
- $attrs->{group_by} ||= [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ];
- }
-
# if both page and offset are specified, produce a combined offset
# even though it doesn't make much sense, this is what pre 081xx has
# been doing
if (my $page = delete $attrs->{page}) {
- $attrs->{offset} = ($attrs->{rows} * ($page - 1)) +
- ($attrs->{offset} || 0);
+ $attrs->{offset} =
+ ($attrs->{rows} * ($page - 1))
+ +
+ ($attrs->{offset} || 0)
+ ;
}
return $self->{_attrs} = $attrs;
@@ -2756,13 +2923,21 @@
my $paths = {};
return $paths unless ref $fromspec eq 'ARRAY';
+ my $cur_depth = $seen->{-relation_chain_depth} || 0;
+
+ if (int ($cur_depth) != $cur_depth) {
+ $self->throw_exception ("-relation_chain_depth is not an integer, something went horribly wrong ($cur_depth)");
+ }
+
for my $j (@$fromspec) {
next if ref $j ne 'ARRAY';
- next if $j->[0]{-relation_chain_depth} < ( $seen->{-relation_chain_depth} || 0);
+ next if ($j->[0]{-relation_chain_depth} || 0) < $cur_depth;
+ my $jpath = $j->[0]{-join_path};
+
my $p = $paths;
- $p = $p->{$_} ||= {} for @{$j->[0]{-join_path}};
+ $p = $p->{$_} ||= {} for @{$jpath}[$cur_depth .. $#$jpath];
push @{$p->{-join_aliases} }, $j->[0]{-alias};
}
@@ -2919,11 +3094,16 @@
=back
-Which column(s) to order the results by. If a single column name, or
-an arrayref of names is supplied, the argument is passed through
-directly to SQL. The hashref syntax allows for connection-agnostic
-specification of ordering direction:
+Which column(s) to order the results by.
+[The full list of suitable values is documented in
+L<SQL::Abstract/"ORDER BY CLAUSES">; the following is a summary of
+common options.]
+
+If a single column name, or an arrayref of names is supplied, the
+argument is passed through directly to SQL. The hashref syntax allows
+for connection-agnostic specification of ordering direction:
+
For descending order:
order_by => { -desc => [qw/col1 col2 col3/] }
@@ -3201,6 +3381,42 @@
B<NOTE:> If you specify a C<prefetch> attribute, the C<join> and C<select>
attributes will be ignored.
+B<CAVEATs>: Prefetch does a lot of deep magic. As such, it may not behave
+exactly as you might expect.
+
+=over 4
+
+=item *
+
+Prefetch uses the L</cache> to populate the prefetched relationships. This
+may or may not be what you want.
+
+=item *
+
+If you specify a condition on a prefetched relationship, ONLY those
+rows that match the prefetched condition will be fetched into that relationship.
+This means that adding prefetch to a search() B<may alter> what is returned by
+traversing a relationship. So, if you have C<< Artist->has_many(CDs) >> and you do
+
+ my $artist_rs = $schema->resultset('Artist')->search({
+ 'cds.year' => 2008,
+ }, {
+ join => 'cds',
+ });
+
+ my $count = $artist_rs->first->cds->count;
+
+ my $artist_rs_prefetch = $artist_rs->search( {}, { prefetch => 'cds' } );
+
+ my $prefetch_count = $artist_rs_prefetch->first->cds->count;
+
+ cmp_ok( $count, '==', $prefetch_count, "Counts should be the same" );
+
+that cmp_ok() may or may not pass depending on the datasets involved. This
+behavior may or may not survive the 0.09 transition.
+
+=back
+
=head2 page
=over 4
@@ -3213,7 +3429,7 @@
identical to creating a non-pages resultset and then calling ->page($page)
on it.
-If L<rows> attribute is not specified it defualts to 10 rows per page.
+If L<rows> attribute is not specified it defaults to 10 rows per page.
When you have a paged resultset, L</count> will only return the number
of rows in the page. To get the total, use the L</pager> and call
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSetColumn.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSetColumn.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSetColumn.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -39,27 +39,48 @@
$rs->throw_exception("column must be supplied") unless $column;
- my $new_parent_rs = $rs->search_rs; # we don't want to mess up the original, so clone it
+ my $orig_attrs = $rs->_resolved_attrs;
+ my $new_parent_rs = $rs->search_rs;
# prefetch causes additional columns to be fetched, but we can not just make a new
# rs via the _resolved_attrs trick - we need to retain the separation between
# +select/+as and select/as. At the same time we want to preserve any joins that the
# prefetch would otherwise generate.
- my $init_attrs = $new_parent_rs->{attrs} ||= {};
- delete $init_attrs->{collapse};
- $init_attrs->{join} = $rs->_merge_attr( delete $init_attrs->{join}, delete $init_attrs->{prefetch} );
+ my $new_attrs = $new_parent_rs->{attrs} ||= {};
+ $new_attrs->{join} = $rs->_merge_attr( delete $new_attrs->{join}, delete $new_attrs->{prefetch} );
+
# If $column can be found in the 'as' list of the parent resultset, use the
# corresponding element of its 'select' list (to keep any custom column
# definition set up with 'select' or '+select' attrs), otherwise use $column
# (to create a new column definition on-the-fly).
- my $attrs = $new_parent_rs->_resolved_attrs;
- my $as_list = $attrs->{as} || [];
- my $select_list = $attrs->{select} || [];
+ my $as_list = $orig_attrs->{as} || [];
+ my $select_list = $orig_attrs->{select} || [];
my $as_index = List::Util::first { ($as_list->[$_] || "") eq $column } 0..$#$as_list;
my $select = defined $as_index ? $select_list->[$as_index] : $column;
+ # {collapse} would mean a has_many join was injected, which in turn means
+ # we need to group IF WE CAN (only if the column in question is unique)
+ if (!$new_attrs->{group_by} && keys %{$orig_attrs->{collapse}}) {
+
+ # scan for a constraint that would contain our column only - that'd be proof
+ # enough it is unique
+ my $constraints = { $rs->result_source->unique_constraints };
+ for my $constraint_columns ( values %$constraints ) {
+
+ next unless @$constraint_columns == 1;
+
+ my $col = $constraint_columns->[0];
+ my $fqcol = join ('.', $new_attrs->{alias}, $col);
+
+ if ($col eq $select or $fqcol eq $select) {
+ $new_attrs->{group_by} = [ $select ];
+ last;
+ }
+ }
+ }
+
my $new = bless { _select => $select, _as => $column, _parent_resultset => $new_parent_rs }, $class;
return $new;
}
@@ -317,7 +338,7 @@
sub func {
my ($self,$function) = @_;
my $cursor = $self->func_rs($function)->cursor;
-
+
if( wantarray ) {
return map { $_->[ 0 ] } $cursor->all;
}
@@ -352,9 +373,9 @@
=head2 throw_exception
See L<DBIx::Class::Schema/throw_exception> for details.
-
+
=cut
-
+
sub throw_exception {
my $self=shift;
if (ref $self && $self->{_parent_resultset}) {
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSource/View.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSource/View.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSource/View.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -17,9 +17,9 @@
=head1 SYNOPSIS
- package MyDB::Schema::Year2000CDs;
+ package MyDB::Schema::Result::Year2000CDs;
- use DBIx::Class::ResultSource::View;
+ use base qw/DBIx::Class/;
__PACKAGE__->load_components('Core');
__PACKAGE__->table_class('DBIx::Class::ResultSource::View');
@@ -28,17 +28,30 @@
__PACKAGE__->result_source_instance->is_virtual(1);
__PACKAGE__->result_source_instance->view_definition(
"SELECT cdid, artist, title FROM cd WHERE year ='2000'"
- );
+ );
+ __PACKAGE__->add_columns(
+ 'cdid' => {
+ data_type => 'integer',
+ is_auto_increment => 1,
+ },
+ 'artist' => {
+ data_type => 'integer',
+ },
+ 'title' => {
+ data_type => 'varchar',
+ size => 100,
+ },
+ );
=head1 DESCRIPTION
View object that inherits from L<DBIx::Class::ResultSource>
-This class extends ResultSource to add basic view support.
+This class extends ResultSource to add basic view support.
-A view has a L</view_definition>, which contains an SQL query. The
-query cannot have parameters. It may contain JOINs, sub selects and
-any other SQL your database supports.
+A view has a L</view_definition>, which contains a SQL query. The query can
+only have parameters if L</is_virtual> is set to true. It may contain JOINs,
+sub selects and any other SQL your database supports.
View definition SQL is deployed to your database on
L<DBIx::Class::Schema/deploy> unless you set L</is_virtual> to true.
@@ -50,6 +63,37 @@
exist in your database as a real view. The L</view_definition> in this
case replaces the view name in a FROM clause in a subselect.
+=head1 EXAMPLES
+
+Having created the MyDB::Schema::Year2000CDs schema as shown in the SYNOPSIS
+above, you can then:
+
+ $2000_cds = $schema->resultset('Year2000CDs')
+ ->search()
+ ->all();
+ $count = $schema->resultset('Year2000CDs')
+ ->search()
+ ->count();
+
+If you modified the schema to include a placeholder
+
+ __PACKAGE__->result_source_instance->view_definition(
+ "SELECT cdid, artist, title FROM cd WHERE year ='?'"
+ );
+
+and ensuring you have is_virtual set to true:
+
+ __PACKAGE__->result_source_instance->is_virtual(1);
+
+You could now say:
+
+ $2001_cds = $schema->resultset('Year2000CDs')
+ ->search({}, { bind => [2001] })
+ ->all();
+ $count = $schema->resultset('Year2000CDs')
+ ->search({}, { bind => [2001] })
+ ->count();
+
=head1 SQL EXAMPLES
=over
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSource.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSource.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSource.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -24,13 +24,74 @@
=head1 SYNOPSIS
+ # Create a table based result source, in a result class.
+
+ package MyDB::Schema::Result::Artist;
+ use base qw/DBIx::Class/;
+
+ __PACKAGE__->load_components(qw/Core/);
+ __PACKAGE__->table('artist');
+ __PACKAGE__->add_columns(qw/ artistid name /);
+ __PACKAGE__->set_primary_key('artistid');
+ __PACKAGE__->has_many(cds => 'MyDB::Schema::Result::CD');
+
+ 1;
+
+ # Create a query (view) based result source, in a result class
+ package MyDB::Schema::Result::Year2000CDs;
+
+ __PACKAGE__->load_components('Core');
+ __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
+
+ __PACKAGE__->table('year2000cds');
+ __PACKAGE__->result_source_instance->is_virtual(1);
+ __PACKAGE__->result_source_instance->view_definition(
+ "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
+ );
+
+
=head1 DESCRIPTION
-A ResultSource is a component of a schema from which results can be directly
-retrieved, most usually a table (see L<DBIx::Class::ResultSource::Table>)
+A ResultSource is an object that represents a source of data for querying.
-Basic view support also exists, see L<<DBIx::Class::ResultSource::View>.
+This class is a base class for various specialised types of result
+sources, for example L<DBIx::Class::ResultSource::Table>. Table is the
+default result source type, so one is created for you when defining a
+result class as described in the synopsis above.
+More specifically, the L<DBIx::Class::Core> component pulls in the
+L<DBIx::Class::ResultSourceProxy::Table> as a base class, which
+defines the L<table|DBIx::Class::ResultSourceProxy::Table/table>
+method. When called, C<table> creates and stores an instance of
+L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
+sources, you don't need to remember any of this.
+
+Result sources representing select queries, or views, can also be
+created, see L<DBIx::Class::ResultSource::View> for full details.
+
+=head2 Finding result source objects
+
+As mentioned above, a result source instance is created and stored for
+you when you define a L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
+
+You can retrieve the result source at runtime in the following ways:
+
+=over
+
+=item From a Schema object:
+
+ $schema->source($source_name);
+
+=item From a Row object:
+
+ $row->result_source;
+
+=item From a ResultSet object:
+
+ $rs->result_source;
+
+=back
+
=head1 METHODS
=pod
@@ -69,9 +130,9 @@
$source->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
-Adds columns to the result source. If supplied key => hashref pairs, uses
-the hashref as the column_info for that column. Repeated calls of this
-method will add more columns, not replace them.
+Adds columns to the result source. If supplied colname => hashref
+pairs, uses the hashref as the L</column_info> for that column. Repeated
+calls of this method will add more columns, not replace them.
The column names given will be created as accessor methods on your
L<DBIx::Class::Row> objects. You can change the name of the accessor
@@ -84,40 +145,62 @@
=item accessor
+ { accessor => '_name' }
+
+ # example use, replace standard accessor with one of your own:
+ sub name {
+ my ($self, $value) = @_;
+
+ die "Name cannot contain digits!" if($value =~ /\d/);
+ $self->_name($value);
+
+ return $self->_name();
+ }
+
Use this to set the name of the accessor method for this column. If unset,
the name of the column will be used.
=item data_type
-This contains the column type. It is automatically filled by the
-L<SQL::Translator::Producer::DBIx::Class::File> producer, and the
-L<DBIx::Class::Schema::Loader> module. If you do not enter a
-data_type, DBIx::Class will attempt to retrieve it from the
-database for you, using L<DBI>'s column_info method. The values of this
-key are typically upper-cased.
+ { data_type => 'integer' }
+This contains the column type. It is automatically filled if you use the
+L<SQL::Translator::Producer::DBIx::Class::File> producer, or the
+L<DBIx::Class::Schema::Loader> module.
+
Currently there is no standard set of values for the data_type. Use
whatever your database supports.
=item size
+ { size => 20 }
+
The length of your column, if it is a column type that can have a size
-restriction. This is currently only used by L<DBIx::Class::Schema/deploy>.
+restriction. This is currently only used to create tables from your
+schema, see L<DBIx::Class::Schema/deploy>.
=item is_nullable
-Set this to a true value for a columns that is allowed to contain
-NULL values. This is currently only used by L<DBIx::Class::Schema/deploy>.
+ { is_nullable => 1 }
+Set this to a true value for a columns that is allowed to contain NULL
+values, default is false. This is currently only used to create tables
+from your schema, see L<DBIx::Class::Schema/deploy>.
+
=item is_auto_increment
+ { is_auto_increment => 1 }
+
Set this to a true value for a column whose value is somehow
-automatically set. This is used to determine which columns to empty
-when cloning objects using L<DBIx::Class::Row/copy>. It is also used by
+automatically set, defaults to false. This is used to determine which
+columns to empty when cloning objects using
+L<DBIx::Class::Row/copy>. It is also used by
L<DBIx::Class::Schema/deploy>.
=item is_numeric
+ { is_numeric => 1 }
+
Set this to a true or false value (not C<undef>) to explicitly specify
if this column contains numeric data. This controls how set_column
decides whether to consider a column dirty after an update: if
@@ -130,22 +213,29 @@
=item is_foreign_key
+ { is_foreign_key => 1 }
+
Set this to a true value for a column that contains a key from a
-foreign table. This is currently only used by
-L<DBIx::Class::Schema/deploy>.
+foreign table, defaults to false. This is currently only used to
+create tables from your schema, see L<DBIx::Class::Schema/deploy>.
=item default_value
-Set this to the default value which will be inserted into a column
-by the database. Can contain either a value or a function (use a
+ { default_value => \'now()' }
+
+Set this to the default value which will be inserted into a column by
+the database. Can contain either a value or a function (use a
reference to a scalar e.g. C<\'now()'> if you want a function). This
-is currently only used by L<DBIx::Class::Schema/deploy>.
+is currently only used to create tables from your schema, see
+L<DBIx::Class::Schema/deploy>.
See the note on L<DBIx::Class::Row/new> for more information about possible
issues related to db-side default values.
=item sequence
+ { sequence => 'my_table_seq' }
+
Set this on a primary key column to the name of the sequence used to
generate a new key value. If not specified, L<DBIx::Class::PK::Auto>
will attempt to retrieve the name of the sequence from the database
@@ -153,10 +243,16 @@
=item auto_nextval
-Set this to a true value for a column whose value is retrieved
-automatically from an oracle sequence. If you do not use an Oracle
-trigger to get the nextval, you have to set sequence as well.
+Set this to a true value for a column whose value is retrieved automatically
+from a sequence or function (if supported by your Storage driver.) For a
+sequence, if you do not use a trigger to get the nextval, you have to set the
+L</sequence> value as well.
+Also set this for MSSQL columns with the 'uniqueidentifier'
+L<DBIx::Class::ResultSource/data_type> whose values you want to automatically
+generate using C<NEWID()>, unless they are a primary key in which case this will
+be done anyway.
+
=item extra
This is used by L<DBIx::Class::Schema/deploy> and L<SQL::Translator>
@@ -171,13 +267,13 @@
=over
-=item Arguments: $colname, [ \%columninfo ]
+=item Arguments: $colname, \%columninfo?
=item Return value: 1/0 (true/false)
=back
- $source->add_column('col' => \%info?);
+ $source->add_column('col' => \%info);
Add a single column and optional column info. Uses the same column
info keys as L</add_columns>.
@@ -237,8 +333,8 @@
my $info = $source->column_info($col);
Returns the column metadata hashref for a column, as originally passed
-to L</add_columns>. See the description of L</add_columns> for information
-on the contents of the hashref.
+to L</add_columns>. See L</add_columns> above for information on the
+contents of the hashref.
=cut
@@ -362,14 +458,16 @@
=back
-Defines one or more columns as primary key for this source. Should be
+Defines one or more columns as primary key for this source. Must be
called after L</add_columns>.
Additionally, defines a L<unique constraint|add_unique_constraint>
named C<primary>.
The primary key columns are used by L<DBIx::Class::PK::Auto> to
-retrieve automatically created values from the database.
+retrieve automatically created values from the database. They are also
+used as default joining columns when specifying relationships, see
+L<DBIx::Class::Relationship>.
=cut
@@ -408,7 +506,7 @@
=over 4
-=item Arguments: [ $name ], \@colnames
+=item Arguments: $name?, \@colnames
=item Return value: undefined
@@ -426,11 +524,13 @@
__PACKAGE__->add_unique_constraint([ qw/column1 column2/ ]);
-This will result in a unique constraint named C<table_column1_column2>, where
-C<table> is replaced with the table name.
+This will result in a unique constraint named
+C<table_column1_column2>, where C<table> is replaced with the table
+name.
-Unique constraints are used, for example, when you call
-L<DBIx::Class::ResultSet/find>. Only columns in the constraint are searched.
+Unique constraints are used, for example, when you pass the constraint
+name as the C<key> attribute to L<DBIx::Class::ResultSet/find>. Then
+only columns in the constraint are searched.
Throws an error if any of the given column names do not yet exist on
the result source.
@@ -484,7 +584,10 @@
sub name_unique_constraint {
my ($self, $cols) = @_;
- return join '_', $self->name, @$cols;
+ my $name = $self->name;
+ $name = $$name if (ref $name eq 'SCALAR');
+
+ return join '_', $name, @$cols;
}
=head2 unique_constraints
@@ -499,7 +602,8 @@
$source->unique_constraints();
-Read-only accessor which returns a hash of unique constraints on this source.
+Read-only accessor which returns a hash of unique constraints on this
+source.
The hash is keyed by constraint name, and contains an arrayref of
column names as values.
@@ -659,12 +763,16 @@
=back
- package My::ResultSetClass;
+ package My::Schema::ResultSet::Artist;
use base 'DBIx::Class::ResultSet';
...
- $source->resultset_class('My::ResultSet::Class');
+ # In the result class
+ __PACKAGE__->resultset_class('My::Schema::ResultSet::Artist');
+ # Or in code
+ $source->resultset_class('My::Schema::ResultSet::Artist');
+
Set the class of the resultset. This is useful if you want to create your
own resultset methods. Create your own class derived from
L<DBIx::Class::ResultSet>, and set it here. If called with no arguments,
@@ -681,6 +789,10 @@
=back
+ # In the result class
+ __PACKAGE__->resultset_attributes({ order_by => [ 'id' ] });
+
+ # Or in code
$source->resultset_attributes({ order_by => [ 'id' ] });
Store a collection of resultset attributes, that will be set on every
@@ -893,7 +1005,7 @@
}
return unless $f_source; # Can't test rel without f_source
- eval { $self->_resolve_join($rel, 'me') };
+ eval { $self->_resolve_join($rel, 'me', {}, []) };
if ($@) { # If the resolve failed, back out and re-throw the error
delete $rels{$rel}; #
@@ -981,7 +1093,7 @@
L<DBIx::Class::Relationship>.
The returned hashref is keyed by the name of the opposing
-relationship, and contains it's data in the same manner as
+relationship, and contains its data in the same manner as
L</relationship_info>.
=cut
@@ -1083,26 +1195,21 @@
# Returns the {from} structure used to express JOIN conditions
sub _resolve_join {
- my ($self, $join, $alias, $seen, $force_left, $jpath) = @_;
+ my ($self, $join, $alias, $seen, $jpath, $force_left) = @_;
# we need a supplied one, because we do in-place modifications, no returns
$self->throw_exception ('You must supply a seen hashref as the 3rd argument to _resolve_join')
- unless $seen;
+ unless ref $seen eq 'HASH';
- $force_left ||= { force => 0 };
+ $self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
+ unless ref $jpath eq 'ARRAY';
- # This isn't quite right, we should actually dive into $seen and reconstruct
- # the entire path (the reference entry point would be the join conditional
- # with depth == current_depth - 1. At this point however nothing depends on
- # having the entire path, transcending related_resultset, so just leave it
- # as is, hairy enough already.
- $jpath ||= [];
+ $jpath = [@$jpath];
if (ref $join eq 'ARRAY') {
return
map {
- local $force_left->{force} = $force_left->{force};
- $self->_resolve_join($_, $alias, $seen, $force_left, [@$jpath]);
+ $self->_resolve_join($_, $alias, $seen, $jpath, $force_left);
} @$join;
} elsif (ref $join eq 'HASH') {
return
@@ -1110,9 +1217,9 @@
my $as = ($seen->{$_} ? join ('_', $_, $seen->{$_} + 1) : $_); # the actual seen value will be incremented below
local $force_left->{force} = $force_left->{force};
(
- $self->_resolve_join($_, $alias, $seen, $force_left, [@$jpath]),
+ $self->_resolve_join($_, $alias, $seen, [@$jpath], $force_left),
$self->related_source($_)->_resolve_join(
- $join->{$_}, $as, $seen, $force_left, [@$jpath, $_]
+ $join->{$_}, $as, $seen, [@$jpath, $_], $force_left
)
);
} keys %$join;
@@ -1120,17 +1227,19 @@
$self->throw_exception("No idea how to resolve join reftype ".ref $join);
} else {
+ return() unless defined $join;
+
my $count = ++$seen->{$join};
my $as = ($count > 1 ? "${join}_${count}" : $join);
my $rel_info = $self->relationship_info($join);
$self->throw_exception("No such relationship ${join}") unless $rel_info;
my $type;
- if ($force_left->{force}) {
+ if ($force_left) {
$type = 'left';
} else {
$type = $rel_info->{attrs}{join_type} || '';
- $force_left->{force} = 1 if lc($type) eq 'left';
+ $force_left = 1 if lc($type) eq 'left';
}
my $rel_src = $self->related_source($join);
@@ -1156,18 +1265,22 @@
# hashref of columns of the related object.
sub _pk_depends_on {
my ($self, $relname, $rel_data) = @_;
- my $cond = $self->relationship_info($relname)->{cond};
+ my $relinfo = $self->relationship_info($relname);
+
+ # don't assume things if the relationship direction is specified
+ return $relinfo->{attrs}{is_foreign_key_constraint}
+ if exists ($relinfo->{attrs}{is_foreign_key_constraint});
+
+ my $cond = $relinfo->{cond};
return 0 unless ref($cond) eq 'HASH';
# map { foreign.foo => 'self.bar' } to { bar => 'foo' }
-
my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
# assume anything that references our PK probably is dependent on us
# rather than vice versa, unless the far side is (a) defined or (b)
# auto-increment
-
my $rel_source = $self->related_source($relname);
foreach my $p ($self->primary_columns) {
@@ -1196,7 +1309,6 @@
sub _resolve_condition {
my ($self, $cond, $as, $for) = @_;
- #warn %$cond;
if (ref $cond eq 'HASH') {
my %ret;
foreach my $k (keys %{$cond}) {
@@ -1237,7 +1349,7 @@
} elsif (ref $cond eq 'ARRAY') {
return [ map { $self->_resolve_condition($_, $as, $for) } @$cond ];
} else {
- die("Can't handle this yet :(");
+ die("Can't handle condition $cond yet :(");
}
}
@@ -1342,15 +1454,14 @@
"don't know how to resolve prefetch reftype ".ref($pre));
}
else {
-
my $p = $alias_map;
$p = $p->{$_} for (@$pref_path, $pre);
$self->throw_exception (
- "Unable to resolve prefetch $pre - join alias map does not contain an entry for path "
+ "Unable to resolve prefetch $pre - join alias map does not contain an entry for path: "
. join (' -> ', @$pref_path, $pre)
) if (ref $p->{-join_aliases} ne 'ARRAY' or not @{$p->{-join_aliases}} );
-
+
my $as = shift @{$p->{-join_aliases}};
my $rel_info = $self->relationship_info( $pre );
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSourceHandle.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSourceHandle.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSourceHandle.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -77,7 +77,7 @@
my ($self, $cloning) = @_;
my $to_serialize = { %$self };
-
+
my $class = $self->schema->class($self->source_moniker);
$to_serialize->{schema} = $class;
return (Storable::freeze($to_serialize));
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSourceProxy/Table.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSourceProxy/Table.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/ResultSourceProxy/Table.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -6,6 +6,7 @@
use base qw/DBIx::Class::ResultSourceProxy/;
use DBIx::Class::ResultSource::Table;
+use Scalar::Util ();
__PACKAGE__->mk_classdata(table_class => 'DBIx::Class::ResultSource::Table');
@@ -22,8 +23,11 @@
my $class_has_table_instance = ($table and $table->result_class eq $class);
return $table if $class_has_table_instance;
+ my $table_class = $class->table_class;
+ $class->ensure_class_loaded($table_class);
+
if( $table ) {
- $table = $class->table_class->new({
+ $table = $table_class->new({
%$table,
result_class => $class,
source_name => undef,
@@ -31,7 +35,7 @@
});
}
else {
- $table = $class->table_class->new({
+ $table = $table_class->new({
name => undef,
result_class => $class,
source_name => undef,
@@ -67,7 +71,7 @@
=head2 table
__PACKAGE__->table('tbl_name');
-
+
Gets or sets the table name.
=cut
@@ -75,8 +79,13 @@
sub table {
my ($class, $table) = @_;
return $class->result_source_instance->name unless $table;
- unless (ref $table) {
- $table = $class->table_class->new({
+
+ unless (Scalar::Util::blessed($table) && $table->isa($class->table_class)) {
+
+ my $table_class = $class->table_class;
+ $class->ensure_class_loaded($table_class);
+
+ $table = $table_class->new({
$class->can('result_source_instance') ?
%{$class->result_source_instance||{}} : (),
name => $table,
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Row.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Row.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Row.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -162,10 +162,8 @@
if ($attrs) {
$new->throw_exception("attrs must be a hashref")
unless ref($attrs) eq 'HASH';
-
+
my ($related,$inflated);
- ## Pretend all the rels are actual objects, unset below if not, for insert() to fix
- $new->{_rel_in_storage} = 1;
foreach my $key (keys %$attrs) {
if (ref $attrs->{$key}) {
@@ -181,9 +179,9 @@
}
if ($rel_obj->in_storage) {
+ $new->{_rel_in_storage}{$key} = 1;
$new->set_from_related($key, $rel_obj);
} else {
- $new->{_rel_in_storage} = 0;
MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj\n";
}
@@ -202,13 +200,11 @@
}
if ($rel_obj->in_storage) {
- $new->set_from_related($key, $rel_obj);
+ $rel_obj->throw_exception ('A multi relationship can not be pre-existing when doing multicreate. Something went wrong');
} else {
- $new->{_rel_in_storage} = 0;
MULTICREATE_DEBUG and
warn "MC $new uninserted $key $rel_obj (${\($idx+1)} of $total)\n";
}
- $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
push(@objects, $rel_obj);
}
$related->{$key} = \@objects;
@@ -221,8 +217,10 @@
if(!Scalar::Util::blessed($rel_obj)) {
$rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
}
- unless ($rel_obj->in_storage) {
- $new->{_rel_in_storage} = 0;
+ if ($rel_obj->in_storage) {
+ $new->{_rel_in_storage}{$key} = 1;
+ }
+ else {
MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj";
}
$inflated->{$key} = $rel_obj;
@@ -235,7 +233,7 @@
}
$new->throw_exception("No such column $key on $class")
unless $class->has_column($key);
- $new->store_column($key => $attrs->{$key});
+ $new->store_column($key => $attrs->{$key});
}
$new->{_relationship_data} = $related if $related;
@@ -283,31 +281,25 @@
my $rollback_guard;
# Check if we stored uninserted relobjs here in new()
- my %related_stuff = (%{$self->{_relationship_data} || {}},
+ my %related_stuff = (%{$self->{_relationship_data} || {}},
%{$self->{_inflated_column} || {}});
- if(!$self->{_rel_in_storage}) {
+ # insert what needs to be inserted before us
+ my %pre_insert;
+ for my $relname (keys %related_stuff) {
+ my $rel_obj = $related_stuff{$relname};
- # The guard will save us if we blow out of this scope via die
- $rollback_guard = $source->storage->txn_scope_guard;
+ if (! $self->{_rel_in_storage}{$relname}) {
+ next unless (Scalar::Util::blessed($rel_obj)
+ && $rel_obj->isa('DBIx::Class::Row'));
- ## Should all be in relationship_data, but we need to get rid of the
- ## 'filter' reltype..
- ## These are the FK rels, need their IDs for the insert.
+ next unless $source->_pk_depends_on(
+ $relname, { $rel_obj->get_columns }
+ );
- my @pri = $self->primary_columns;
+ # The guard will save us if we blow out of this scope via die
+ $rollback_guard ||= $source->storage->txn_scope_guard;
- REL: foreach my $relname (keys %related_stuff) {
-
- my $rel_obj = $related_stuff{$relname};
-
- next REL unless (Scalar::Util::blessed($rel_obj)
- && $rel_obj->isa('DBIx::Class::Row'));
-
- next REL unless $source->_pk_depends_on(
- $relname, { $rel_obj->get_columns }
- );
-
MULTICREATE_DEBUG and warn "MC $self pre-reconstructing $relname $rel_obj\n";
my $them = { %{$rel_obj->{_relationship_data} || {} }, $rel_obj->get_inflated_columns };
@@ -315,12 +307,21 @@
->related_source($relname)
->resultset
->find_or_create($them);
+
%{$rel_obj} = %{$re};
- $self->set_from_related($relname, $rel_obj);
- delete $related_stuff{$relname};
+ $self->{_rel_in_storage}{$relname} = 1;
}
+
+ $self->set_from_related($relname, $rel_obj);
+ delete $related_stuff{$relname};
}
+ # start a transaction here if not started yet and there is more stuff
+ # to insert after us
+ if (keys %related_stuff) {
+ $rollback_guard ||= $source->storage->txn_scope_guard
+ }
+
MULTICREATE_DEBUG and do {
no warnings 'uninitialized';
warn "MC $self inserting (".join(', ', $self->get_columns).")\n";
@@ -332,13 +333,12 @@
## PK::Auto
my @auto_pri = grep {
- !defined $self->get_column($_) ||
- ref($self->get_column($_)) eq 'SCALAR'
+ (not defined $self->get_column($_))
+ ||
+ (ref($self->get_column($_)) eq 'SCALAR')
} $self->primary_columns;
if (@auto_pri) {
- #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
- # if defined $too_many;
MULTICREATE_DEBUG and warn "MC $self fetching missing PKs ".join(', ', @auto_pri)."\n";
my $storage = $self->result_source->storage;
$self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
@@ -353,47 +353,47 @@
$self->{_dirty_columns} = {};
$self->{related_resultsets} = {};
- if(!$self->{_rel_in_storage}) {
- ## Now do the relationships that need our ID (has_many etc.)
- foreach my $relname (keys %related_stuff) {
- my $rel_obj = $related_stuff{$relname};
- my @cands;
- if (Scalar::Util::blessed($rel_obj)
- && $rel_obj->isa('DBIx::Class::Row')) {
- @cands = ($rel_obj);
- } elsif (ref $rel_obj eq 'ARRAY') {
- @cands = @$rel_obj;
- }
- if (@cands) {
- my $reverse = $source->reverse_relationship_info($relname);
- foreach my $obj (@cands) {
- $obj->set_from_related($_, $self) for keys %$reverse;
- my $them = { %{$obj->{_relationship_data} || {} }, $obj->get_inflated_columns };
- if ($self->__their_pk_needs_us($relname, $them)) {
- if (exists $self->{_ignore_at_insert}{$relname}) {
- MULTICREATE_DEBUG and warn "MC $self skipping post-insert on $relname";
- } else {
- MULTICREATE_DEBUG and warn "MC $self re-creating $relname $obj";
- my $re = $self->result_source
- ->related_source($relname)
- ->resultset
- ->find_or_create($them);
- %{$obj} = %{$re};
- MULTICREATE_DEBUG and warn "MC $self new $relname $obj";
- }
+ foreach my $relname (keys %related_stuff) {
+ next unless $source->has_relationship ($relname);
+
+ my @cands = ref $related_stuff{$relname} eq 'ARRAY'
+ ? @{$related_stuff{$relname}}
+ : $related_stuff{$relname}
+ ;
+
+ if (@cands
+ && Scalar::Util::blessed($cands[0])
+ && $cands[0]->isa('DBIx::Class::Row')
+ ) {
+ my $reverse = $source->reverse_relationship_info($relname);
+ foreach my $obj (@cands) {
+ $obj->set_from_related($_, $self) for keys %$reverse;
+ my $them = { %{$obj->{_relationship_data} || {} }, $obj->get_inflated_columns };
+ if ($self->__their_pk_needs_us($relname, $them)) {
+ if (exists $self->{_ignore_at_insert}{$relname}) {
+ MULTICREATE_DEBUG and warn "MC $self skipping post-insert on $relname";
} else {
- MULTICREATE_DEBUG and warn "MC $self post-inserting $obj";
- $obj->insert();
+ MULTICREATE_DEBUG and warn "MC $self re-creating $relname $obj";
+ my $re = $self->result_source
+ ->related_source($relname)
+ ->resultset
+ ->create($them);
+ %{$obj} = %{$re};
+ MULTICREATE_DEBUG and warn "MC $self new $relname $obj";
}
+ } else {
+ MULTICREATE_DEBUG and warn "MC $self post-inserting $obj";
+ $obj->insert();
}
}
}
- delete $self->{_ignore_at_insert};
- $rollback_guard->commit;
}
$self->in_storage(1);
- undef $self->{_orig_ident};
+ delete $self->{_orig_ident};
+ delete $self->{_ignore_at_insert};
+ $rollback_guard->commit if $rollback_guard;
+
return $self;
}
@@ -413,7 +413,7 @@
Indicates whether the object exists as a row in the database or
not. This is set to true when L<DBIx::Class::ResultSet/find>,
L<DBIx::Class::ResultSet/create> or L<DBIx::Class::ResultSet/insert>
-are used.
+are used.
Creating a row object using L<DBIx::Class::ResultSet/new>, or calling
L</delete> on one, sets it to false.
@@ -519,14 +519,14 @@
The object is still perfectly usable, but L</in_storage> will
now return 0 and the object must be reinserted using L</insert>
-before it can be used to L</update> the row again.
+before it can be used to L</update> the row again.
If you delete an object in a class with a C<has_many> relationship, an
attempt is made to delete all the related objects as well. To turn
this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr>
hashref of the relationship, see L<DBIx::Class::Relationship>. Any
database-level cascade or restrict will take precedence over a
-DBIx-Class-based cascading delete.
+DBIx-Class-based cascading delete.
If you delete an object within a txn_do() (see L<DBIx::Class::Storage/txn_do>)
and the transaction subsequently fails, the row object will remain marked as
@@ -600,7 +600,7 @@
return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
if (exists $self->{_inflated_column}{$column}) {
return $self->store_column($column,
- $self->_deflated_column($column, $self->{_inflated_column}{$column}));
+ $self->_deflated_column($column, $self->{_inflated_column}{$column}));
}
$self->throw_exception( "No such column '${column}'" ) unless $self->has_column($column);
return undef;
@@ -702,7 +702,7 @@
Throws an exception if the column does not exist.
Marks a column as having been changed regardless of whether it has
-really changed.
+really changed.
=cut
sub make_column_dirty {
@@ -711,7 +711,7 @@
$self->throw_exception( "No such column '${column}'" )
unless exists $self->{_column_data}{$column} || $self->has_column($column);
- # the entire clean/dirty code relieas on exists, not on true/false
+ # the entire clean/dirty code relies on exists, not on true/false
return 1 if exists $self->{_dirty_columns}{$column};
$self->{_dirty_columns}{$column} = 1;
@@ -787,9 +787,12 @@
$self->store_column($column, $new_value);
my $dirty;
- if (defined $old_value xor defined $new_value) {
+ if (!$self->in_storage) { # no point tracking dirtyness on uninserted data
$dirty = 1;
}
+ elsif (defined $old_value xor defined $new_value) {
+ $dirty = 1;
+ }
elsif (not defined $old_value) { # both undef
$dirty = 0;
}
@@ -799,8 +802,8 @@
else { # do a numeric comparison if datatype allows it
my $colinfo = $self->column_info ($column);
- # cache for speed
- if (not defined $colinfo->{is_numeric}) {
+ # cache for speed (the object may *not* have a resultsource instance)
+ if (not defined $colinfo->{is_numeric} && $self->_source_handle) {
$colinfo->{is_numeric} =
$self->result_source->schema->storage->is_datatype_numeric ($colinfo->{data_type})
? 1
@@ -829,7 +832,7 @@
$row->set_columns({ $col => $val, ... });
-=over
+=over
=item Arguments: \%columndata
@@ -864,7 +867,7 @@
=back
Sets more than one column value at once. Any inflated values are
-deflated and the raw values stored.
+deflated and the raw values stored.
Any related values passed as Row objects, using the relation name as a
key, are reduced to the appropriate foreign key values and stored. If
@@ -908,7 +911,7 @@
}
}
}
- $self->set_columns($upd);
+ $self->set_columns($upd);
}
=head2 copy
@@ -954,7 +957,7 @@
$new->set_inflated_columns($changes);
$new->insert;
- # Its possible we'll have 2 relations to the same Source. We need to make
+ # Its possible we'll have 2 relations to the same Source. We need to make
# sure we don't try to insert the same row twice esle we'll violate unique
# constraints
my $rels_copied = {};
@@ -963,7 +966,7 @@
my $rel_info = $self->result_source->relationship_info($rel);
next unless $rel_info->{attrs}{cascade_copy};
-
+
my $resolved = $self->result_source->_resolve_condition(
$rel_info->{cond}, $rel, $new
);
@@ -975,7 +978,7 @@
$copied->{$id_str} = 1;
my $rel_copy = $related->copy($resolved);
}
-
+
}
return $new;
}
@@ -1050,7 +1053,6 @@
my $new = {
_source_handle => $source_handle,
_column_data => $me,
- _in_storage => 1
};
bless $new, (ref $class || $class);
@@ -1062,14 +1064,25 @@
unless $pre_source;
if (ref($pre_val->[0]) eq 'ARRAY') { # multi
my @pre_objects;
- foreach my $pre_rec (@$pre_val) {
- unless ($pre_source->primary_columns == grep { exists $pre_rec->[0]{$_}
- and defined $pre_rec->[0]{$_} } $pre_source->primary_columns) {
- next;
+
+ for my $me_pref (@$pre_val) {
+
+ # the collapser currently *could* return bogus elements with all
+ # columns set to undef
+ my $has_def;
+ for (values %{$me_pref->[0]}) {
+ if (defined $_) {
+ $has_def++;
+ last;
+ }
}
- push(@pre_objects, $pre_source->result_class->inflate_result(
- $pre_source, @{$pre_rec}));
+ next unless $has_def;
+
+ push @pre_objects, $pre_source->result_class->inflate_result(
+ $pre_source, @$me_pref
+ );
}
+
$new->related_resultset($pre)->set_cache(\@pre_objects);
} elsif (defined $pre_val->[0]) {
my $fetched;
@@ -1087,11 +1100,13 @@
} elsif ($accessor eq 'filter') {
$new->{_inflated_column}{$pre} = $fetched;
} else {
- $class->throw_exception("Prefetch not supported with accessor '$accessor'");
+ $class->throw_exception("Implicit prefetch (via select/columns) not supported with accessor '$accessor'");
}
$new->related_resultset($pre)->set_cache([ $fetched ]);
}
}
+
+ $new->in_storage (1);
return $new;
}
@@ -1260,14 +1275,53 @@
my $self = shift @_;
my $attrs = shift @_;
my $resultset = $self->result_source->resultset;
-
+
if(defined $attrs) {
- $resultset = $resultset->search(undef, $attrs);
+ $resultset = $resultset->search(undef, $attrs);
}
-
+
return $resultset->find($self->{_orig_ident} || $self->ident_condition);
}
+=head2 discard_changes ($attrs)
+
+Re-selects the row from the database, losing any changes that had
+been made.
+
+This method can also be used to refresh from storage, retrieving any
+changes made since the row was last read from storage.
+
+$attrs is expected to be a hashref of attributes suitable for passing as the
+second argument to $resultset->search($cond, $attrs);
+
+=cut
+
+sub discard_changes {
+ my ($self, $attrs) = @_;
+ delete $self->{_dirty_columns};
+ return unless $self->in_storage; # Don't reload if we aren't real!
+
+ # add a replication default to read from the master only
+ $attrs = { force_pool => 'master', %{$attrs||{}} };
+
+ if( my $current_storage = $self->get_from_storage($attrs)) {
+
+ # Set $self to the current.
+ %$self = %$current_storage;
+
+ # Avoid a possible infinite loop with
+ # sub DESTROY { $_[0]->discard_changes }
+ bless $current_storage, 'Do::Not::Exist';
+
+ return $self;
+ }
+ else {
+ $self->in_storage(0);
+ return $self;
+ }
+}
+
+
=head2 throw_exception
See L<DBIx::Class::Schema/throw_exception>.
@@ -1317,6 +1371,13 @@
changes made since the row was last read from storage. Actually
implemented in L<DBIx::Class::PK>
+Note: If you are using L<DBIx::Class::Storage::DBI::Replicated> as your
+storage, please kept in mind that if you L</discard_changes> on a row that you
+just updated or created, you should wrap the entire bit inside a transaction.
+Otherwise you run the risk that you insert or update to the master database
+but read from a replicant database that has not yet been updated from the
+master. This will result in unexpected results.
+
=cut
1;
Added: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/SQLAHacks/MSSQL.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/SQLAHacks/MSSQL.pm (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/SQLAHacks/MSSQL.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,33 @@
+package # Hide from PAUSE
+ DBIx::Class::SQLAHacks::MSSQL;
+
+use base qw( DBIx::Class::SQLAHacks );
+use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
+
+#
+# MSSQL is retarded wrt TOP (crappy limit) and ordering.
+# One needs to add a TOP to *all* ordered subqueries, if
+# TOP has been used in the statement at least once.
+# Do it here.
+#
+sub select {
+ my $self = shift;
+
+ my ($sql, @bind) = $self->SUPER::select (@_);
+
+ # ordering was requested and there are at least 2 SELECT/FROM pairs
+ # (thus subquery), and there is no TOP specified
+ if (
+ $sql =~ /\bSELECT\b .+? \bFROM\b .+? \bSELECT\b .+? \bFROM\b/isx
+ &&
+ $sql !~ /^ \s* SELECT \s+ TOP \s+ \d+ /xi
+ &&
+ scalar $self->_order_by_chunks ($_[3]->{order_by})
+ ) {
+ $sql =~ s/^ \s* SELECT \s/SELECT TOP 100 PERCENT /xi;
+ }
+
+ return wantarray ? ($sql, @bind) : $sql;
+}
+
+1;
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/SQLAHacks/MySQL.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/SQLAHacks/MySQL.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/SQLAHacks/MySQL.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -12,7 +12,7 @@
my $self = shift;
my $table = $_[0];
- $table = $self->_quote($table) unless ref($table);
+ $table = $self->_quote($table);
if (! $_[1] or (ref $_[1] eq 'HASH' and !keys %{$_[1]} ) ) {
return "INSERT INTO ${table} () VALUES ()"
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/SQLAHacks.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/SQLAHacks.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/SQLAHacks.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,6 +1,10 @@
package # Hide from PAUSE
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 the
+# SQLA core
+
use base qw/SQL::Abstract::Limit/;
use strict;
use warnings;
@@ -12,12 +16,13 @@
no warnings qw/redefine/;
no strict qw/refs/;
for my $f (qw/carp croak/) {
+
my $orig = \&{"SQL::Abstract::$f"};
*{"SQL::Abstract::$f"} = sub {
local $Carp::CarpLevel = 1; # even though Carp::Clan ignores this, $orig will not
- if (Carp::longmess() =~ /DBIx::Class::SQLAHacks::[\w]+\(\) called/) {
+ if (Carp::longmess() =~ /DBIx::Class::SQLAHacks::[\w]+ .+? called \s at/x) {
__PACKAGE__->can($f)->(@_);
}
else {
@@ -27,6 +32,9 @@
}
}
+
+# Tries to determine limit dialect.
+#
sub new {
my $self = shift->SUPER::new(@_);
@@ -39,14 +47,12 @@
$self;
}
-
# Some databases (sqlite) do not handle multiple parenthesis
-# around in/between arguments. A tentative x IN ( ( 1, 2 ,3) )
+# 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) = @_;
@@ -116,41 +122,195 @@
sub _Top {
my ( $self, $sql, $order, $rows, $offset ) = @_;
+ # mangle the input sql so it can be properly aliased in the outer queries
+ $sql =~ s/^ \s* SELECT \s+ (.+?) \s+ (?=FROM)//ix
+ or croak "Unrecognizable SELECT: $sql";
+ my $sql_select = $1;
+ my @sql_select = split (/\s*,\s*/, $sql_select);
+
+ # we can't support subqueries (in fact MSSQL can't) - croak
+ if (@sql_select != @{$self->{_dbic_rs_attrs}{select}}) {
+ croak (sprintf (
+ 'SQL SELECT did not parse cleanly - retrieved %d comma separated elements, while '
+ . 'the resultset select attribure contains %d elements: %s',
+ scalar @sql_select,
+ scalar @{$self->{_dbic_rs_attrs}{select}},
+ $sql_select,
+ ));
+ }
+
+ my $name_sep = $self->name_sep || '.';
+ my $esc_name_sep = "\Q$name_sep\E";
+ my $col_re = qr/ ^ (?: (.+) $esc_name_sep )? ([^$esc_name_sep]+) $ /x;
+
+ my $rs_alias = $self->{_dbic_rs_attrs}{alias};
+ my $quoted_rs_alias = $self->_quote ($rs_alias);
+
+ # construct the new select lists, rename(alias) some columns if necessary
+ my (@outer_select, @inner_select, %seen_names, %col_aliases, %outer_col_aliases);
+
+ for (@{$self->{_dbic_rs_attrs}{select}}) {
+ next if ref $_;
+ my ($table, $orig_colname) = ( $_ =~ $col_re );
+ next unless $table;
+ $seen_names{$orig_colname}++;
+ }
+
+ for my $i (0 .. $#sql_select) {
+
+ my $colsel_arg = $self->{_dbic_rs_attrs}{select}[$i];
+ my $colsel_sql = $sql_select[$i];
+
+ # this may or may not work (in case of a scalarref or something)
+ my ($table, $orig_colname) = ( $colsel_arg =~ $col_re );
+
+ my $quoted_alias;
+ # do not attempt to understand non-scalar selects - alias numerically
+ if (ref $colsel_arg) {
+ $quoted_alias = $self->_quote ('column_' . (@inner_select + 1) );
+ }
+ # column name seen more than once - alias it
+ elsif ($orig_colname &&
+ ($seen_names{$orig_colname} && $seen_names{$orig_colname} > 1) ) {
+ $quoted_alias = $self->_quote ("${table}__${orig_colname}");
+ }
+
+ # we did rename - make a record and adjust
+ if ($quoted_alias) {
+ # alias inner
+ push @inner_select, "$colsel_sql AS $quoted_alias";
+
+ # push alias to outer
+ push @outer_select, $quoted_alias;
+
+ # Any aliasing accumulated here will be considered
+ # both for inner and outer adjustments of ORDER BY
+ $self->__record_alias (
+ \%col_aliases,
+ $quoted_alias,
+ $colsel_arg,
+ $table ? $orig_colname : undef,
+ );
+ }
+
+ # otherwise just leave things intact inside, and use the abbreviated one outside
+ # (as we do not have table names anymore)
+ else {
+ push @inner_select, $colsel_sql;
+
+ my $outer_quoted = $self->_quote ($orig_colname); # it was not a duplicate so should just work
+ push @outer_select, $outer_quoted;
+ $self->__record_alias (
+ \%outer_col_aliases,
+ $outer_quoted,
+ $colsel_arg,
+ $table ? $orig_colname : undef,
+ );
+ }
+ }
+
+ my $outer_select = join (', ', @outer_select );
+ my $inner_select = join (', ', @inner_select );
+
+ %outer_col_aliases = (%outer_col_aliases, %col_aliases);
+
+ # deal with order
croak '$order supplied to SQLAHacks limit emulators must be a hash'
if (ref $order ne 'HASH');
$order = { %$order }; #copy
- my $last = $rows + $offset;
+ my $req_order = $order->{order_by};
- my $req_order = $self->_order_by ($order->{order_by});
+ # examine normalized version, collapses nesting
+ my $limit_order;
+ if (scalar $self->_order_by_chunks ($req_order)) {
+ $limit_order = $req_order;
+ }
+ else {
+ $limit_order = [ map
+ { join ('', $rs_alias, $name_sep, $_ ) }
+ ( $self->{_dbic_rs_attrs}{_source_handle}->resolve->primary_columns )
+ ];
+ }
- my $limit_order = $req_order ? $order->{order_by} : $order->{_virtual_order_by};
+ my ( $order_by_inner, $order_by_outer ) = $self->_order_directions($limit_order);
+ my $order_by_requested = $self->_order_by ($req_order);
- delete $order->{$_} for qw/order_by _virtual_order_by/;
+ # generate the rest
+ delete $order->{order_by};
my $grpby_having = $self->_order_by ($order);
- my ( $order_by_inner, $order_by_outer ) = $self->_order_directions($limit_order);
+ # short circuit for counts - the ordering complexity is needless
+ if ($self->{_dbic_rs_attrs}{-for_count_only}) {
+ return "SELECT TOP $rows $inner_select $sql $grpby_having $order_by_outer";
+ }
- $sql =~ s/^\s*(SELECT|select)//;
+ # we can't really adjust the order_by columns, as introspection is lacking
+ # resort to simple substitution
+ for my $col (keys %outer_col_aliases) {
+ for ($order_by_requested, $order_by_outer) {
+ $_ =~ s/\s+$col\s+/ $outer_col_aliases{$col} /g;
+ }
+ }
+ for my $col (keys %col_aliases) {
+ $order_by_inner =~ s/\s+$col\s+/ $col_aliases{$col} /g;
+ }
- $sql = <<"SQL";
- SELECT * FROM
- (
- SELECT TOP $rows * FROM
+
+ my $inner_lim = $rows + $offset;
+
+ $sql = "SELECT TOP $inner_lim $inner_select $sql $grpby_having $order_by_inner";
+
+ if ($offset) {
+ $sql = <<"SQL";
+
+ SELECT TOP $rows $outer_select FROM
(
- SELECT TOP $last $sql $grpby_having $order_by_inner
- ) AS foo
+ $sql
+ ) $quoted_rs_alias
$order_by_outer
- ) AS bar
- $req_order
+SQL
+ }
+
+ if ($order_by_requested) {
+ $sql = <<"SQL";
+
+ SELECT $outer_select FROM
+ ( $sql ) $quoted_rs_alias
+ $order_by_requested
SQL
- return $sql;
+
+ }
+
+ $sql =~ s/\s*\n\s*/ /g; # parsing out multiline statements is harder than a single line
+ return $sql;
}
+# action at a distance to shorten Top code above
+sub __record_alias {
+ my ($self, $register, $alias, $fqcol, $col) = @_;
+ # record qualified name
+ $register->{$fqcol} = $alias;
+ $register->{$self->_quote($fqcol)} = $alias;
+ return unless $col;
+
+ # record unqualified name, undef (no adjustment) if a duplicate is found
+ if (exists $register->{$col}) {
+ $register->{$col} = undef;
+ }
+ else {
+ $register->{$col} = $alias;
+ }
+
+ $register->{$self->_quote($col)} = $register->{$col};
+}
+
+
+
# While we're at it, this should make LIMIT queries more efficient,
# without digging into things too deeply
sub _find_syntax {
@@ -158,17 +318,21 @@
return $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
}
+my $for_syntax = {
+ update => 'FOR UPDATE',
+ shared => 'FOR SHARE',
+};
+# Quotes table names, handles "limit" dialects (e.g. where rownum between x and
+# y), supports SELECT ... FOR UPDATE and SELECT ... FOR SHARE.
sub select {
my ($self, $table, $fields, $where, $order, @rest) = @_;
$self->{"${_}_bind"} = [] for (qw/having from order/);
- if (ref $table eq 'SCALAR') {
- $table = $$table;
- }
- elsif (not ref $table) {
+ if (not ref($table) or ref($table) eq 'SCALAR') {
$table = $self->_quote($table);
}
+
local $self->{rownum_hack_count} = 1
if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
@rest = (-1) unless defined $rest[0];
@@ -177,22 +341,18 @@
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' :
- ''
- ) :
- ''
- ;
+ if (my $for = delete $self->{_dbic_rs_attrs}{for}) {
+ $sql .= " $for_syntax->{$for}" if $for_syntax->{$for};
+ }
+
return wantarray ? ($sql, @{$self->{from_bind}}, @where_bind, @{$self->{having_bind}}, @{$self->{order_bind}} ) : $sql;
}
+# Quotes table names, and handles default inserts
sub insert {
my $self = shift;
my $table = shift;
- $table = $self->_quote($table) unless ref($table);
+ $table = $self->_quote($table);
# SQLA will emit INSERT INTO $table ( ) VALUES ( )
# which is sadly understood only by MySQL. Change default behavior here,
@@ -204,17 +364,19 @@
$self->SUPER::insert($table, @_);
}
+# Just quotes table names.
sub update {
my $self = shift;
my $table = shift;
- $table = $self->_quote($table) unless ref($table);
+ $table = $self->_quote($table);
$self->SUPER::update($table, @_);
}
+# Just quotes table names.
sub delete {
my $self = shift;
my $table = shift;
- $table = $self->_quote($table) unless ref($table);
+ $table = $self->_quote($table);
$self->SUPER::delete($table, @_);
}
@@ -240,28 +402,37 @@
? ' 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 (
- 'The select => { distinct => ... } syntax is not supported for multiple columns.'
- .' Instead please use { group_by => [ qw/' . (join ' ', @$_fields) . '/ ] }'
- .' or { select => [ qw/' . (join ' ', @$_fields) . '/ ], distinct => 1 }'
- );
- }
- else {
- $_fields = @{$_fields}[0] if ref $_fields eq 'ARRAY';
- carp (
- 'The select => { distinct => ... } syntax will be deprecated in DBIC version 0.09,'
- ." please use { group_by => '${_fields}' } or { select => '${_fields}', distinct => 1 }"
- );
- }
- }
- return $self->_sqlcase($func)
- .'( '.$self->_recurse_fields($fields->{$func}).' )';
+ }
+ elsif ($ref eq 'HASH') {
+ my %hash = %$fields;
+
+ my $as = delete $hash{-as}; # if supplied
+
+ my ($func, $args) = each %hash;
+ delete $hash{$func};
+
+ if (lc ($func) eq 'distinct' && ref $args eq 'ARRAY' && @$args > 1) {
+ croak (
+ 'The select => { distinct => ... } syntax is not supported for multiple columns.'
+ .' Instead please use { group_by => [ qw/' . (join ' ', @$args) . '/ ] }'
+ .' or { select => [ qw/' . (join ' ', @$args) . '/ ], distinct => 1 }'
+ );
}
+
+ my $select = sprintf ('%s( %s )%s',
+ $self->_sqlcase($func),
+ $self->_recurse_fields($args),
+ $as
+ ? sprintf (' %s %s', $self->_sqlcase('as'), $as)
+ : ''
+ );
+
+ # there should be nothing left
+ if (keys %hash) {
+ croak "Malformed select argument - too many keys in hash: " . join (',', keys %$fields );
+ }
+
+ return $select;
}
# Is the second check absolutely necessary?
elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
@@ -279,9 +450,8 @@
my $ret = '';
- if (defined $arg->{group_by}) {
- $ret = $self->_sqlcase(' group by ')
- .$self->_recurse_fields($arg->{group_by}, { no_rownum_hack => 1 });
+ if (my $g = $self->_recurse_fields($arg->{group_by}, { no_rownum_hack => 1 }) ) {
+ $ret = $self->_sqlcase(' group by ') . $g;
}
if (defined $arg->{having}) {
@@ -410,6 +580,7 @@
sub _quote {
my ($self, $label) = @_;
return '' unless defined $label;
+ return $$label if ref($label) eq 'SCALAR';
return "*" if $label eq '*';
return $label unless $self->{quote_char};
if(ref $self->{quote_char} eq "ARRAY"){
@@ -429,12 +600,15 @@
return $self->{limit_dialect};
}
+# Set to an array-ref to specify separate left and right quotes for table names.
+# A single scalar is equivalen to [ $char, $char ]
sub quote_char {
my $self = shift;
$self->{quote_char} = shift if @_;
return $self->{quote_char};
}
+# Character separating quoted table names.
sub name_sep {
my $self = shift;
$self->{name_sep} = shift if @_;
@@ -442,50 +616,3 @@
}
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/prefetch/lib/DBIx/Class/Schema/Versioned.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Schema/Versioned.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Schema/Versioned.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -308,7 +308,7 @@
# here to be sure.
# XXX - just fix it
$self->storage->sqlt_type;
-
+
my $upgrade_file = $self->ddl_filename(
$self->storage->sqlt_type,
$self->schema_version,
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Schema.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Schema.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Schema.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -7,9 +7,8 @@
use Carp::Clan qw/^DBIx::Class/;
use Scalar::Util qw/weaken/;
use File::Spec;
-use MRO::Compat;
use Sub::Name ();
-require Module::Find;
+use Module::Find();
use base qw/DBIx::Class/;
@@ -43,7 +42,7 @@
$dsn,
$user,
$password,
- { AutoCommit => 0 },
+ { AutoCommit => 1 },
);
my $schema2 = Library::Schema->connect($coderef_returning_dbh);
@@ -512,7 +511,7 @@
general.
Note that C<connect_info> expects an arrayref of arguments, but
-C<connect> does not. C<connect> wraps it's arguments in an arrayref
+C<connect> does not. C<connect> wraps its arguments in an arrayref
before passing them to C<connect_info>.
=head3 Overloading
@@ -544,6 +543,8 @@
sub resultset {
my ($self, $moniker) = @_;
+ $self->throw_exception('resultset() expects a source name')
+ unless defined $moniker;
return $self->source($moniker)->resultset;
}
@@ -756,7 +757,7 @@
[ 2, 'Indie Band' ],
...
]);
-
+
Since wantarray context is basically the same as looping over $rs->create(...)
you won't see any performance benefits and in this case the method is more for
convenience. Void context sends the column information directly to storage
@@ -807,10 +808,10 @@
sub connection {
my ($self, @info) = @_;
return $self if !@info && $self->storage;
-
+
my ($storage_class, $args) = ref $self->storage_type ?
($self->_normalize_storage_type($self->storage_type),{}) : ($self->storage_type, {});
-
+
$storage_class = 'DBIx::Class::Storage'.$storage_class
if $storage_class =~ m/^::/;
eval "require ${storage_class};";
@@ -1125,6 +1126,19 @@
You may override this method in your schema if you wish to use a different
format.
+ WARNING
+
+ Prior to DBIx::Class version 0.08100 this method had a different signature:
+
+ my $filename = $table->ddl_filename($type, $dir, $version, $preversion)
+
+ In recent versions variables $dir and $version were reversed in order to
+ bring the signature in line with other Schema/Storage methods. If you
+ really need to maintain backward compatibility, you can do the following
+ in any overriding methods:
+
+ ($dir, $version) = ($version, $dir) if ($DBIx::Class::VERSION < 0.08100);
+
=cut
sub ddl_filename {
@@ -1134,7 +1148,7 @@
$filename =~ s/::/-/g;
$filename = File::Spec->catfile($dir, "$filename-$version-$type.sql");
$filename =~ s/$version/$preversion-$version/ if($preversion);
-
+
return $filename;
}
@@ -1360,7 +1374,7 @@
$self->throw_exception
("No arguments to load_classes and couldn't load ${base} ($@)")
if $@;
-
+
if ($self eq $target) {
# Pathological case, largely caused by the docs on early C::M::DBIC::Plain
foreach my $moniker ($self->sources) {
@@ -1373,14 +1387,14 @@
$self->connection(@info);
return $self;
}
-
+
my $schema = $self->compose_namespace($target, $base);
{
no strict 'refs';
my $name = join '::', $target, 'schema';
*$name = Sub::Name::subname $name, sub { $schema };
}
-
+
$schema->connection(@info);
foreach my $moniker ($schema->sources) {
my $source = $schema->source($moniker);
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/StartupCheck.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/StartupCheck.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/StartupCheck.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -7,7 +7,7 @@
=head1 SYNOPSIS
use DBIx::Class::StartupCheck;
-
+
=head1 DESCRIPTION
This module used to check for, and if necessary issue a warning for, a
Added: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/AmbiguousGlob.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/AmbiguousGlob.pm (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/AmbiguousGlob.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,44 @@
+package DBIx::Class::Storage::DBI::AmbiguousGlob;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Storage::DBI';
+use mro 'c3';
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::AmbiguousGlob - Storage component for RDBMS supporting multicolumn in clauses
+
+=head1 DESCRIPTION
+
+Some servers choke on things like:
+
+ COUNT(*) FROM (SELECT tab1.col, tab2.col FROM tab1 JOIN tab2 ... )
+
+claiming that col is a duplicate column (it loses the table specifiers by
+the time it gets to the *). Thus for any subquery count we select only the
+primary keys of the main table in the inner query. This hopefully still
+hits the indexes and keeps the server happy.
+
+At this point the only overriden method is C<_subq_count_select()>
+
+=cut
+
+sub _subq_count_select {
+ my ($self, $source, $rs_attrs) = @_;
+ my @pcols = map { join '.', $rs_attrs->{alias}, $_ } ($source->primary_columns);
+ return @pcols ? \@pcols : [ 1 ];
+}
+
+=head1 AUTHORS
+
+See L<DBIx::Class/CONTRIBUTORS>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+1;
Property changes on: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/AmbiguousGlob.pm
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Cursor.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Cursor.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Cursor.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,10 +1,10 @@
package DBIx::Class::Storage::DBI::Cursor;
-use base qw/DBIx::Class::Cursor/;
-
use strict;
use warnings;
+use base qw/DBIx::Class::Cursor/;
+
=head1 NAME
DBIx::Class::Storage::DBI::Cursor - Object representing a query cursor on a
@@ -68,7 +68,11 @@
my ($storage, $dbh, $self) = @_;
$self->_check_dbh_gen;
- if ($self->{attrs}{rows} && $self->{pos} >= $self->{attrs}{rows}) {
+ if (
+ $self->{attrs}{software_limit}
+ && $self->{attrs}{rows}
+ && $self->{pos} >= $self->{attrs}{rows}
+ ) {
$self->{sth}->finish if $self->{sth}->{Active};
delete $self->{sth};
$self->{done} = 1;
@@ -128,6 +132,7 @@
&& ($self->{attrs}{offset} || $self->{attrs}{rows})) {
return $self->next::method;
}
+
$self->{storage}->dbh_do($self->can('_dbh_all'), $self);
}
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/DB2.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/DB2.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/DB2.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -4,9 +4,8 @@
use warnings;
use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
-# __PACKAGE__->load_components(qw/PK::Auto/);
-
sub _dbh_last_insert_id {
my ($self, $dbh, $source, $col) = @_;
@@ -22,11 +21,11 @@
sub _sql_maker_opts {
my ( $self, $opts ) = @_;
-
+
if ( $opts ) {
$self->{_sql_maker_opts} = { %$opts };
}
-
+
return { limit_dialect => 'RowNumberOver', %{$self->{_sql_maker_opts}||{}} };
}
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/MSSQL.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/MSSQL.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/MSSQL.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -3,14 +3,166 @@
use strict;
use warnings;
-use base qw/DBIx::Class::Storage::DBI/;
+use base qw/DBIx::Class::Storage::DBI::AmbiguousGlob DBIx::Class::Storage::DBI/;
+use mro 'c3';
-sub _dbh_last_insert_id {
- my ($self, $dbh, $source, $col) = @_;
- my ($id) = $dbh->selectrow_array('SELECT SCOPE_IDENTITY()');
- return $id;
+use List::Util();
+
+__PACKAGE__->mk_group_accessors(simple => qw/
+ _identity _identity_method
+/);
+
+__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MSSQL');
+
+sub insert_bulk {
+ my $self = shift;
+ my ($source, $cols, $data) = @_;
+
+ my $identity_insert = 0;
+
+ COLUMNS:
+ foreach my $col (@{$cols}) {
+ if ($source->column_info($col)->{is_auto_increment}) {
+ $identity_insert = 1;
+ last COLUMNS;
+ }
+ }
+
+ if ($identity_insert) {
+ my $table = $source->from;
+ $self->_get_dbh->do("SET IDENTITY_INSERT $table ON");
+ }
+
+ $self->next::method(@_);
+
+ if ($identity_insert) {
+ my $table = $source->from;
+ $self->_get_dbh->do("SET IDENTITY_INSERT $table OFF");
+ }
}
+# support MSSQL GUID column types
+
+sub insert {
+ my $self = shift;
+ my ($source, $to_insert) = @_;
+
+ my $updated_cols = {};
+
+ my %guid_cols;
+ my @pk_cols = $source->primary_columns;
+ my %pk_cols;
+ @pk_cols{@pk_cols} = ();
+
+ my @pk_guids = grep {
+ $source->column_info($_)->{data_type}
+ &&
+ $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i
+ } @pk_cols;
+
+ my @auto_guids = grep {
+ $source->column_info($_)->{data_type}
+ &&
+ $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i
+ &&
+ $source->column_info($_)->{auto_nextval}
+ } grep { not exists $pk_cols{$_} } $source->columns;
+
+ my @get_guids_for =
+ grep { not exists $to_insert->{$_} } (@pk_guids, @auto_guids);
+
+ for my $guid_col (@get_guids_for) {
+ my ($new_guid) = $self->_get_dbh->selectrow_array('SELECT NEWID()');
+ $updated_cols->{$guid_col} = $to_insert->{$guid_col} = $new_guid;
+ }
+
+ $updated_cols = { %$updated_cols, %{ $self->next::method(@_) } };
+
+ return $updated_cols;
+}
+
+sub _prep_for_execute {
+ my $self = shift;
+ my ($op, $extra_bind, $ident, $args) = @_;
+
+# cast MONEY values properly
+ if ($op eq 'insert' || $op eq 'update') {
+ my $fields = $args->[0];
+
+ for my $col (keys %$fields) {
+ # $ident is a result source object with INSERT/UPDATE ops
+ if ($ident->column_info ($col)->{data_type}
+ &&
+ $ident->column_info ($col)->{data_type} =~ /^money\z/i) {
+ my $val = $fields->{$col};
+ $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
+ }
+ }
+ }
+
+ my ($sql, $bind) = $self->next::method (@_);
+
+ if ($op eq 'insert') {
+ $sql .= ';SELECT SCOPE_IDENTITY()';
+
+ my $col_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]);
+ if (List::Util::first { $_->{is_auto_increment} } (values %$col_info) ) {
+
+ my $table = $ident->from;
+ my $identity_insert_on = "SET IDENTITY_INSERT $table ON";
+ my $identity_insert_off = "SET IDENTITY_INSERT $table OFF";
+ $sql = "$identity_insert_on; $sql; $identity_insert_off";
+ }
+ }
+
+ return ($sql, $bind);
+}
+
+sub _execute {
+ my $self = shift;
+ my ($op) = @_;
+
+ my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
+
+ if ($op eq 'insert') {
+
+ # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked
+ # on in _prep_for_execute above
+ my ($identity) = $sth->fetchrow_array;
+
+ # SCOPE_IDENTITY failed, but we can do something else
+ if ( (! $identity) && $self->_identity_method) {
+ ($identity) = $self->_dbh->selectrow_array(
+ 'select ' . $self->_identity_method
+ );
+ }
+
+ $self->_identity($identity);
+ $sth->finish;
+ }
+
+ return wantarray ? ($rv, $sth, @bind) : $rv;
+}
+
+sub last_insert_id { shift->_identity }
+
+# savepoint syntax is the same as in Sybase ASE
+
+sub _svp_begin {
+ my ($self, $name) = @_;
+
+ $self->_get_dbh->do("SAVE TRANSACTION $name");
+}
+
+# A new SAVE TRANSACTION with the same name releases the previous one.
+sub _svp_release { 1 }
+
+sub _svp_rollback {
+ my ($self, $name) = @_;
+
+ $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
+}
+
sub build_datetime_parser {
my $self = shift;
my $type = "DateTime::Format::Strptime";
@@ -22,49 +174,51 @@
sub sqlt_type { 'SQLServer' }
sub _sql_maker_opts {
- my ( $self, $opts ) = @_;
+ my ( $self, $opts ) = @_;
- if ( $opts ) {
- $self->{_sql_maker_opts} = { %$opts };
- }
+ if ( $opts ) {
+ $self->{_sql_maker_opts} = { %$opts };
+ }
- return { limit_dialect => 'Top', %{$self->{_sql_maker_opts}||{}} };
+ return { limit_dialect => 'Top', %{$self->{_sql_maker_opts}||{}} };
}
1;
=head1 NAME
-DBIx::Class::Storage::DBI::MSSQL - Storage::DBI subclass for MSSQL
+DBIx::Class::Storage::DBI::MSSQL - Base Class for Microsoft SQL Server support
+in DBIx::Class
=head1 SYNOPSIS
-This subclass supports MSSQL, and can in theory be used directly
-via the C<storage_type> mechanism:
+This is the base class for Microsoft SQL Server support, used by
+L<DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server> and
+L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
- $schema->storage_type('::DBI::MSSQL');
- $schema->connect_info('dbi:....', ...);
+=head1 IMPLEMENTATION NOTES
-However, as there is no L<DBD::MSSQL>, you will probably want to use
-one of the other DBD-specific MSSQL classes, such as
-L<DBIx::Class::Storage::DBI::Sybase::MSSQL>. These classes will
-merge this class with a DBD-specific class to obtain fully
-correct behavior for your scenario.
+Microsoft SQL Server supports three methods of retrieving the IDENTITY
+value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
+SCOPE_IDENTITY is used here because it is the safest. However, it must
+be called is the same execute statement, not just the same connection.
-=head1 METHODS
+So, this implementation appends a SELECT SCOPE_IDENTITY() statement
+onto each INSERT to accommodate that requirement.
-=head2 last_insert_id
+C<SELECT @@IDENTITY> can also be used by issuing:
-=head2 sqlt_type
+ $self->_identity_method('@@identity');
-=head2 build_datetime_parser
+it will only be used if SCOPE_IDENTITY() fails.
-The resulting parser handles the MSSQL C<DATETIME> type, but is almost
-certainly not sufficient for the other MSSQL 2008 date/time types.
+This is more dangerous, as inserting into a table with an on insert trigger that
+inserts into another table with an identity will give erroneous results on
+recent versions of SQL Server.
-=head1 AUTHORS
+=head1 AUTHOR
-Brian Cassidy <bricas at cpan.org>
+See L<DBIx::Class/CONTRIBUTORS>.
=head1 LICENSE
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -4,6 +4,7 @@
use warnings;
use base 'DBIx::Class::Storage::DBI';
+use mro 'c3';
=head1 NAME
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/NoBindVars.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/NoBindVars.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/NoBindVars.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -4,6 +4,7 @@
use warnings;
use base 'DBIx::Class::Storage::DBI';
+use mro 'c3';
=head1 NAME
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC/ACCESS.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC/ACCESS.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC/ACCESS.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -2,9 +2,11 @@
use strict;
use warnings;
-use DBI;
use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+use DBI;
+
my $ERR_MSG_START = __PACKAGE__ . ' failed: ';
sub insert {
@@ -38,11 +40,11 @@
sub bind_attribute_by_data_type {
my $self = shift;
-
+
my ( $data_type ) = @_;
-
+
return { TYPE => $data_type } if $data_type == DBI::SQL_LONGVARCHAR;
-
+
return;
}
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -3,6 +3,7 @@
use warnings;
use base qw/DBIx::Class::Storage::DBI::ODBC/;
+use mro 'c3';
sub _dbh_last_insert_id {
my ($self, $dbh, $source, $col) = @_;
@@ -22,7 +23,7 @@
sub _sql_maker_opts {
my ($self) = @_;
-
+
$self->dbh_do(sub {
my ($self, $dbh) = @_;
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -3,64 +3,182 @@
use warnings;
use base qw/DBIx::Class::Storage::DBI::MSSQL/;
+use mro 'c3';
-sub _prep_for_execute {
- my $self = shift;
- my ($op, $extra_bind, $ident, $args) = @_;
+use Carp::Clan qw/^DBIx::Class/;
+use List::Util();
+use Scalar::Util ();
- my ($sql, $bind) = $self->next::method (@_);
- $sql .= ';SELECT SCOPE_IDENTITY()' if $op eq 'insert';
+__PACKAGE__->mk_group_accessors(simple => qw/
+ _using_dynamic_cursors
+/);
- return ($sql, $bind);
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server - Support specific
+to Microsoft SQL Server over ODBC
+
+=head1 DESCRIPTION
+
+This class implements support specific to Microsoft SQL Server over ODBC. It is
+loaded automatically by by DBIx::Class::Storage::DBI::ODBC when it detects a
+MSSQL back-end.
+
+Most of the functionality is provided from the superclass
+L<DBIx::Class::Storage::DBI::MSSQL>.
+
+=head1 MULTIPLE ACTIVE STATEMENTS
+
+The following options are alternative ways to enable concurrent executing
+statement support. Each has its own advantages and drawbacks.
+
+=head2 connect_call_use_dynamic_cursors
+
+Use as:
+
+ on_connect_call => 'use_dynamic_cursors'
+
+in your L<DBIx::Class::Storage::DBI/connect_info> as one way to enable multiple
+concurrent statements.
+
+Will add C<< odbc_cursortype => 2 >> to your DBI connection attributes. See
+L<DBD::ODBC/odbc_cursortype> for more information.
+
+Alternatively, you can add it yourself and dynamic cursor support will be
+automatically enabled.
+
+If you're using FreeTDS, C<tds_version> must be set to at least C<8.0>.
+
+This will not work with CODE ref connect_info's.
+
+B<WARNING:> this will break C<SCOPE_IDENTITY()>, and C<SELECT @@IDENTITY> will
+be used instead, which on SQL Server 2005 and later will return erroneous
+results on tables which have an on insert trigger that inserts into another
+table with an C<IDENTITY> column.
+
+=cut
+
+sub connect_call_use_dynamic_cursors {
+ my $self = shift;
+
+ if (ref($self->_dbi_connect_info->[0]) eq 'CODE') {
+ croak 'cannot set DBI attributes on a CODE ref connect_info';
+ }
+
+ my $dbi_attrs = $self->_dbi_connect_info->[-1];
+
+ unless (ref($dbi_attrs) && Scalar::Util::reftype($dbi_attrs) eq 'HASH') {
+ $dbi_attrs = {};
+ push @{ $self->_dbi_connect_info }, $dbi_attrs;
+ }
+
+ if (not exists $dbi_attrs->{odbc_cursortype}) {
+ # turn on support for multiple concurrent statements, unless overridden
+ $dbi_attrs->{odbc_cursortype} = 2;
+ $self->disconnect; # resetting dbi attrs, so have to reconnect
+ $self->ensure_connected;
+ $self->_set_dynamic_cursors;
+ }
}
-sub _execute {
- my $self = shift;
- my ($op) = @_;
+sub _set_dynamic_cursors {
+ my $self = shift;
+ my $dbh = $self->_get_dbh;
- my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
- if ($op eq 'insert') {
- $self->{_scope_identity} = $sth->fetchrow_array;
- $sth->finish;
- }
+ eval {
+ local $dbh->{RaiseError} = 1;
+ local $dbh->{PrintError} = 0;
+ $dbh->do('SELECT @@IDENTITY');
+ };
+ if ($@) {
+ croak <<'EOF';
- return wantarray ? ($rv, $sth, @bind) : $rv;
+Your drivers do not seem to support dynamic cursors (odbc_cursortype => 2),
+if you're using FreeTDS, make sure to set tds_version to 8.0 or greater.
+EOF
+ }
+
+ $self->_using_dynamic_cursors(1);
+ $self->_identity_method('@@identity');
}
-sub last_insert_id { shift->{_scope_identity} }
+sub _rebless {
+ no warnings 'uninitialized';
+ my $self = shift;
-1;
+ if (ref($self->_dbi_connect_info->[0]) ne 'CODE' &&
+ eval { $self->_dbi_connect_info->[-1]{odbc_cursortype} } == 2) {
+ $self->_set_dynamic_cursors;
+ return;
+ }
-__END__
+ $self->_using_dynamic_cursors(0);
+}
-=head1 NAME
+=head2 connect_call_use_server_cursors
-DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server - Support specific
-to Microsoft SQL Server over ODBC
+Use as:
-=head1 DESCRIPTION
+ on_connect_call => 'use_server_cursors'
-This class implements support specific to Microsoft SQL Server over ODBC,
-including auto-increment primary keys and SQL::Abstract::Limit dialect. It
-is loaded automatically by by DBIx::Class::Storage::DBI::ODBC when it
-detects a MSSQL back-end.
+May allow multiple active select statements. See
+L<DBD::ODBC/odbc_SQL_ROWSET_SIZE> for more information.
-=head1 IMPLEMENTATION NOTES
+Takes an optional parameter for the value to set the attribute to, default is
+C<2>.
-Microsoft SQL Server supports three methods of retrieving the IDENTITY
-value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
-SCOPE_IDENTITY is used here because it is the safest. However, it must
-be called is the same execute statement, not just the same connection.
+B<WARNING>: this does not work on all versions of SQL Server, and may lock up
+your database!
-So, this implementation appends a SELECT SCOPE_IDENTITY() statement
-onto each INSERT to accommodate that requirement.
+=cut
-=head1 AUTHORS
+sub connect_call_use_server_cursors {
+ my $self = shift;
+ my $sql_rowset_size = shift || 2;
-Marc Mims C<< <marc at questright.com> >>
+ $self->_get_dbh->{odbc_SQL_ROWSET_SIZE} = $sql_rowset_size;
+}
+=head2 connect_call_use_MARS
+
+Use as:
+
+ on_connect_call => 'use_MARS'
+
+Use to enable a feature of SQL Server 2005 and later, "Multiple Active Result
+Sets". See L<DBD::ODBC::FAQ/Does DBD::ODBC support Multiple Active Statements?>
+for more information.
+
+B<WARNING>: This has implications for the way transactions are handled.
+
+=cut
+
+sub connect_call_use_MARS {
+ my $self = shift;
+
+ my $dsn = $self->_dbi_connect_info->[0];
+
+ if (ref($dsn) eq 'CODE') {
+ croak 'cannot change the DBI DSN on a CODE ref connect_info';
+ }
+
+ if ($dsn !~ /MARS_Connection=/) {
+ $self->_dbi_connect_info->[0] = "$dsn;MARS_Connection=Yes";
+ my $was_connected = defined $self->_dbh;
+ $self->disconnect;
+ $self->ensure_connected if $was_connected;
+ }
+}
+
+1;
+
+=head1 AUTHOR
+
+See L<DBIx::Class/CONTRIBUTORS>.
+
=head1 LICENSE
You may distribute this code under the same terms as Perl itself.
=cut
+# vim: sw=2 sts=2
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/ODBC.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -3,17 +3,21 @@
use warnings;
use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
sub _rebless {
my ($self) = @_;
- my $dbtype = eval { $self->dbh->get_info(17) };
+ my $dbtype = eval { $self->_get_dbh->get_info(17) };
+
unless ( $@ ) {
# Translate the backend name into a perl identifier
$dbtype =~ s/\W/_/gi;
- my $class = "DBIx::Class::Storage::DBI::ODBC::${dbtype}";
- eval "require $class";
- bless $self, $class unless $@;
+ my $subclass = "DBIx::Class::Storage::DBI::ODBC::${dbtype}";
+ if ($self->load_optional_class($subclass) && !$self->isa($subclass)) {
+ bless $self, $subclass;
+ $self->_rebless;
+ }
}
}
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -5,7 +5,7 @@
=head1 NAME
-DBIx::Class::Storage::DBI::Oracle::Generic - Automatic primary key class for Oracle
+DBIx::Class::Storage::DBI::Oracle::Generic - Oracle Support for DBIx::Class
=head1 SYNOPSIS
@@ -24,11 +24,8 @@
=cut
use base qw/DBIx::Class::Storage::DBI/;
-use Carp::Clan qw/^DBIx::Class/;
+use mro 'c3';
-# For ORA_BLOB => 113, ORA_CLOB => 112
-use DBD::Oracle qw( :ora_types );
-
sub _dbh_last_insert_id {
my ($self, $dbh, $source, @columns) = @_;
my @ids = ();
@@ -52,7 +49,7 @@
};
# trigger_body is a LONG
- $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
+ local $dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
my $sth;
@@ -79,40 +76,22 @@
sub _sequence_fetch {
my ( $self, $type, $seq ) = @_;
- my ($id) = $self->dbh->selectrow_array("SELECT ${seq}.${type} FROM DUAL");
+ my ($id) = $self->_get_dbh->selectrow_array("SELECT ${seq}.${type} FROM DUAL");
return $id;
}
-=head2 connected
-
-Returns true if we have an open (and working) database connection, false if it is not (yet)
-open (or does not work). (Executes a simple SELECT to make sure it works.)
-
-The reason this is needed is that L<DBD::Oracle>'s ping() does not do a real
-OCIPing but just gets the server version, which doesn't help if someone killed
-your session.
-
-=cut
-
-sub connected {
+sub _ping {
my $self = shift;
- if (not $self->next::method(@_)) {
- return 0;
- }
- else {
- my $dbh = $self->_dbh;
+ my $dbh = $self->_dbh or return 0;
- local $dbh->{RaiseError} = 1;
+ local $dbh->{RaiseError} = 1;
- eval {
- my $ping_sth = $dbh->prepare_cached("select 1 from dual");
- $ping_sth->execute;
- $ping_sth->finish;
- };
+ eval {
+ $dbh->do("select 1 from dual");
+ };
- return $@ ? 0 : 1;
- }
+ return $@ ? 0 : 1;
}
sub _dbh_execute {
@@ -157,7 +136,7 @@
sub get_autoinc_seq {
my ($self, $source, $col) = @_;
-
+
$self->dbh_do('_dbh_get_autoinc_seq', $source, $col);
}
@@ -183,10 +162,54 @@
sub datetime_parser_type { return "DateTime::Format::Oracle"; }
+=head2 connect_call_datetime_setup
+
+Used as:
+
+ on_connect_call => 'datetime_setup'
+
+In L<DBIx::Class::Storage::DBI/connect_info> to set the session nls date, and
+timestamp values for use with L<DBIx::Class::InflateColumn::DateTime> and the
+necessary environment variables for L<DateTime::Format::Oracle>, which is used
+by it.
+
+Maximum allowable precision is used, unless the environment variables have
+already been set.
+
+These are the defaults used:
+
+ $ENV{NLS_DATE_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS';
+ $ENV{NLS_TIMESTAMP_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS.FF';
+ $ENV{NLS_TIMESTAMP_TZ_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS.FF TZHTZM';
+
+To get more than second precision with L<DBIx::Class::InflateColumn::DateTime>
+for your timestamps, use something like this:
+
+ use Time::HiRes 'time';
+ my $ts = DateTime->from_epoch(epoch => time);
+
+=cut
+
+sub connect_call_datetime_setup {
+ my $self = shift;
+
+ my $date_format = $ENV{NLS_DATE_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS';
+ my $timestamp_format = $ENV{NLS_TIMESTAMP_FORMAT} ||=
+ 'YYYY-MM-DD HH24:MI:SS.FF';
+ my $timestamp_tz_format = $ENV{NLS_TIMESTAMP_TZ_FORMAT} ||=
+ 'YYYY-MM-DD HH24:MI:SS.FF TZHTZM';
+
+ $self->_do_query("alter session set nls_date_format = '$date_format'");
+ $self->_do_query(
+"alter session set nls_timestamp_format = '$timestamp_format'");
+ $self->_do_query(
+"alter session set nls_timestamp_tz_format='$timestamp_tz_format'");
+}
+
sub _svp_begin {
my ($self, $name) = @_;
-
- $self->dbh->do("SAVEPOINT $name");
+
+ $self->_get_dbh->do("SAVEPOINT $name");
}
=head2 source_bind_attributes
@@ -208,6 +231,7 @@
sub source_bind_attributes
{
+ require DBD::Oracle;
my $self = shift;
my($source) = @_;
@@ -220,8 +244,9 @@
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_type'} = uc($data_type) eq 'CLOB' ?
+ DBD::Oracle::ORA_CLOB() :
+ DBD::Oracle::ORA_BLOB();
$column_bind_attrs{'ora_field'} = $column;
}
@@ -238,15 +263,13 @@
sub _svp_rollback {
my ($self, $name) = @_;
- $self->dbh->do("ROLLBACK TO SAVEPOINT $name")
+ $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
}
-=head1 AUTHORS
+=head1 AUTHOR
-Andy Grundman <andy at hybridized.org>
+See L<DBIx::Class/CONTRIBUTORS>.
-Scott Connelly <scottsweep at yahoo.com>
-
=head1 LICENSE
You may distribute this code under the same terms as Perl itself.
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Oracle/WhereJoins.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,10 +1,11 @@
package DBIx::Class::Storage::DBI::Oracle::WhereJoins;
-use base qw( DBIx::Class::Storage::DBI::Oracle::Generic );
-
use strict;
use warnings;
+use base qw( DBIx::Class::Storage::DBI::Oracle::Generic );
+use mro 'c3';
+
__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::OracleJoins');
1;
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Oracle.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Oracle.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Oracle.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -4,11 +4,12 @@
use warnings;
use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
sub _rebless {
my ($self) = @_;
- my $version = eval { $self->dbh->get_info(18); };
+ my $version = eval { $self->_get_dbh->get_info(18); };
if ( !$@ ) {
my ($major, $minor, $patchlevel) = split(/\./, $version);
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Pg.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Pg.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Pg.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -3,20 +3,19 @@
use strict;
use warnings;
-use DBD::Pg qw(:pg_types);
-
use base qw/DBIx::Class::Storage::DBI::MultiColumnIn/;
+use mro 'c3';
-# __PACKAGE__->load_components(qw/PK::Auto/);
+use DBD::Pg qw(:pg_types);
-# Warn about problematic versions of DBD::Pg
-warn "DBD::Pg 1.49 is strongly recommended"
- if ($DBD::Pg::VERSION < 1.49);
+# Ask for a DBD::Pg with array support
+warn "DBD::Pg 2.9.2 or greater is strongly recommended\n"
+ if ($DBD::Pg::VERSION < 2.009002); # pg uses (used?) version::qv()
sub with_deferred_fk_checks {
my ($self, $sub) = @_;
- $self->dbh->do('SET CONSTRAINTS ALL DEFERRED');
+ $self->_get_dbh->do('SET CONSTRAINTS ALL DEFERRED');
$sub->();
}
@@ -34,28 +33,73 @@
$self->dbh_do('_dbh_last_insert_id', $seq);
}
+sub _get_pg_search_path {
+ my ($self,$dbh) = @_;
+ # cache the search path as ['schema','schema',...] in the storage
+ # obj
+ $self->{_pg_search_path} ||= do {
+ my @search_path;
+ my ($sp_string) = $dbh->selectrow_array('SHOW search_path');
+ while( $sp_string =~ s/("[^"]+"|[^,]+),?// ) {
+ unless( defined $1 and length $1 ) {
+ $self->throw_exception("search path sanity check failed: '$1'")
+ }
+ push @search_path, $1;
+ }
+ \@search_path
+ };
+}
+
sub _dbh_get_autoinc_seq {
my ($self, $dbh, $schema, $table, @pri) = @_;
- while (my $col = shift @pri) {
- my $info = $dbh->column_info(undef,$schema,$table,$col)->fetchrow_hashref;
- if(defined $info->{COLUMN_DEF} and
- $info->{COLUMN_DEF} =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/) {
- my $seq = $1;
- # may need to strip quotes -- see if this works
- return $seq =~ /\./ ? $seq : $info->{TABLE_SCHEM} . "." . $seq;
- }
+ # get the list of postgres schemas to search. if we have a schema
+ # specified, use that. otherwise, use the search path
+ my @search_path;
+ if( defined $schema and length $schema ) {
+ @search_path = ( $schema );
+ } else {
+ @search_path = @{ $self->_get_pg_search_path($dbh) };
}
+
+ foreach my $search_schema (@search_path) {
+ foreach my $col (@pri) {
+ my $info = $dbh->column_info(undef,$search_schema,$table,$col)->fetchrow_hashref;
+ if($info) {
+ # if we get here, we have definitely found the right
+ # column.
+ if( defined $info->{COLUMN_DEF} and
+ $info->{COLUMN_DEF}
+ =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i
+ ) {
+ my $seq = $1;
+ return $seq =~ /\./ ? $seq : $info->{TABLE_SCHEM} . "." . $seq;
+ } else {
+ # we have found the column, but cannot figure out
+ # the nextval seq
+ return;
+ }
+ }
+ }
+ }
return;
}
sub get_autoinc_seq {
my ($self,$source,$col) = @_;
-
+
my @pri = $source->primary_columns;
- my ($schema,$table) = $source->name =~ /^(.+)\.(.+)$/ ? ($1,$2)
- : (undef,$source->name);
+ my $schema;
+ my $table = $source->name;
+
+ if (ref $table eq 'SCALAR') {
+ $table = $$table;
+ }
+ elsif ($table =~ /^(.+)\.(.+)$/) {
+ ($schema, $table) = ($1, $2);
+ }
+
$self->dbh_do('_dbh_get_autoinc_seq', $schema, $table, @pri);
}
@@ -72,7 +116,7 @@
bytea => { pg_type => DBD::Pg::PG_BYTEA },
blob => { pg_type => DBD::Pg::PG_BYTEA },
};
-
+
if( defined $bind_attributes->{$data_type} ) {
return $bind_attributes->{$data_type};
}
@@ -83,26 +127,26 @@
sub _sequence_fetch {
my ( $self, $type, $seq ) = @_;
- my ($id) = $self->dbh->selectrow_array("SELECT nextval('${seq}')");
+ my ($id) = $self->_get_dbh->selectrow_array("SELECT nextval('${seq}')");
return $id;
}
sub _svp_begin {
my ($self, $name) = @_;
- $self->dbh->pg_savepoint($name);
+ $self->_get_dbh->pg_savepoint($name);
}
sub _svp_release {
my ($self, $name) = @_;
- $self->dbh->pg_release($name);
+ $self->_get_dbh->pg_release($name);
}
sub _svp_rollback {
my ($self, $name) = @_;
- $self->dbh->pg_rollback_to($name);
+ $self->_get_dbh->pg_rollback_to($name);
}
1;
@@ -122,9 +166,26 @@
This class implements autoincrements for PostgreSQL.
+=head1 POSTGRESQL SCHEMA SUPPORT
+
+This supports multiple PostgreSQL schemas, with one caveat: for
+performance reasons, the schema search path is queried the first time it is
+needed and CACHED for subsequent uses.
+
+For this reason, you should do any necessary manipulation of the
+PostgreSQL search path BEFORE instantiating your schema object, or as
+part of the on_connect_do option to connect(), for example:
+
+ my $schema = My::Schema->connect
+ ( $dsn,$user,$pass,
+ { on_connect_do =>
+ [ 'SET search_path TO myschema, foo, public' ],
+ },
+ );
+
=head1 AUTHORS
-Marcus Ramberg <m.ramberg at cpan.org>
+See L<DBIx::Class/CONTRIBUTORS>
=head1 LICENSE
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/First.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/First.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/First.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -12,7 +12,7 @@
This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>. You
shouldn't need to create instances of this class.
-
+
=head1 DESCRIPTION
Given a pool (L<DBIx::Class::Storage::DBI::Replicated::Pool>) of replicated
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/Random.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/Random.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Balancer/Random.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -13,7 +13,7 @@
This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>. You
shouldn't need to create instances of this class.
-
+
=head1 DESCRIPTION
Given a pool (L<DBIx::Class::Storage::DBI::Replicated::Pool>) of replicated
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Balancer.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -3,7 +3,8 @@
use Moose::Role;
requires 'next_storage';
use MooseX::Types::Moose qw/Int/;
-
+use DBIx::Class::Storage::DBI::Replicated::Pool;
+use DBIx::Class::Storage::DBI::Replicated::Types qw/DBICStorageDBI/;
use namespace::clean -except => 'meta';
=head1 NAME
@@ -13,7 +14,7 @@
=head1 SYNOPSIS
This role is used internally by L<DBIx::Class::Storage::DBI::Replicated>.
-
+
=head1 DESCRIPTION
Given a pool (L<DBIx::Class::Storage::DBI::Replicated::Pool>) of replicated
@@ -48,7 +49,7 @@
has 'master' => (
is=>'ro',
- isa=>'DBIx::Class::Storage::DBI',
+ isa=>DBICStorageDBI,
required=>1,
);
@@ -74,13 +75,13 @@
This attribute returns the next slave to handle a read request. Your L</pool>
attribute has methods to help you shuffle through all the available replicants
-via it's balancer object.
+via its balancer object.
=cut
has 'current_replicant' => (
is=> 'rw',
- isa=>'DBIx::Class::Storage::DBI',
+ isa=>DBICStorageDBI,
lazy_build=>1,
handles=>[qw/
select
@@ -169,10 +170,12 @@
around 'select' => sub {
my ($select, $self, @args) = @_;
-
+
if (my $forced_pool = $args[-1]->{force_pool}) {
delete $args[-1]->{force_pool};
return $self->_get_forced_pool($forced_pool)->select(@args);
+ } elsif($self->master->{transaction_depth}) {
+ return $self->master->select(@args);
} else {
$self->increment_storage;
return $self->$select(@args);
@@ -189,10 +192,12 @@
around 'select_single' => sub {
my ($select_single, $self, @args) = @_;
-
+
if (my $forced_pool = $args[-1]->{force_pool}) {
delete $args[-1]->{force_pool};
return $self->_get_forced_pool($forced_pool)->select_single(@args);
+ } elsif($self->master->{transaction_depth}) {
+ return $self->master->select_single(@args);
} else {
$self->increment_storage;
return $self->$select_single(@args);
@@ -224,7 +229,7 @@
return $forced_pool;
} elsif($forced_pool eq 'master') {
return $self->master;
- } elsif(my $replicant = $self->pool->replicants($forced_pool)) {
+ } elsif(my $replicant = $self->pool->replicants->{$forced_pool}) {
return $replicant;
} else {
$self->master->throw_exception("$forced_pool is not a named replicant.");
@@ -233,7 +238,7 @@
=head1 AUTHOR
-John Napiorkowski <john.napiorkowski at takkle.com>
+John Napiorkowski <jjnapiork at cpan.org>
=head1 LICENSE
Added: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Introduction.pod
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Introduction.pod (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Introduction.pod 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,185 @@
+package DBIx::Class::Storage::DBI::Replicated::Introduction;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Replicated::Introduction - Minimum Need to Know
+
+=head1 SYNOPSIS
+
+This is an introductory document for L<DBIx::Class::Storage::Replication>.
+
+This document is not an overview of what replication is or why you should be
+using it. It is not a document explaing how to setup MySQL native replication
+either. Copious external resources are avialable for both. This document
+presumes you have the basics down.
+
+=head1 DESCRIPTION
+
+L<DBIx::Class> supports a framework for using database replication. This system
+is integrated completely, which means once it's setup you should be able to
+automatically just start using a replication cluster without additional work or
+changes to your code. Some caveats apply, primarily related to the proper use
+of transactions (you are wrapping all your database modifying statements inside
+a transaction, right ;) ) however in our experience properly written DBIC will
+work transparently with Replicated storage.
+
+Currently we have support for MySQL native replication, which is relatively
+easy to install and configure. We also currently support single master to one
+or more replicants (also called 'slaves' in some documentation). However the
+framework is not specifically tied to the MySQL framework and supporting other
+replication systems or topographies should be possible. Please bring your
+patches and ideas to the #dbix-class IRC channel or the mailing list.
+
+For an easy way to start playing with MySQL native replication, see:
+L<MySQL::Sandbox>.
+
+If you are using this with a L<Catalyst> based appplication, you may also wish
+to see more recent updates to L<Catalyst::Model::DBIC::Schema>, which has
+support for replication configuration options as well.
+
+=head1 REPLICATED STORAGE
+
+By default, when you start L<DBIx::Class>, your Schema (L<DBIx::Class::Schema>)
+is assigned a storage_type, which when fully connected will reflect your
+underlying storage engine as defined by your choosen database driver. For
+example, if you connect to a MySQL database, your storage_type will be
+L<DBIx::Class::Storage::DBI::mysql> Your storage type class will contain
+database specific code to help smooth over the differences between databases
+and let L<DBIx::Class> do its thing.
+
+If you want to use replication, you will override this setting so that the
+replicated storage engine will 'wrap' your underlying storages and present to
+the end programmer a unified interface. This wrapper storage class will
+delegate method calls to either a master database or one or more replicated
+databases based on if they are read only (by default sent to the replicants)
+or write (reserved for the master). Additionally, the Replicated storage
+will monitor the health of your replicants and automatically drop them should
+one exceed configurable parameters. Later, it can automatically restore a
+replicant when its health is restored.
+
+This gives you a very robust system, since you can add or drop replicants
+and DBIC will automatically adjust itself accordingly.
+
+Additionally, if you need high data integrity, such as when you are executing
+a transaction, replicated storage will automatically delegate all database
+traffic to the master storage. There are several ways to enable this high
+integrity mode, but wrapping your statements inside a transaction is the easy
+and canonical option.
+
+=head1 PARTS OF REPLICATED STORAGE
+
+A replicated storage contains several parts. First, there is the replicated
+storage itself (L<DBIx::Class::Storage::DBI::Replicated>). A replicated storage
+takes a pool of replicants (L<DBIx::Class::Storage::DBI::Replicated::Pool>)
+and a software balancer (L<DBIx::Class::Storage::DBI::Replicated::Pool>). The
+balancer does the job of splitting up all the read traffic amongst each
+replicant in the Pool. Currently there are two types of balancers, a Random one
+which chooses a Replicant in the Pool using a naive randomizer algorithm, and a
+First replicant, which just uses the first one in the Pool (and obviously is
+only of value when you have a single replicant).
+
+=head1 REPLICATED STORAGE CONFIGURATION
+
+All the parts of replication can be altered dynamically at runtime, which makes
+it possibly to create a system that automatically scales under load by creating
+more replicants as needed, perhaps using a cloud system such as Amazon EC2.
+However, for common use you can setup your replicated storage to be enabled at
+the time you connect the databases. The following is a breakdown of how you
+may wish to do this. Again, if you are using L<Catalyst>, I strongly recommend
+you use (or upgrade to) the latest L<Catalyst::Model::DBIC::Schema>, which makes
+this job even easier.
+
+First, you need to connect your L<DBIx::Class::Schema>. Let's assume you have
+such a schema called, "MyApp::Schema".
+
+ use MyApp::Schema;
+ my $schema = MyApp::Schema->connect($dsn, $user, $pass);
+
+Next, you need to set the storage_type.
+
+ $schema->storage_type(
+ ::DBI::Replicated' => {
+ balancer_type => '::Random',
+ balancer_args => {
+ auto_validate_every => 5,
+ master_read_weight => 1
+ },
+ pool_args => {
+ maximum_lag =>2,
+ },
+ }
+ );
+
+Let's break down the settings. The method L<DBIx::Class::Schema/storage_type>
+takes one mandatory parameter, a scalar value, and an option second value which
+is a Hash Reference of configuration options for that storage. In this case,
+we are setting the Replicated storage type using '::DBI::Replicated' as the
+first value. You will only use a different value if you are subclassing the
+replicated storage, so for now just copy that first parameter.
+
+The second parameter contains a hash reference of stuff that gets passed to the
+replicated storage. L<DBIx::Class::Storage::DBI::Replicated/balancer_type> is
+the type of software load balancer you will use to split up traffic among all
+your replicants. Right now we have two options, "::Random" and "::First". You
+can review documentation for both at:
+
+L<DBIx::Class::Storage::DBI::Replicated::Balancer::First>,
+L<DBIx::Class::Storage::DBI::Replicated::Balancer::Random>.
+
+In this case we will have three replicants, so the ::Random option is the only
+one that makes sense.
+
+'balancer_args' get passed to the balancer when it's instantiated. All
+balancers have the 'auto_validate_every' option. This is the number of seconds
+we allow to pass between validation checks on a load balanced replicant. So
+the higher the number, the more possibility that your reads to the replicant
+may be inconsistant with what's on the master. Setting this number too low
+will result in increased database loads, so choose a number with care. Our
+experience is that setting the number around 5 seconds results in a good
+performance / integrity balance.
+
+'master_read_weight' is an option associated with the ::Random balancer. It
+allows you to let the master be read from. I usually leave this off (default
+is off).
+
+The 'pool_args' are configuration options associated with the replicant pool.
+This object (L<DBIx::Class::Storage::DBI::Replicated::Pool>) manages all the
+declared replicants. 'maximum_lag' is the number of seconds a replicant is
+allowed to lag behind the master before being temporarily removed from the pool.
+Keep in mind that the Balancer option 'auto_validate_every' determins how often
+a replicant is tested against this condition, so the true possible lag can be
+higher than the number you set. The default is zero.
+
+No matter how low you set the maximum_lag or the auto_validate_every settings,
+there is always the chance that your replicants will lag a bit behind the
+master for the supported replication system built into MySQL. You can ensure
+reliabily reads by using a transaction, which will force both read and write
+activity to the master, however this will increase the load on your master
+database.
+
+After you've configured the replicated storage, you need to add the connection
+information for the replicants:
+
+ $schema->storage->connect_replicants(
+ [$dsn1, $user, $pass, \%opts],
+ [$dsn2, $user, $pass, \%opts],
+ [$dsn3, $user, $pass, \%opts],
+ );
+
+These replicants should be configured as slaves to the master using the
+instructions for MySQL native replication, or if you are just learning, you
+will find L<MySQL::Sandbox> an easy way to set up a replication cluster.
+
+And now your $schema object is properly configured! Enjoy!
+
+=head1 AUTHOR
+
+John Napiorkowski <jjnapiork at cpan.org>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+1;
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -18,7 +18,7 @@
This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>. You
shouldn't need to create instances of this class.
-
+
=head1 DESCRIPTION
In a replicated storage type, there is at least one replicant to handle the
@@ -34,7 +34,7 @@
This is a number which defines the maximum allowed lag returned by the
L<DBIx::Class::Storage::DBI/lag_behind_master> method. The default is 0. In
general, this should return a larger number when the replicant is lagging
-behind it's master, however the implementation of this is database specific, so
+behind its master, however the implementation of this is database specific, so
don't count on this number having a fixed meaning. For example, MySQL will
return a number of seconds that the replicating database is lagging.
@@ -51,7 +51,7 @@
=head2 last_validated
This is an integer representing a time since the last time the replicants were
-validated. It's nothing fancy, just an integer provided via the perl time
+validated. It's nothing fancy, just an integer provided via the perl L<time|perlfunc/time>
builtin.
=cut
@@ -89,11 +89,11 @@
actual replicant storage. For example if the $dsn element is something like:
"dbi:SQLite:dbname=dbfile"
-
+
You could access the specific replicant via:
$schema->storage->replicants->{'dbname=dbfile'}
-
+
This attributes also supports the following helper methods:
=over 4
@@ -125,14 +125,15 @@
has 'replicants' => (
is=>'rw',
metaclass => 'Collection::Hash',
- isa=>HashRef['DBIx::Class::Storage::DBI'],
+ isa=>HashRef['Object'],
default=>sub {{}},
provides => {
'set' => 'set_replicant',
- 'get' => 'get_replicant',
+ 'get' => 'get_replicant',
'empty' => 'has_replicants',
'count' => 'num_replicants',
'delete' => 'delete_replicant',
+ 'values' => 'all_replicant_storages',
},
);
@@ -151,7 +152,7 @@
sub connect_replicants {
my $self = shift @_;
my $schema = shift @_;
-
+
my @newly_created = ();
foreach my $connect_info (@_) {
$connect_info = [ $connect_info ]
@@ -169,7 +170,7 @@
$self->set_replicant( $key => $replicant);
push @newly_created, $replicant;
}
-
+
return @newly_created;
}
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -14,7 +14,7 @@
=head1 SYNOPSIS
This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>.
-
+
=head1 DESCRIPTION
Replicants are DBI Storages that follow a master DBI Storage. Typically this
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/Types.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,32 +1,31 @@
package # hide from PAUSE
DBIx::Class::Storage::DBI::Replicated::Types;
-=head1 NAME
+# DBIx::Class::Storage::DBI::Replicated::Types - Types used internally by
+# L<DBIx::Class::Storage::DBI::Replicated>
-DBIx::Class::Storage::DBI::Replicated::Types - Types used internally by
-L<DBIx::Class::Storage::DBI::Replicated>
-
-=cut
-
use MooseX::Types
- -declare => [qw/BalancerClassNamePart Weight/];
+ -declare => [qw/BalancerClassNamePart Weight DBICSchema DBICStorageDBI/];
use MooseX::Types::Moose qw/ClassName Str Num/;
class_type 'DBIx::Class::Storage::DBI';
class_type 'DBIx::Class::Schema';
+subtype DBICSchema, as 'DBIx::Class::Schema';
+subtype DBICStorageDBI, as 'DBIx::Class::Storage::DBI';
+
subtype BalancerClassNamePart,
as ClassName;
-
+
coerce BalancerClassNamePart,
from Str,
via {
my $type = $_;
if($type=~m/^::/) {
$type = 'DBIx::Class::Storage::DBI::Replicated::Balancer'.$type;
- }
- Class::MOP::load_class($type);
- $type;
+ }
+ Class::MOP::load_class($type);
+ $type;
};
subtype Weight,
@@ -34,14 +33,12 @@
where { $_ >= 0 },
message { 'weight must be a decimal greater than 0' };
-=head1 AUTHOR
+# AUTHOR
+#
+# John Napiorkowski <john.napiorkowski at takkle.com>
+#
+# LICENSE
+#
+# You may distribute this code under the same terms as Perl itself.
- John Napiorkowski <john.napiorkowski at takkle.com>
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
-
1;
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated/WithDSN.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -13,7 +13,7 @@
=head1 SYNOPSIS
This class is used internally by L<DBIx::Class::Storage::DBI::Replicated>.
-
+
=head1 DESCRIPTION
This role adds C<DSN: > info to storage debugging output.
@@ -31,7 +31,10 @@
around '_query_start' => sub {
my ($method, $self, $sql, @bind) = @_;
my $dsn = $self->_dbi_connect_info->[0];
- $self->$method("DSN: $dsn SQL: $sql", @bind);
+ my($op, $rest) = (($sql=~m/^(\w+)(.+)$/),'NOP', 'NO SQL');
+ my $storage_type = $self->can('active') ? 'REPLICANT' : 'MASTER';
+
+ $self->$method("$op [DSN_$storage_type=$dsn]$rest", @bind);
};
=head1 ALSO SEE
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Replicated.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -2,35 +2,35 @@
BEGIN {
use Carp::Clan qw/^DBIx::Class/;
-
+
## Modules required for Replication support not required for general DBIC
## use, so we explicitly test for these.
-
+
my %replication_required = (
- Moose => '0.77',
- MooseX::AttributeHelpers => '0.12',
- MooseX::Types => '0.10',
- namespace::clean => '0.11',
- Hash::Merge => '0.11'
+ 'Moose' => '0.87',
+ 'MooseX::AttributeHelpers' => '0.21',
+ 'MooseX::Types' => '0.16',
+ 'namespace::clean' => '0.11',
+ 'Hash::Merge' => '0.11'
);
-
+
my @didnt_load;
-
+
for my $module (keys %replication_required) {
eval "use $module $replication_required{$module}";
push @didnt_load, "$module $replication_required{$module}"
if $@;
}
-
+
croak("@{[ join ', ', @didnt_load ]} are missing and are required for Replication")
- if @didnt_load;
+ if @didnt_load;
}
use Moose;
use DBIx::Class::Storage::DBI;
use DBIx::Class::Storage::DBI::Replicated::Pool;
use DBIx::Class::Storage::DBI::Replicated::Balancer;
-use DBIx::Class::Storage::DBI::Replicated::Types 'BalancerClassNamePart';
+use DBIx::Class::Storage::DBI::Replicated::Types qw/BalancerClassNamePart DBICSchema DBICStorageDBI/;
use MooseX::Types::Moose qw/ClassName HashRef Object/;
use Scalar::Util 'reftype';
use Carp::Clan qw/^DBIx::Class/;
@@ -48,33 +48,45 @@
storage type, add some replicated (readonly) databases, and perform reporting
tasks.
- ## Change storage_type in your schema class
+You should set the 'storage_type attribute to a replicated type. You should
+also define your arguments, such as which balancer you want and any arguments
+that the Pool object should get.
+
$schema->storage_type( ['::DBI::Replicated', {balancer=>'::Random'}] );
-
- ## Add some slaves. Basically this is an array of arrayrefs, where each
- ## arrayref is database connect information
-
+
+Next, you need to add in the Replicants. Basically this is an array of
+arrayrefs, where each arrayref is database connect information. Think of these
+arguments as what you'd pass to the 'normal' $schema->connect method.
+
$schema->storage->connect_replicants(
[$dsn1, $user, $pass, \%opts],
[$dsn2, $user, $pass, \%opts],
[$dsn3, $user, $pass, \%opts],
);
-
- ## Now, just use the $schema as normal
+
+Now, just use the $schema as you normally would. Automatically all reads will
+be delegated to the replicants, while writes to the master.
+
$schema->resultset('Source')->search({name=>'etc'});
-
- ## You can force a given query to use a particular storage using the search
- ### attribute 'force_pool'. For example:
-
+
+You can force a given query to use a particular storage using the search
+attribute 'force_pool'. For example:
+
my $RS = $schema->resultset('Source')->search(undef, {force_pool=>'master'});
-
- ## Now $RS will force everything (both reads and writes) to use whatever was
- ## setup as the master storage. 'master' is hardcoded to always point to the
- ## Master, but you can also use any Replicant name. Please see:
- ## L<DBIx::Class::Storage::Replicated::Pool> and the replicants attribute for
- ## More. Also see transactions and L</execute_reliably> for alternative ways
- ## to force read traffic to the master.
-
+
+Now $RS will force everything (both reads and writes) to use whatever was setup
+as the master storage. 'master' is hardcoded to always point to the Master,
+but you can also use any Replicant name. Please see:
+L<DBIx::Class::Storage::DBI::Replicated::Pool> and the replicants attribute for more.
+
+Also see transactions and L</execute_reliably> for alternative ways to
+force read traffic to the master. In general, you should wrap your statements
+in a transaction when you are reading and writing to the same tables at the
+same time, since your replicants will often lag a bit behind the master.
+
+See L<DBIx::Class::Storage::DBI::Replicated::Instructions> for more help and
+walkthroughs.
+
=head1 DESCRIPTION
Warning: This class is marked BETA. This has been running a production
@@ -100,7 +112,7 @@
=head1 NOTES
The consistancy betweeen master and replicants is database specific. The Pool
-gives you a method to validate it's replicants, removing and replacing them
+gives you a method to validate its replicants, removing and replacing them
when they fail/pass predefined criteria. Please make careful use of the ways
to force a query to run against Master when needed.
@@ -108,12 +120,12 @@
Replicated Storage has additional requirements not currently part of L<DBIx::Class>
- Moose => 0.77
- MooseX::AttributeHelpers => 0.12
- MooseX::Types => 0.10
- namespace::clean => 0.11
- Hash::Merge => 0.11
-
+ Moose => '0.87',
+ MooseX::AttributeHelpers => '0.20',
+ MooseX::Types => '0.16',
+ namespace::clean => '0.11',
+ Hash::Merge => '0.11'
+
You will need to install these modules manually via CPAN or make them part of the
Makefile for your distribution.
@@ -129,7 +141,7 @@
has 'schema' => (
is=>'rw',
- isa=>'DBIx::Class::Schema',
+ isa=>DBICSchema,
weak_ref=>1,
required=>1,
);
@@ -153,7 +165,7 @@
=head2 pool_args
Contains a hashref of initialized information to pass to the Balancer object.
-See L<DBIx::Class::Storage::Replicated::Pool> for available arguments.
+See L<DBIx::Class::Storage::DBI::Replicated::Pool> for available arguments.
=cut
@@ -186,7 +198,7 @@
=head2 balancer_args
Contains a hashref of initialized information to pass to the Balancer object.
-See L<DBIx::Class::Storage::Replicated::Balancer> for available arguments.
+See L<DBIx::Class::Storage::DBI::Replicated::Balancer> for available arguments.
=cut
@@ -242,7 +254,7 @@
has 'master' => (
is=> 'ro',
- isa=>'DBIx::Class::Storage::DBI',
+ isa=>DBICStorageDBI,
lazy_build=>1,
);
@@ -288,7 +300,8 @@
create_ddl_dir
deployment_statements
datetime_parser
- datetime_parser_type
+ datetime_parser_type
+ build_datetime_parser
last_insert_id
insert
insert_bulk
@@ -303,10 +316,19 @@
sth
deploy
with_deferred_fk_checks
-
+ dbh_do
reload_row
+ with_deferred_fk_checks
_prep_for_execute
-
+
+ backup
+ is_datatype_numeric
+ _count_select
+ _subq_count_select
+ _subq_update_delete
+ svp_rollback
+ svp_begin
+ svp_release
/],
);
@@ -381,7 +403,7 @@
=head2 BUILDARGS
-L<DBIx::Class::Schema> when instantiating it's storage passed itself as the
+L<DBIx::Class::Schema> when instantiating its storage passed itself as the
first argument. So we need to massage the arguments a bit so that all the
bits get put into the correct places.
@@ -389,7 +411,7 @@
sub BUILDARGS {
my ($class, $schema, $storage_type_args, @args) = @_;
-
+
return {
schema=>$schema,
%$storage_type_args,
@@ -546,24 +568,24 @@
sub execute_reliably {
my ($self, $coderef, @args) = @_;
-
+
unless( ref $coderef eq 'CODE') {
$self->throw_exception('Second argument must be a coderef');
}
-
+
##Get copy of master storage
my $master = $self->master;
-
+
##Get whatever the current read hander is
my $current = $self->read_handler;
-
+
##Set the read handler to master
$self->read_handler($master);
-
+
## do whatever the caller needs
my @result;
my $want_array = wantarray;
-
+
eval {
if($want_array) {
@result = $coderef->(@args);
@@ -573,13 +595,13 @@
$coderef->(@args);
}
};
-
+
##Reset to the original state
$self->read_handler($current);
-
+
##Exception testing has to come last, otherwise you might leave the
##read_handler set to master.
-
+
if($@) {
$self->throw_exception("coderef returned an error: $@");
} else {
@@ -591,14 +613,14 @@
Sets the current $schema to be 'reliable', that is all queries, both read and
write are sent to the master
-
+
=cut
sub set_reliable_storage {
my $self = shift @_;
my $schema = $self->schema;
my $write_handler = $self->schema->storage->write_handler;
-
+
$schema->storage->read_handler($write_handler);
}
@@ -606,30 +628,17 @@
Sets the current $schema to be use the </balancer> for all reads, while all
writea are sent to the master only
-
+
=cut
sub set_balanced_storage {
my $self = shift @_;
my $schema = $self->schema;
- my $write_handler = $self->schema->storage->balancer;
-
- $schema->storage->read_handler($write_handler);
+ my $balanced_handler = $self->schema->storage->balancer;
+
+ $schema->storage->read_handler($balanced_handler);
}
-=head2 around: txn_do ($coderef)
-
-Overload to the txn_do method, which is delegated to whatever the
-L<write_handler> is set to. We overload this in order to wrap in inside a
-L</execute_reliably> method.
-
-=cut
-
-around 'txn_do' => sub {
- my($txn_do, $self, $coderef, @args) = @_;
- $self->execute_reliably(sub {$self->$txn_do($coderef, @args)});
-};
-
=head2 connected
Check that the master and at least one of the replicants is connected.
@@ -802,7 +811,7 @@
}
$self->master->cursor_class;
}
-
+
=head1 GOTCHAS
Due to the fact that replicants can lag behind a master, you must take care to
@@ -836,7 +845,7 @@
my $new_schema = $schema->clone;
$new_schema->set_reliable_storage;
-
+
## $new_schema will use only the Master storage for all reads/writes while
## the $schema object will use replicated storage.
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/SQLite.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/SQLite.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/SQLite.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -2,12 +2,14 @@
use strict;
use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+
use POSIX 'strftime';
use File::Copy;
use File::Spec;
-use base qw/DBIx::Class::Storage::DBI/;
-
sub _dbh_last_insert_id {
my ($self, $dbh, $source, $col) = @_;
$dbh->func('last_insert_rowid');
Added: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,54 @@
+package # hide from PAUSE
+ DBIx::Class::Storage::DBI::Sybase::Base;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase::Base - Common functionality for drivers using
+DBD::Sybase
+
+=cut
+
+sub _ping {
+ my $self = shift;
+
+ my $dbh = $self->_dbh or return 0;
+
+ local $dbh->{RaiseError} = 1;
+ eval {
+ $dbh->do('select 1');
+ };
+
+ return $@ ? 0 : 1;
+}
+
+sub _placeholders_supported {
+ my $self = shift;
+ my $dbh = $self->_get_dbh;
+
+ return eval {
+# There's also $dbh->{syb_dynamic_supported} but it can be inaccurate for this
+# purpose.
+ local $dbh->{PrintError} = 0;
+ local $dbh->{RaiseError} = 1;
+# this specifically tests a bind that is NOT a string
+ $dbh->selectrow_array('select 1 where 1 = ?', {}, 1);
+ };
+}
+
+1;
+
+=head1 AUTHORS
+
+See L<DBIx::Class/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -15,6 +15,7 @@
use base qw/DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server/;
+use mro 'c3';
1;
Added: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server/NoBindVars.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server/NoBindVars.pm (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server/NoBindVars.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,53 @@
+package DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars;
+
+use strict;
+use warnings;
+
+use base qw/
+ DBIx::Class::Storage::DBI::NoBindVars
+ DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server
+/;
+use mro 'c3';
+
+sub _rebless {
+ my $self = shift;
+
+ $self->disable_sth_caching(1);
+}
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars - Support for Microsoft
+SQL Server via DBD::Sybase without placeholders
+
+=head1 SYNOPSIS
+
+This subclass supports MSSQL server connections via DBD::Sybase when ? style
+placeholders are not available.
+
+=head1 DESCRIPTION
+
+If you are using this driver then your combination of L<DBD::Sybase> and
+libraries (most likely FreeTDS) does not support ? style placeholders.
+
+This storage driver uses L<DBIx::Class::Storage::DBI::NoBindVars> as a base.
+This means that bind variables will be interpolated (properly quoted of course)
+into the SQL query itself, without using bind placeholders.
+
+More importantly this means that caching of prepared statements is explicitly
+disabled, as the interpolation renders it useless.
+
+In all other respects, it is a subclass of
+L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
+
+=head1 AUTHOR
+
+See L<DBIx::Class/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -4,36 +4,55 @@
use warnings;
use base qw/
- DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server
- DBIx::Class::Storage::DBI::Sybase
+ DBIx::Class::Storage::DBI::Sybase::Base
+ DBIx::Class::Storage::DBI::MSSQL
/;
+use mro 'c3';
+sub _rebless {
+ my $self = shift;
+ my $dbh = $self->_get_dbh;
+
+ if (not $self->_placeholders_supported) {
+ bless $self,
+ 'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars';
+ $self->_rebless;
+ }
+
+# LongReadLen doesn't work with MSSQL through DBD::Sybase, and the default is
+# huge on some versions of SQL server and can cause memory problems, so we
+# fix it up here.
+ my $text_size = eval { $self->_dbi_connect_info->[-1]->{LongReadLen} } ||
+ 32768; # the DBD::Sybase default
+
+ $dbh->do("set textsize $text_size");
+}
+
1;
=head1 NAME
-DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server - Storage::DBI subclass for MSSQL via
-DBD::Sybase
+DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server - Support for Microsoft
+SQL Server via DBD::Sybase
=head1 SYNOPSIS
This subclass supports MSSQL server connections via L<DBD::Sybase>.
-=head1 CAVEATS
+=head1 DESCRIPTION
-This storage driver uses L<DBIx::Class::Storage::DBI::NoBindVars> as a base.
-This means that bind variables will be interpolated (properly quoted of course)
-into the SQL query itself, without using bind placeholders.
+This driver tries to determine whether your version of L<DBD::Sybase> and
+supporting libraries (usually FreeTDS) support using placeholders, if not the
+storage will be reblessed to
+L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars>.
-More importantly this means that caching of prepared statements is explicitly
-disabled, as the interpolation renders it useless.
+The MSSQL specific functionality is provided by
+L<DBIx::Class::Storage::DBI::MSSQL>.
-=head1 AUTHORS
+=head1 AUTHOR
-Brandon L Black <blblack at gmail.com>
+See L<DBIx::Class/CONTRIBUTORS>.
-Justin Hunter <justin.d.hunter at gmail.com>
-
=head1 LICENSE
You may distribute this code under the same terms as Perl itself.
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -3,12 +3,20 @@
use strict;
use warnings;
-use base qw/DBIx::Class::Storage::DBI::NoBindVars/;
+use base qw/
+ DBIx::Class::Storage::DBI::Sybase::Base
+ DBIx::Class::Storage::DBI::NoBindVars
+/;
+use mro 'c3';
sub _rebless {
my $self = shift;
- my $dbtype = eval { @{$self->dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2] };
+ my $dbtype = eval {
+ @{$self->_get_dbh
+ ->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})
+ }[2]
+ };
unless ( $@ ) {
$dbtype =~ s/\W/_/gi;
my $subclass = "DBIx::Class::Storage::DBI::Sybase::${dbtype}";
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/mysql.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/mysql.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI/mysql.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -3,18 +3,31 @@
use strict;
use warnings;
-use base qw/DBIx::Class::Storage::DBI::MultiColumnIn/;
+use base qw/
+ DBIx::Class::Storage::DBI::MultiColumnIn
+ DBIx::Class::Storage::DBI::AmbiguousGlob
+ DBIx::Class::Storage::DBI
+/;
+use mro 'c3';
__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MySQL');
sub with_deferred_fk_checks {
my ($self, $sub) = @_;
- $self->dbh->do('SET foreign_key_checks=0');
+ $self->_do_query('SET FOREIGN_KEY_CHECKS = 0');
$sub->();
- $self->dbh->do('SET foreign_key_checks=1');
+ $self->_do_query('SET FOREIGN_KEY_CHECKS = 1');
}
+sub connect_call_set_strict_mode {
+ my $self = shift;
+
+ # the @@sql_mode puts back what was previously set on the session handle
+ $self->_do_query(q|SET SQL_MODE = CONCAT('ANSI,TRADITIONAL,ONLY_FULL_GROUP_BY,', @@sql_mode)|);
+ $self->_do_query(q|SET SQL_AUTO_IS_NULL = 0|);
+}
+
sub _dbh_last_insert_id {
my ($self, $dbh, $source, $col) = @_;
$dbh->{mysql_insertid};
@@ -27,28 +40,28 @@
sub _svp_begin {
my ($self, $name) = @_;
- $self->dbh->do("SAVEPOINT $name");
+ $self->_get_dbh->do("SAVEPOINT $name");
}
sub _svp_release {
my ($self, $name) = @_;
- $self->dbh->do("RELEASE SAVEPOINT $name");
+ $self->_get_dbh->do("RELEASE SAVEPOINT $name");
}
sub _svp_rollback {
my ($self, $name) = @_;
- $self->dbh->do("ROLLBACK TO SAVEPOINT $name")
+ $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
}
-
+
sub is_replicating {
- my $status = shift->dbh->selectrow_hashref('show slave status');
+ my $status = shift->_get_dbh->selectrow_hashref('show slave status');
return ($status->{Slave_IO_Running} eq 'Yes') && ($status->{Slave_SQL_Running} eq 'Yes');
}
sub lag_behind_master {
- return shift->dbh->selectrow_hashref('show slave status')->{Seconds_Behind_Master};
+ return shift->_get_dbh->selectrow_hashref('show slave status')->{Seconds_Behind_Master};
}
# MySql can not do subquery update/deletes, only way is slow per-row operations.
@@ -57,38 +70,30 @@
return shift->_per_row_update_delete (@_);
}
-# MySql chokes on things like:
-# COUNT(*) FROM (SELECT tab1.col, tab2.col FROM tab1 JOIN tab2 ... )
-# claiming that col is a duplicate column (it loses the table specifiers by
-# the time it gets to the *). Thus for any subquery count we select only the
-# primary keys of the main table in the inner query. This hopefully still
-# hits the indexes and keeps mysql happy.
-# (mysql does not care if the SELECT and the GROUP BY match)
-sub _subq_count_select {
- my ($self, $source, $rs_attrs) = @_;
- my @pcols = map { join '.', $rs_attrs->{alias}, $_ } ($source->primary_columns);
- return @pcols ? \@pcols : [ 1 ];
-}
-
1;
=head1 NAME
-DBIx::Class::Storage::DBI::mysql - Automatic primary key class for MySQL
+DBIx::Class::Storage::DBI::mysql - Storage::DBI class implementing MySQL specifics
=head1 SYNOPSIS
- # In your table classes
- __PACKAGE__->load_components(qw/PK::Auto Core/);
- __PACKAGE__->set_primary_key('id');
+Storage::DBI autodetects the underlying MySQL database, and re-blesses the
+C<$storage> object into this class.
+ my $schema = MyDb::Schema->connect( $dsn, $user, $pass, { on_connect_call => 'set_strict_mode' } );
+
=head1 DESCRIPTION
-This class implements autoincrements for MySQL.
+This class implements MySQL specific bits of L<DBIx::Class::Storage::DBI>.
+It also provides a one-stop on-connect macro C<set_strict_mode> which sets
+session variables such that MySQL behaves more predictably as far as the
+SQL standard is concerned.
+
=head1 AUTHORS
-Matt S. Trout <mst at shadowcatsystems.co.uk>
+See L<DBIx::Class/CONTRIBUTORS>
=head1 LICENSE
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/DBI.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,10 +1,12 @@
package DBIx::Class::Storage::DBI;
# -*- mode: cperl; cperl-indent-level: 2 -*-
+use strict;
+use warnings;
+
use base 'DBIx::Class::Storage';
+use mro 'c3';
-use strict;
-use warnings;
use Carp::Clan qw/^DBIx::Class/;
use DBI;
use DBIx::Class::Storage::DBI::Cursor;
@@ -13,14 +15,15 @@
use List::Util();
__PACKAGE__->mk_group_accessors('simple' =>
- qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
- _conn_pid _conn_tid transaction_depth _dbh_autocommit savepoints/
+ qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts _conn_pid
+ _conn_tid transaction_depth _dbh_autocommit _driver_determined savepoints/
);
# the values for these accessors are picked out (and deleted) from
# the attribute hashref passed to connect_info
my @storage_options = qw/
- on_connect_do on_disconnect_do disable_sth_caching unsafe auto_savepoint
+ on_connect_call on_disconnect_call on_connect_do on_disconnect_do
+ disable_sth_caching unsafe auto_savepoint
/;
__PACKAGE__->mk_group_accessors('simple' => @storage_options);
@@ -89,8 +92,8 @@
=item *
-A single code reference which returns a connected
-L<DBI database handle|DBI/connect> optionally followed by
+A single code reference which returns a connected
+L<DBI database handle|DBI/connect> optionally followed by
L<extra attributes|/DBIx::Class specific connection attributes> recognized
by DBIx::Class:
@@ -109,7 +112,7 @@
%extra_attributes,
}];
-This is particularly useful for L<Catalyst> based applications, allowing the
+This is particularly useful for L<Catalyst> based applications, allowing the
following config (L<Config::General> style):
<Model::DB>
@@ -128,7 +131,7 @@
set C<AutoCommit> to either I<0> or I<1>. L<DBIx::Class> further
recommends that it be set to I<1>, and that you perform transactions
via our L<DBIx::Class::Schema/txn_do> method. L<DBIx::Class> will set it
-to I<1> if you do not do explicitly set it to zero. This is the default
+to I<1> if you do not do explicitly set it to zero. This is the default
for most DBDs. See L</DBIx::Class and AutoCommit> for details.
=head3 DBIx::Class specific connection attributes
@@ -177,12 +180,97 @@
Note, this only runs if you explicitly call L</disconnect> on the
storage object.
+=item on_connect_call
+
+A more generalized form of L</on_connect_do> that calls the specified
+C<connect_call_METHOD> methods in your storage driver.
+
+ on_connect_do => 'select 1'
+
+is equivalent to:
+
+ on_connect_call => [ [ do_sql => 'select 1' ] ]
+
+Its values may contain:
+
+=over
+
+=item a scalar
+
+Will call the C<connect_call_METHOD> method.
+
+=item a code reference
+
+Will execute C<< $code->($storage) >>
+
+=item an array reference
+
+Each value can be a method name or code reference.
+
+=item an array of arrays
+
+For each array, the first item is taken to be the C<connect_call_> method name
+or code reference, and the rest are parameters to it.
+
+=back
+
+Some predefined storage methods you may use:
+
+=over
+
+=item do_sql
+
+Executes a SQL string or a code reference that returns a SQL string. This is
+what L</on_connect_do> and L</on_disconnect_do> use.
+
+It can take:
+
+=over
+
+=item a scalar
+
+Will execute the scalar as SQL.
+
+=item an arrayref
+
+Taken to be arguments to L<DBI/do>, the SQL string optionally followed by the
+attributes hashref and bind values.
+
+=item a code reference
+
+Will execute C<< $code->($storage) >> and execute the return array refs as
+above.
+
+=back
+
+=item datetime_setup
+
+Execute any statements necessary to initialize the database session to return
+and accept datetime/timestamp values used with
+L<DBIx::Class::InflateColumn::DateTime>.
+
+Only necessary for some databases, see your specific storage driver for
+implementation details.
+
+=back
+
+=item on_disconnect_call
+
+Takes arguments in the same form as L</on_connect_call> and executes them
+immediately before disconnecting from the database.
+
+Calls the C<disconnect_call_METHOD> methods as opposed to the
+C<connect_call_METHOD> methods called by L</on_connect_call>.
+
+Note, this only runs if you explicitly call L</disconnect> on the
+storage object.
+
=item disable_sth_caching
If set to a true value, this option will disable the caching of
statement handles via L<DBI/prepare_cached>.
-=item limit_dialect
+=item limit_dialect
Sets the limit dialect. This is useful for JDBC-bridge among others
where the remote SQL-dialect cannot be determined by the name of the
@@ -190,7 +278,7 @@
=item quote_char
-Specifies what characters to use to quote table and column names. If
+Specifies what characters to use to quote table and column names. If
you use this you will want to specify L</name_sep> as well.
C<quote_char> expects either a single character, in which case is it
@@ -202,8 +290,8 @@
=item name_sep
-This only needs to be used in conjunction with C<quote_char>, and is used to
-specify the charecter that seperates elements (schemas, tables, columns) from
+This only needs to be used in conjunction with C<quote_char>, and is used to
+specify the charecter that seperates elements (schemas, tables, columns) from
each other. In most cases this is simply a C<.>.
The consequences of not supplying this value is that L<SQL::Abstract>
@@ -349,17 +437,61 @@
}
}
- %attrs = () if (ref $args[0] eq 'CODE'); # _connect() never looks past $args[0] in this case
+ if (ref $args[0] eq 'CODE') {
+ # _connect() never looks past $args[0] in this case
+ %attrs = ()
+ } else {
+ %attrs = (
+ %{ $self->_default_dbi_connect_attributes || {} },
+ %attrs,
+ );
+ }
$self->_dbi_connect_info([@args, keys %attrs ? \%attrs : ()]);
$self->_connect_info;
}
+sub _default_dbi_connect_attributes {
+ return {
+ AutoCommit => 1,
+ RaiseError => 1,
+ PrintError => 0,
+ };
+}
+
=head2 on_connect_do
This method is deprecated in favour of setting via L</connect_info>.
+=cut
+=head2 on_disconnect_do
+
+This method is deprecated in favour of setting via L</connect_info>.
+
+=cut
+
+sub _parse_connect_do {
+ my ($self, $type) = @_;
+
+ my $val = $self->$type;
+ return () if not defined $val;
+
+ my @res;
+
+ if (not ref($val)) {
+ push @res, [ 'do_sql', $val ];
+ } elsif (ref($val) eq 'CODE') {
+ push @res, $val;
+ } elsif (ref($val) eq 'ARRAY') {
+ push @res, map { [ 'do_sql', $_ ] } @$val;
+ } else {
+ $self->throw_exception("Invalid type for $type: ".ref($val));
+ }
+
+ return \@res;
+}
+
=head2 dbh_do
Arguments: ($subref | $method_name), @extra_coderef_args?
@@ -423,6 +555,7 @@
}
};
+ # ->connected might unset $@ - copy
my $exception = $@;
if(!$exception) { return $want_array ? @result : $result[0] }
@@ -430,6 +563,8 @@
# We were not connected - reconnect and retry, but let any
# exception fall right through this time
+ carp "Retrying $code after catching disconnected exception: $exception"
+ if $ENV{DBIC_DBIRETRY_DEBUG};
$self->_populate_dbh;
$self->$code($self->_dbh, @_);
}
@@ -470,10 +605,11 @@
$self->txn_commit;
};
+ # ->connected might unset $@ - copy
my $exception = $@;
if(!$exception) { return $want_array ? @result : $result[0] }
- if($tried++ > 0 || $self->connected) {
+ if($tried++ || $self->connected) {
eval { $self->txn_rollback };
my $rollback_exception = $@;
if($rollback_exception) {
@@ -491,6 +627,8 @@
# We were not connected, and was first try - reconnect and retry
# via the while loop
+ carp "Retrying $coderef after catching disconnected exception: $exception"
+ if $ENV{DBIC_DBIRETRY_DEBUG};
$self->_populate_dbh;
}
}
@@ -505,10 +643,14 @@
sub disconnect {
my ($self) = @_;
- if( $self->connected ) {
- my $connection_do = $self->on_disconnect_do;
- $self->_do_connection_actions($connection_do) if ref($connection_do);
+ if( $self->_dbh ) {
+ my @actions;
+ push @actions, ( $self->on_disconnect_call || () );
+ push @actions, $self->_parse_connect_do ('on_disconnect_do');
+
+ $self->_do_connection_actions(disconnect_call_ => $_) for @actions;
+
$self->_dbh->rollback unless $self->_dbh_autocommit;
$self->_dbh->disconnect;
$self->_dbh(undef);
@@ -538,25 +680,59 @@
$sub->();
}
+=head2 connected
+
+=over
+
+=item Arguments: none
+
+=item Return Value: 1|0
+
+=back
+
+Verifies that the the current database handle is active and ready to execute
+an SQL statement (i.e. the connection did not get stale, server is still
+answering, etc.) This method is used internally by L</dbh>.
+
+=cut
+
sub connected {
- my ($self) = @_;
+ my $self = shift;
+ return 0 unless $self->_seems_connected;
- if(my $dbh = $self->_dbh) {
- if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
- $self->_dbh(undef);
- $self->{_dbh_gen}++;
- return;
- }
- else {
- $self->_verify_pid;
- return 0 if !$self->_dbh;
- }
- return ($dbh->FETCH('Active') && $dbh->ping);
+ #be on the safe side
+ local $self->_dbh->{RaiseError} = 1;
+
+ return $self->_ping;
+}
+
+sub _seems_connected {
+ my $self = shift;
+
+ my $dbh = $self->_dbh
+ or return 0;
+
+ if(defined $self->_conn_tid && $self->_conn_tid != threads->tid) {
+ $self->_dbh(undef);
+ $self->{_dbh_gen}++;
+ return 0;
}
+ else {
+ $self->_verify_pid;
+ return 0 if !$self->_dbh;
+ }
- return 0;
+ return $dbh->FETCH('Active');
}
+sub _ping {
+ my $self = shift;
+
+ my $dbh = $self->_dbh or return 0;
+
+ return $dbh->ping;
+}
+
# handle pid changes correctly
# NOTE: assumes $self->_dbh is a valid $dbh
sub _verify_pid {
@@ -581,21 +757,41 @@
=head2 dbh
-Returns the dbh - a data base handle of class L<DBI>.
+Returns a C<$dbh> - a data base handle of class L<DBI>. The returned handle
+is guaranteed to be healthy by implicitly calling L</connected>, and if
+necessary performing a reconnection before returning. Keep in mind that this
+is very B<expensive> on some database engines. Consider using L<dbh_do>
+instead.
=cut
sub dbh {
my ($self) = @_;
- $self->ensure_connected;
+ if (not $self->_dbh) {
+ $self->_populate_dbh;
+ } else {
+ $self->ensure_connected;
+ }
return $self->_dbh;
}
+# this is the internal "get dbh or connect (don't check)" method
+sub _get_dbh {
+ my $self = shift;
+ $self->_populate_dbh unless $self->_dbh;
+ return $self->_dbh;
+}
+
sub _sql_maker_args {
my ($self) = @_;
-
- return ( bindtype=>'columns', array_datatypes => 1, limit_dialect => $self->dbh, %{$self->_sql_maker_opts} );
+
+ return (
+ bindtype=>'columns',
+ array_datatypes => 1,
+ limit_dialect => $self->_get_dbh,
+ %{$self->_sql_maker_opts}
+ );
}
sub sql_maker {
@@ -612,7 +808,9 @@
sub _populate_dbh {
my ($self) = @_;
+
my @info = @{$self->_dbi_connect_info || []};
+ $self->_dbh(undef); # in case ->connected failed we might get sent here
$self->_dbh($self->_connect(@info));
$self->_conn_pid($$);
@@ -624,51 +822,88 @@
# there is no transaction in progress by definition
$self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
- my $connection_do = $self->on_connect_do;
- $self->_do_connection_actions($connection_do) if $connection_do;
+ $self->_run_connection_actions unless $self->{_in_determine_driver};
}
+sub _run_connection_actions {
+ my $self = shift;
+ my @actions;
+
+ push @actions, ( $self->on_connect_call || () );
+ push @actions, $self->_parse_connect_do ('on_connect_do');
+
+ $self->_do_connection_actions(connect_call_ => $_) for @actions;
+}
+
sub _determine_driver {
my ($self) = @_;
- if (ref $self eq 'DBIx::Class::Storage::DBI') {
- my $driver;
+ if ((not $self->_driver_determined) && (not $self->{_in_determine_driver})) {
+ my $started_unconnected = 0;
+ local $self->{_in_determine_driver} = 1;
- if ($self->_dbh) { # we are connected
- $driver = $self->_dbh->{Driver}{Name};
- } else {
- # try to use dsn to not require being connected, the driver may still
- # force a connection in _rebless to determine version
- ($driver) = $self->_dbi_connect_info->[0] =~ /dbi:([^:]+):/i;
+ if (ref($self) eq __PACKAGE__) {
+ my $driver;
+ if ($self->_dbh) { # we are connected
+ $driver = $self->_dbh->{Driver}{Name};
+ } else {
+ # try to use dsn to not require being connected, the driver may still
+ # force a connection in _rebless to determine version
+ ($driver) = $self->_dbi_connect_info->[0] =~ /dbi:([^:]+):/i;
+ $started_unconnected = 1;
+ }
+
+ my $storage_class = "DBIx::Class::Storage::DBI::${driver}";
+ if ($self->load_optional_class($storage_class)) {
+ mro::set_mro($storage_class, 'c3');
+ bless $self, $storage_class;
+ $self->_rebless();
+ }
}
- if ($self->load_optional_class("DBIx::Class::Storage::DBI::${driver}")) {
- bless $self, "DBIx::Class::Storage::DBI::${driver}";
- $self->_rebless();
- }
+ $self->_driver_determined(1);
+
+ $self->_run_connection_actions
+ if $started_unconnected && defined $self->_dbh;
}
}
sub _do_connection_actions {
- my $self = shift;
- my $connection_do = shift;
+ my $self = shift;
+ my $method_prefix = shift;
+ my $call = shift;
- if (!ref $connection_do) {
- $self->_do_query($connection_do);
+ if (not ref($call)) {
+ my $method = $method_prefix . $call;
+ $self->$method(@_);
+ } elsif (ref($call) eq 'CODE') {
+ $self->$call(@_);
+ } elsif (ref($call) eq 'ARRAY') {
+ if (ref($call->[0]) ne 'ARRAY') {
+ $self->_do_connection_actions($method_prefix, $_) for @$call;
+ } else {
+ $self->_do_connection_actions($method_prefix, @$_) for @$call;
+ }
+ } else {
+ $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref($call)) );
}
- elsif (ref $connection_do eq 'ARRAY') {
- $self->_do_query($_) foreach @$connection_do;
- }
- elsif (ref $connection_do eq 'CODE') {
- $connection_do->($self);
- }
- else {
- $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref $connection_do) );
- }
return $self;
}
+sub connect_call_do_sql {
+ my $self = shift;
+ $self->_do_query(@_);
+}
+
+sub disconnect_call_do_sql {
+ my $self = shift;
+ $self->_do_query(@_);
+}
+
+# override in db-specific backend when necessary
+sub connect_call_datetime_setup { 1 }
+
sub _do_query {
my ($self, $action) = @_;
@@ -753,11 +988,11 @@
$self->throw_exception ("Your Storage implementation doesn't support savepoints")
unless $self->can('_svp_begin');
-
+
push @{ $self->{savepoints} }, $name;
$self->debugobj->svp_begin($name) if $self->debug;
-
+
return $self->_svp_begin($name);
}
@@ -817,7 +1052,7 @@
}
$self->debugobj->svp_rollback($name) if $self->debug;
-
+
return $self->_svp_rollback($name);
}
@@ -829,14 +1064,17 @@
sub txn_begin {
my $self = shift;
- $self->ensure_connected();
if($self->{transaction_depth} == 0) {
$self->debugobj->txn_begin()
if $self->debug;
- # this isn't ->_dbh-> because
- # we should reconnect on begin_work
- # for AutoCommit users
- $self->dbh->begin_work;
+
+ # being here implies we have AutoCommit => 1
+ # if the user is utilizing txn_do - good for
+ # him, otherwise we need to ensure that the
+ # $dbh is healthy on BEGIN
+ my $dbh_method = $self->{_in_dbh_do} ? '_dbh' : 'dbh';
+ $self->$dbh_method->begin_work;
+
} elsif ($self->auto_savepoint) {
$self->svp_begin;
}
@@ -955,7 +1193,7 @@
my $sth = $self->sth($sql,$op);
- my $placeholder_index = 1;
+ my $placeholder_index = 1;
foreach my $bound (@$bind) {
my $attributes = {};
@@ -992,18 +1230,27 @@
sub insert {
my ($self, $source, $to_insert) = @_;
+# redispatch to insert method of storage we reblessed into, if necessary
+ if (not $self->_driver_determined) {
+ $self->_determine_driver;
+ goto $self->can('insert');
+ }
+
my $ident = $source->from;
my $bind_attributes = $self->source_bind_attributes($source);
my $updated_cols = {};
- $self->ensure_connected;
foreach my $col ( $source->columns ) {
if ( !defined $to_insert->{$col} ) {
my $col_info = $source->column_info($col);
if ( $col_info->{auto_nextval} ) {
- $updated_cols->{$col} = $to_insert->{$col} = $self->_sequence_fetch( 'nextval', $col_info->{sequence} || $self->_dbh_get_autoinc_seq($self->dbh, $source) );
+ $updated_cols->{$col} = $to_insert->{$col} = $self->_sequence_fetch(
+ 'nextval',
+ $col_info->{sequence} ||
+ $self->_dbh_get_autoinc_seq($self->_get_dbh, $source)
+ );
}
}
}
@@ -1014,7 +1261,7 @@
}
## Still not quite perfect, and EXPERIMENTAL
-## Currently it is assumed that all values passed will be "normal", i.e. not
+## Currently it is assumed that all values passed will be "normal", i.e. not
## scalar refs, or at least, all the same type as the first set, the statement is
## only prepped once.
sub insert_bulk {
@@ -1023,7 +1270,9 @@
my $table = $source->from;
@colvalues{@$cols} = (0..$#$cols);
my ($sql, @bind) = $self->sql_maker->insert($table, \%colvalues);
-
+
+ $self->_determine_driver;
+
$self->_query_start( $sql, @bind );
my $sth = $self->sth($sql);
@@ -1036,7 +1285,7 @@
my $bind_attributes = $self->source_bind_attributes($source);
## Bind the values and execute
- my $placeholder_index = 1;
+ my $placeholder_index = 1;
foreach my $bound (@bind) {
@@ -1083,8 +1332,9 @@
sub update {
my $self = shift @_;
my $source = shift @_;
+ $self->_determine_driver;
my $bind_attributes = $self->source_bind_attributes($source);
-
+
return $self->_execute('update' => [], $source, $bind_attributes, @_);
}
@@ -1092,9 +1342,9 @@
sub delete {
my $self = shift @_;
my $source = shift @_;
-
+ $self->_determine_driver;
my $bind_attrs = $self->source_bind_attributes($source);
-
+
return $self->_execute('delete' => [], $source, $bind_attrs, @_);
}
@@ -1193,10 +1443,10 @@
my $self = shift;
# localization is neccessary as
- # 1) there is no infrastructure to pass this around (easy to do, but will wait)
+ # 1) there is no infrastructure to pass this around before SQLA2
# 2) _select_args sets it and _prep_for_execute consumes it
my $sql_maker = $self->sql_maker;
- local $sql_maker->{for};
+ local $sql_maker->{_dbic_rs_attrs};
return $self->_execute($self->_select_args(@_));
}
@@ -1205,10 +1455,10 @@
my $self = shift;
# localization is neccessary as
- # 1) there is no infrastructure to pass this around (easy to do, but will wait)
+ # 1) there is no infrastructure to pass this around before SQLA2
# 2) _select_args sets it and _prep_for_execute consumes it
my $sql_maker = $self->sql_maker;
- local $sql_maker->{for};
+ local $sql_maker->{_dbic_rs_attrs};
# my ($op, $bind, $ident, $bind_attrs, $select, $cond, $order, $rows, $offset)
# = $self->_select_args($ident, $select, $cond, $attrs);
@@ -1228,8 +1478,19 @@
sub _select_args {
my ($self, $ident, $select, $where, $attrs) = @_;
+ my ($alias2source, $rs_alias) = $self->_resolve_ident_sources ($ident);
+
my $sql_maker = $self->sql_maker;
- my $alias2source = $self->_resolve_ident_sources ($ident);
+ $sql_maker->{_dbic_rs_attrs} = {
+ %$attrs,
+ select => $select,
+ from => $ident,
+ where => $where,
+ $rs_alias
+ ? ( _source_handle => $alias2source->{$rs_alias}->handle )
+ : ()
+ ,
+ };
# calculate bind_attrs before possible $ident mangling
my $bind_attrs = {};
@@ -1240,30 +1501,56 @@
my $fqcn = join ('.', $alias, $col);
$bind_attrs->{$fqcn} = $bindtypes->{$col} if $bindtypes->{$col};
- # so that unqualified searches can be bound too
- $bind_attrs->{$col} = $bind_attrs->{$fqcn} if $alias eq 'me';
+ # Unqialified column names are nice, but at the same time can be
+ # rather ambiguous. What we do here is basically go along with
+ # the loop, adding an unqualified column slot to $bind_attrs,
+ # alongside the fully qualified name. As soon as we encounter
+ # another column by that name (which would imply another table)
+ # we unset the unqualified slot and never add any info to it
+ # to avoid erroneous type binding. If this happens the users
+ # only choice will be to fully qualify his column name
+
+ if (exists $bind_attrs->{$col}) {
+ $bind_attrs->{$col} = {};
+ }
+ else {
+ $bind_attrs->{$col} = $bind_attrs->{$fqcn};
+ }
}
}
- my @limit;
- if ($attrs->{software_limit} ||
- $sql_maker->_default_limit_syntax eq "GenericSubQ") {
- $attrs->{software_limit} = 1;
- } else {
+ # adjust limits
+ if (
+ $attrs->{software_limit}
+ ||
+ $sql_maker->_default_limit_syntax eq "GenericSubQ"
+ ) {
+ $attrs->{software_limit} = 1;
+ }
+ else {
$self->throw_exception("rows attribute must be positive if present")
if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
# MySQL actually recommends this approach. I cringe.
$attrs->{rows} = 2**48 if not defined $attrs->{rows} and defined $attrs->{offset};
+ }
- if ($attrs->{rows} && keys %{$attrs->{collapse}}) {
- ($ident, $select, $where, $attrs)
- = $self->_adjust_select_args_for_limited_prefetch ($ident, $select, $where, $attrs);
- }
- else {
- push @limit, $attrs->{rows}, $attrs->{offset};
- }
+ my @limit;
+
+ # see if we need to tear the prefetch apart (either limited has_many or grouped prefetch)
+ # otherwise delegate the limiting to the storage, unless software limit was requested
+ if (
+ ( $attrs->{rows} && keys %{$attrs->{collapse}} )
+ ||
+ ( $attrs->{group_by} && @{$attrs->{group_by}} &&
+ $attrs->{_prefetch_select} && @{$attrs->{_prefetch_select}} )
+ ) {
+ ($ident, $select, $where, $attrs)
+ = $self->_adjust_select_args_for_complex_prefetch ($ident, $select, $where, $attrs);
}
+ elsif (! $attrs->{software_limit} ) {
+ push @limit, $attrs->{rows}, $attrs->{offset};
+ }
###
# This would be the point to deflate anything found in $where
@@ -1277,70 +1564,71 @@
my $order = { map
{ $attrs->{$_} ? ( $_ => $attrs->{$_} ) : () }
- (qw/order_by group_by having _virtual_order_by/ )
+ (qw/order_by group_by having/ )
};
-
- $sql_maker->{for} = delete $attrs->{for};
-
return ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $where, $order, @limit);
}
-sub _adjust_select_args_for_limited_prefetch {
+#
+# This is the code producing joined subqueries like:
+# SELECT me.*, other.* FROM ( SELECT me.* FROM ... ) JOIN other ON ...
+#
+sub _adjust_select_args_for_complex_prefetch {
my ($self, $from, $select, $where, $attrs) = @_;
- if ($attrs->{group_by} and @{$attrs->{group_by}}) {
- $self->throw_exception ('Prefetch with limit (rows/offset) is not supported on resultsets with a group_by attribute');
- }
-
- $self->throw_exception ('Prefetch with limit (rows/offset) is not supported on resultsets with a custom from attribute')
+ $self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute')
if (ref $from ne 'ARRAY');
+ # copies for mangling
+ $from = [ @$from ];
+ $select = [ @$select ];
+ $attrs = { %$attrs };
# separate attributes
my $sub_attrs = { %$attrs };
- delete $attrs->{$_} for qw/where bind rows offset/;
- delete $sub_attrs->{$_} for qw/for collapse select order_by/;
+ delete $attrs->{$_} for qw/where bind rows offset group_by having/;
+ delete $sub_attrs->{$_} for qw/for collapse _prefetch_select _collapse_order_by select as/;
- my $alias = $attrs->{alias};
+ my $select_root_alias = $attrs->{alias};
+ my $sql_maker = $self->sql_maker;
- # create subquery select list
- my $sub_select = [ grep { $_ =~ /^$alias\./ } @{$attrs->{select}} ];
+ # create subquery select list - consider only stuff *not* brought in by the prefetch
+ my $sub_select = [];
+ my $sub_group_by;
+ for my $i (0 .. @{$attrs->{select}} - @{$attrs->{_prefetch_select}} - 1) {
+ my $sel = $attrs->{select}[$i];
+ # alias any functions to the dbic-side 'as' label
+ # adjust the outer select accordingly
+ if (ref $sel eq 'HASH' ) {
+ $sel->{-as} ||= $attrs->{as}[$i];
+ $select->[$i] = join ('.', $attrs->{alias}, ($sel->{-as} || "select_$i") );
+ }
+
+ push @$sub_select, $sel;
+ }
+
# bring over all non-collapse-induced order_by into the inner query (if any)
# the outer one will have to keep them all
+ delete $sub_attrs->{order_by};
if (my $ord_cnt = @{$attrs->{order_by}} - @{$attrs->{_collapse_order_by}} ) {
$sub_attrs->{order_by} = [
- @{$attrs->{order_by}}[ 0 .. ($#{$attrs->{order_by}} - $ord_cnt - 1) ]
+ @{$attrs->{order_by}}[ 0 .. $ord_cnt - 1]
];
}
- # mangle {from}
- $from = [ @$from ];
- my $select_root = shift @$from;
- my @outer_from = @$from;
+ # mangle {from}, keep in mind that $from is "headless" from here on
+ my $join_root = shift @$from;
my %inner_joins;
my %join_info = map { $_->[0]{-alias} => $_->[0] } (@$from);
- # in complex search_related chains $alias may *not* be 'me'
- # so always include it in the inner join, and also shift away
- # from the outer stack, so that the two datasets actually do
- # meet
- if ($select_root->{-alias} ne $alias) {
- $inner_joins{$alias} = 1;
+ # in complex search_related chains $select_root_alias may *not* be
+ # 'me' so always include it in the inner join
+ $inner_joins{$select_root_alias} = 1 if ($join_root->{-alias} ne $select_root_alias);
- while (@outer_from && $outer_from[0][0]{-alias} ne $alias) {
- shift @outer_from;
- }
- if (! @outer_from) {
- $self->throw_exception ("Unable to find '$alias' in the {from} stack, something is wrong");
- }
- shift @outer_from; # the new subquery will represent this alias, so get rid of it
- }
-
-
# decide which parts of the join will remain on the inside
#
# this is not a very viable optimisation, but it was written
@@ -1348,7 +1636,7 @@
# away _any_ branches of the join tree that are:
# 1) not mentioned in the condition/order
# 2) left-join leaves (or left-join leaf chains)
- # Most of the join ocnditions will not satisfy this, but for real
+ # Most of the join conditions will not satisfy this, but for real
# complex queries some might, and we might make some RDBMS happy.
#
#
@@ -1358,8 +1646,9 @@
# It may not be very efficient, but it's a reasonable stop-gap
{
# produce stuff unquoted, so it can be scanned
- my $sql_maker = $self->sql_maker;
local $sql_maker->{quote_char};
+ my $sep = $self->_sql_maker_opts->{name_sep} || '.';
+ $sep = "\Q$sep\E";
my @order_by = (map
{ ref $_ ? $_->[0] : $_ }
@@ -1367,6 +1656,7 @@
);
my $where_sql = $sql_maker->where ($where);
+ my $select_sql = $sql_maker->_recurse_fields ($sub_select);
# sort needed joins
for my $alias (keys %join_info) {
@@ -1374,8 +1664,8 @@
# any table alias found on a column name in where or order_by
# gets included in %inner_joins
# Also any parent joins that are needed to reach this particular alias
- for my $piece ($where_sql, @order_by ) {
- if ($piece =~ /\b$alias\./) {
+ for my $piece ($select_sql, $where_sql, @order_by ) {
+ if ($piece =~ /\b $alias $sep/x) {
$inner_joins{$alias} = 1;
}
}
@@ -1398,21 +1688,22 @@
}
# construct the inner $from for the subquery
- my $inner_from = [ $select_root ];
+ my $inner_from = [ $join_root ];
for my $j (@$from) {
push @$inner_from, $j if $inner_joins{$j->[0]{-alias}};
}
# if a multi-type join was needed in the subquery ("multi" is indicated by
# presence in {collapse}) - add a group_by to simulate the collapse in the subq
+ unless ($sub_attrs->{group_by}) {
+ for my $alias (keys %inner_joins) {
- for my $alias (keys %inner_joins) {
-
- # the dot comes from some weirdness in collapse
- # remove after the rewrite
- if ($attrs->{collapse}{".$alias"}) {
- $sub_attrs->{group_by} = $sub_select;
- last;
+ # the dot comes from some weirdness in collapse
+ # remove after the rewrite
+ if ($attrs->{collapse}{".$alias"}) {
+ $sub_attrs->{group_by} ||= $sub_select;
+ last;
+ }
}
}
@@ -1423,12 +1714,47 @@
$where,
$sub_attrs
);
+ my $subq_joinspec = {
+ -alias => $select_root_alias,
+ -source_handle => $join_root->{-source_handle},
+ $select_root_alias => $subq,
+ };
- # put it in the new {from}
- unshift @outer_from, { $alias => $subq };
+ # Generate a new from (really just replace the join slot with the subquery)
+ # Before we would start the outer chain from the subquery itself (i.e.
+ # SELECT ... FROM (SELECT ... ) alias JOIN ..., but this turned out to be
+ # a bad idea for search_related, as the root of the chain was effectively
+ # lost (i.e. $artist_rs->search_related ('cds'... ) would result in alias
+ # of 'cds', which would prevent from doing things like order_by artist.*)
+ # See t/prefetch/via_search_related.t for a better idea
+ my @outer_from;
+ if ($join_root->{-alias} eq $select_root_alias) { # just swap the root part and we're done
+ @outer_from = (
+ $subq_joinspec,
+ @$from,
+ )
+ }
+ else { # this is trickier
+ @outer_from = ($join_root);
+ for my $j (@$from) {
+ if ($j->[0]{-alias} eq $select_root_alias) {
+ push @outer_from, [
+ $subq_joinspec,
+ @{$j}[1 .. $#$j],
+ ];
+ }
+ else {
+ push @outer_from, $j;
+ }
+ }
+ }
+
# This is totally horrific - the $where ends up in both the inner and outer query
- # Unfortunately not much can be done until SQLA2 introspection arrives
+ # Unfortunately not much can be done until SQLA2 introspection arrives, and even
+ # then if where conditions apply to the *right* side of the prefetch, you may have
+ # to both filter the inner select (e.g. to apply a limit) and then have to re-filter
+ # the outer select to exclude joins you didin't want in the first place
#
# OTOH it can be seen as a plus: <ash> (notes that this query would make a DBA cry ;)
return (\@outer_from, $select, $where, $attrs);
@@ -1438,12 +1764,14 @@
my ($self, $ident) = @_;
my $alias2source = {};
+ my $rs_alias;
# the reason this is so contrived is that $ident may be a {from}
# structure, specifying multiple tables to join
if ( Scalar::Util::blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
# this is compat mode for insert/update/delete which do not deal with aliases
$alias2source->{me} = $ident;
+ $rs_alias = 'me';
}
elsif (ref $ident eq 'ARRAY') {
@@ -1451,6 +1779,7 @@
my $tabinfo;
if (ref $_ eq 'HASH') {
$tabinfo = $_;
+ $rs_alias = $tabinfo->{-alias};
}
if (ref $_ eq 'ARRAY' and ref $_->[0] eq 'HASH') {
$tabinfo = $_->[0];
@@ -1461,9 +1790,59 @@
}
}
- return $alias2source;
+ return ($alias2source, $rs_alias);
}
+# Takes $ident, \@column_names
+#
+# returns { $column_name => \%column_info, ... }
+# also note: this adds -result_source => $rsrc to the column info
+#
+# usage:
+# my $col_sources = $self->_resolve_column_info($ident, @column_names);
+sub _resolve_column_info {
+ my ($self, $ident, $colnames) = @_;
+ my ($alias2src, $root_alias) = $self->_resolve_ident_sources($ident);
+
+ my $sep = $self->_sql_maker_opts->{name_sep} || '.';
+ $sep = "\Q$sep\E";
+
+ my (%return, %seen_cols);
+
+ # compile a global list of column names, to be able to properly
+ # disambiguate unqualified column names (if at all possible)
+ for my $alias (keys %$alias2src) {
+ my $rsrc = $alias2src->{$alias};
+ for my $colname ($rsrc->columns) {
+ push @{$seen_cols{$colname}}, $alias;
+ }
+ }
+
+ COLUMN:
+ foreach my $col (@$colnames) {
+ my ($alias, $colname) = $col =~ m/^ (?: ([^$sep]+) $sep)? (.+) $/x;
+
+ unless ($alias) {
+ # see if the column was seen exactly once (so we know which rsrc it came from)
+ if ($seen_cols{$colname} and @{$seen_cols{$colname}} == 1) {
+ $alias = $seen_cols{$colname}[0];
+ }
+ else {
+ next COLUMN;
+ }
+ }
+
+ my $rsrc = $alias2src->{$alias};
+ $return{$col} = $rsrc && {
+ %{$rsrc->column_info($colname)},
+ -result_source => $rsrc,
+ -source_alias => $alias,
+ };
+ }
+
+ return \%return;
+}
+
# Returns a counting SELECT for a simple count
# query. Abstracted so that a storage could override
# this to { count => 'firstcol' } or whatever makes
@@ -1660,7 +2039,7 @@
=cut
-sub sqlt_type { shift->dbh->{Driver}->{Name} }
+sub sqlt_type { shift->_get_dbh->{Driver}->{Name} }
=head2 bind_attribute_by_data_type
@@ -1743,13 +2122,13 @@
{ add_drop_table => 1, ignore_constraint_names => 1, ignore_index_names => 1 }
-merged with the hash passed in. To disable any of those features, pass in a
+merged with the hash passed in. To disable any of those features, pass in a
hashref like the following
{ ignore_constraint_names => 0, # ... other options }
-Note that this feature is currently EXPERIMENTAL and may not work correctly
+Note that this feature is currently EXPERIMENTAL and may not work correctly
across all databases, or fully handle complex relationships.
WARNING: Please check all SQL files created, before applying them.
@@ -1770,7 +2149,7 @@
$version ||= $schema_version;
$sqltargs = {
- add_drop_table => 1,
+ add_drop_table => 1,
ignore_constraint_names => 1,
ignore_index_names => 1,
%{$sqltargs || {}}
@@ -1810,7 +2189,7 @@
}
print $file $output;
close($file);
-
+
next unless ($preversion);
require SQL::Translator::Diff;
@@ -1826,7 +2205,7 @@
carp("Overwriting existing diff file - $difffile");
unlink($difffile);
}
-
+
my $source_schema;
{
my $t = SQL::Translator->new($sqltargs);
@@ -1845,7 +2224,7 @@
unless ( $source_schema->name );
}
- # The "new" style of producers have sane normalization and can support
+ # 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;
@@ -1866,12 +2245,12 @@
$dest_schema->name( $filename )
unless $dest_schema->name;
}
-
+
my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db,
$dest_schema, $db,
$sqltargs
);
- if(!open $file, ">$difffile") {
+ if(!open $file, ">$difffile") {
$self->throw_exception("Can't write to $difffile ($!)");
next;
}
@@ -1906,8 +2285,6 @@
sub deployment_statements {
my ($self, $schema, $type, $version, $dir, $sqltargs) = @_;
- # Need to be connected to get the correct sqlt_type
- $self->ensure_connected() unless $type;
$type ||= $self->sqlt_type;
$version ||= $schema->schema_version || '1.x';
$dir ||= './';
@@ -1915,7 +2292,7 @@
if(-f $filename)
{
my $file;
- open($file, "<$filename")
+ open($file, "<$filename")
or $self->throw_exception("Can't open $filename ($!)");
my @rows = <$file>;
close($file);
@@ -1926,18 +2303,18 @@
. $self->_check_sqlt_message . q{'})
if !$self->_check_sqlt_version;
- require SQL::Translator::Parser::DBIx::Class;
- eval qq{use SQL::Translator::Producer::${type}};
- $self->throw_exception($@) if $@;
-
- # sources needs to be a parser arg, but for simplicty allow at top level
+ # sources needs to be a parser arg, but for simplicty allow at top level
# coming in
$sqltargs->{parser_args}{sources} = delete $sqltargs->{sources}
if exists $sqltargs->{sources};
- my $tr = SQL::Translator->new(%$sqltargs);
- SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema );
- return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
+ my $tr = SQL::Translator->new(
+ producer => "SQL::Translator::Producer::${type}",
+ %$sqltargs,
+ parser => 'SQL::Translator::Parser::DBIx::Class',
+ data => $schema,
+ );
+ return $tr->translate;
}
sub deploy {
@@ -1952,7 +2329,9 @@
return if $line =~ /^\s+$/; # skip whitespace only
$self->_query_start($line);
eval {
- $self->dbh->do($line); # shouldn't be using ->dbh ?
+ # do a dbh_do cycle here, as we need some error checking in
+ # place (even though we will ignore errors)
+ $self->dbh_do (sub { $_[1]->do($line) });
};
if ($@) {
carp qq{$@ (running "${line}")};
@@ -1981,7 +2360,7 @@
sub datetime_parser {
my $self = shift;
return $self->{datetime_parser} ||= do {
- $self->ensure_connected;
+ $self->_populate_dbh unless $self->_dbh;
$self->build_datetime_parser(@_);
};
}
@@ -2035,7 +2414,7 @@
sub is_replicating {
return;
-
+
}
=head2 lag_behind_master
@@ -2052,8 +2431,13 @@
sub DESTROY {
my $self = shift;
- return if !$self->_dbh;
- $self->_verify_pid;
+ $self->_verify_pid if $self->_dbh;
+
+ # some databases need this to stop spewing warnings
+ if (my $dbh = $self->_dbh) {
+ eval { $dbh->disconnect };
+ }
+
$self->_dbh(undef);
}
@@ -2065,7 +2449,7 @@
DBIx::Class can do some wonderful magic with handling exceptions,
disconnections, and transactions when you use C<< AutoCommit => 1 >>
-combined with C<txn_do> for transaction support.
+(the default) combined with C<txn_do> for transaction support.
If you set C<< AutoCommit => 0 >> in your connect info, then you are always
in an assumed transaction between commits, and you're telling us you'd
@@ -2077,7 +2461,6 @@
be with raw DBI.
-
=head1 AUTHORS
Matt S. Trout <mst at shadowcatsystems.co.uk>
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/Statistics.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/Statistics.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage/Statistics.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -16,7 +16,7 @@
=head1 DESCRIPTION
This class is called by DBIx::Class::Storage::DBI as a means of collecting
-statistics on it's actions. Using this class alone merely prints the SQL
+statistics on its actions. Using this class alone merely prints the SQL
executed, the fact that it completes and begin/end notification for
transactions.
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/Storage.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -4,6 +4,7 @@
use warnings;
use base qw/DBIx::Class/;
+use mro 'c3';
use Scalar::Util qw/weaken/;
use Carp::Clan qw/^DBIx::Class/;
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/UTF8Columns.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/UTF8Columns.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class/UTF8Columns.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -25,7 +25,7 @@
package Artist;
__PACKAGE__->load_components(qw/UTF8Columns Core/);
__PACKAGE__->utf8_columns(qw/name description/);
-
+
# then belows return strings with utf8 flag
$artist->name;
$artist->get_column('description');
Modified: DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/DBIx/Class.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -3,11 +3,12 @@
use strict;
use warnings;
+use MRO::Compat;
+
use vars qw($VERSION);
use base qw/DBIx::Class::Componentised Class::Accessor::Grouped/;
use DBIx::Class::StartupCheck;
-
sub mk_classdata {
shift->mk_classaccessor(@_);
}
@@ -24,7 +25,7 @@
# i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports
# brain damage and presumably various other packaging systems too
-$VERSION = '0.08107';
+$VERSION = '0.08109';
$VERSION = eval $VERSION; # numify for warning-free dev releases
@@ -72,9 +73,11 @@
1;
-Create a table class to represent artists, who have many CDs, in
+Create a result class to represent artists, who have many CDs, in
MyDB/Schema/Result/Artist.pm:
+See L<DBIx::Class::ResultSource> for docs on defining result classes.
+
package MyDB::Schema::Result::Artist;
use base qw/DBIx::Class/;
@@ -86,7 +89,7 @@
1;
-A table class to represent a CD, which belongs to an artist, in
+A result class to represent a CD, which belongs to an artist, in
MyDB/Schema/Result/CD.pm:
package MyDB::Schema::Result::CD;
@@ -108,9 +111,17 @@
# Query for all artists and put them in an array,
# or retrieve them as a result set object.
+ # $schema->resultset returns a DBIx::Class::ResultSet
my @all_artists = $schema->resultset('Artist')->all;
my $all_artists_rs = $schema->resultset('Artist');
+ # Output all artists names
+ # $artist here is a DBIx::Class::Row, which has accessors
+ # for all its columns. Rows are also subclasses of your Result class.
+ foreach $artist (@artists) {
+ print $artist->name, "\n";
+ }
+
# Create a result set to search for artists.
# This does not query the DB.
my $johns_rs = $schema->resultset('Artist')->search(
@@ -301,6 +312,8 @@
rafl: Florian Ragwitz <rafl at debian.org>
+rbuels: Robert Buels <rmb32 at cornell.edu>
+
rdj: Ryan D Johnson <ryan at innerfence.com>
ribasushi: Peter Rabbitson <rabbit+dbic at rabbit.us>
@@ -317,6 +330,8 @@
solomon: Jared Johnson <jaredj at nmgi.com>
+spb: Stephen Bennett <stephen at freenode.net>
+
sszabo: Stephan Szabo <sszabo at bigpanda.com>
teejay : Aaron Trevena <teejay at cpan.org>
Modified: DBIx-Class/0.08/branches/prefetch/lib/SQL/Translator/Parser/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/SQL/Translator/Parser/DBIx/Class.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/SQL/Translator/Parser/DBIx/Class.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -14,6 +14,7 @@
use Exporter;
use SQL::Translator::Utils qw(debug normalize_name);
+use Carp::Clan qw/^SQL::Translator|^DBIx::Class/;
use base qw(Exporter);
@@ -34,11 +35,11 @@
my $dbicschema = $args->{'DBIx::Class::Schema'} || $args->{"DBIx::Schema"} ||$data;
$dbicschema ||= $args->{'package'};
my $limit_sources = $args->{'sources'};
-
- die 'No DBIx::Class::Schema' unless ($dbicschema);
+
+ croak 'No DBIx::Class::Schema' unless ($dbicschema);
if (!ref $dbicschema) {
eval "use $dbicschema;";
- die "Can't load $dbicschema ($@)" if($@);
+ croak "Can't load $dbicschema ($@)" if($@);
}
my $schema = $tr->schema;
@@ -47,12 +48,11 @@
$schema->name( ref($dbicschema) . " v" . ($dbicschema->schema_version || '1.x'))
unless ($schema->name);
- my %seen_tables;
-
my @monikers = sort $dbicschema->sources;
if ($limit_sources) {
my $ref = ref $limit_sources || '';
- die "'sources' parameter must be an array or hash ref" unless $ref eq 'ARRAY' || ref eq 'HASH';
+ $dbicschema->throw_exception ("'sources' parameter must be an array or hash ref")
+ unless( $ref eq 'ARRAY' || ref eq 'HASH' );
# limit monikers to those specified in
my $sources;
@@ -76,21 +76,24 @@
}
}
+ my %tables;
foreach my $moniker (sort @table_monikers)
{
my $source = $dbicschema->source($moniker);
-
- # Skip custom query sources
- next if ref($source->name);
+ my $table_name = $source->name;
- # Its possible to have multiple DBIC source using same table
- next if $seen_tables{$source->name}++;
+ # FIXME - this isn't the right way to do it, but sqlt does not
+ # support quoting properly to be signaled about this
+ $table_name = $$table_name if ref $table_name eq 'SCALAR';
- my $table = $schema->add_table(
- name => $source->name,
+ # Its possible to have multiple DBIC sources using the same table
+ next if $tables{$table_name};
+
+ $tables{$table_name}{source} = $source;
+ my $table = $tables{$table_name}{object} = SQL::Translator::Schema::Table->new(
+ name => $table_name,
type => 'TABLE',
- ) || die $schema->error;
- my $colcount = 0;
+ );
foreach my $col ($source->columns)
{
# assuming column_info in dbic is the same as DBI (?)
@@ -106,7 +109,8 @@
if ($colinfo{is_nullable}) {
$colinfo{default} = '' unless exists $colinfo{default};
}
- my $f = $table->add_field(%colinfo) || die $table->error;
+ my $f = $table->add_field(%colinfo)
+ || $dbicschema->throw_exception ($table->error);
}
$table->primary_key($source->primary_columns);
@@ -125,7 +129,7 @@
my @rels = $source->relationships();
my %created_FK_rels;
-
+
# global add_fk_index set in parser_args
my $add_fk_index = (exists $args->{add_fk_index} && ($args->{add_fk_index} == 0)) ? 0 : 1;
@@ -139,6 +143,10 @@
my $othertable = $source->related_source($rel);
my $rel_table = $othertable->name;
+ # FIXME - this isn't the right way to do it, but sqlt does not
+ # support quoting properly to be signaled about this
+ $rel_table = $$rel_table if ref $rel_table eq 'SCALAR';
+
my $reverse_rels = $source->reverse_relationship_info($rel);
my ($otherrelname, $otherrelationship) = each %{$reverse_rels};
@@ -146,7 +154,7 @@
my $idx;
my %other_columns_idx = map {'foreign.'.$_ => ++$idx } $othertable->columns;
my @cond = sort { $other_columns_idx{$a} cmp $other_columns_idx{$b} } keys(%{$rel_info->{cond}});
-
+
# Get the key information, mapping off the foreign/self markers
my @refkeys = map {/^\w+\.(\w+)$/} @cond;
my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
@@ -177,7 +185,7 @@
$cascade->{$c} = $rel_info->{attrs}{"on_$c"};
}
else {
- warn "SQLT attribute 'on_$c' was supplied for relationship '$moniker/$rel', which does not appear to be a foreign constraint. "
+ carp "SQLT attribute 'on_$c' was supplied for relationship '$moniker/$rel', which does not appear to be a foreign constraint. "
. "If you are sure that SQLT must generate a constraint for this relationship, add 'is_foreign_key_constraint => 1' to the attributes.\n";
}
}
@@ -195,17 +203,21 @@
my $key_test = join("\x00", @keys);
next if $created_FK_rels{$rel_table}->{$key_test};
- my $is_deferrable = $rel_info->{attrs}{is_deferrable};
-
- # global parser_args add_fk_index param can be overridden on the rel def
- my $add_fk_index_rel = (exists $rel_info->{attrs}{add_fk_index}) ? $rel_info->{attrs}{add_fk_index} : $add_fk_index;
+ if (scalar(@keys)) {
+ $created_FK_rels{$rel_table}->{$key_test} = 1;
- $created_FK_rels{$rel_table}->{$key_test} = 1;
- if (scalar(@keys)) {
+ my $is_deferrable = $rel_info->{attrs}{is_deferrable};
+
+ # do not consider deferrable constraints and self-references
+ # for dependency calculations
+ if (! $is_deferrable and $rel_table ne $table_name) {
+ $tables{$table_name}{foreign_table_deps}{$rel_table}++;
+ }
+
$table->add_constraint(
type => 'foreign_key',
- name => join('_', $table->name, 'fk', @keys),
+ name => join('_', $table_name, 'fk', @keys),
fields => \@keys,
reference_fields => \@refkeys,
reference_table => $rel_table,
@@ -213,10 +225,13 @@
on_update => uc ($cascade->{update} || ''),
(defined $is_deferrable ? ( deferrable => $is_deferrable ) : ()),
);
-
+
+ # global parser_args add_fk_index param can be overridden on the rel def
+ my $add_fk_index_rel = (exists $rel_info->{attrs}{add_fk_index}) ? $rel_info->{attrs}{add_fk_index} : $add_fk_index;
+
if ($add_fk_index_rel) {
my $index = $table->add_index(
- name => join('_', $table->name, 'idx', @keys),
+ name => join('_', $table_name, 'idx', @keys),
fields => \@keys,
type => 'NORMAL',
);
@@ -224,31 +239,66 @@
}
}
}
-
- $source->_invoke_sqlt_deploy_hook($table);
+
}
+ # attach the tables to the schema in dependency order
+ my $dependencies = {
+ map { $_ => _resolve_deps ($_, \%tables) } (keys %tables)
+ };
+ for my $table (sort
+ {
+ keys %{$dependencies->{$a} || {} } <=> keys %{ $dependencies->{$b} || {} }
+ ||
+ $a cmp $b
+ }
+ (keys %tables)
+ ) {
+ $schema->add_table ($tables{$table}{object});
+ $tables{$table}{source} -> _invoke_sqlt_deploy_hook( $tables{$table}{object} );
+
+ # the hook might have already removed the table
+ if ($schema->get_table($table) && $table =~ /^ \s* \( \s* SELECT \s+/ix) {
+ warn <<'EOW';
+
+Custom SQL through ->name(\'( SELECT ...') is DEPRECATED, for more details see
+"Arbitrary SQL through a custom ResultSource" in DBIx::Class::Manual::Cookbook
+or http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class/Manual/Cookbook.pod
+
+EOW
+
+ # remove the table as there is no way someone might want to
+ # actually deploy this
+ $schema->drop_table ($table);
+ }
+ }
+
+ my %views;
foreach my $moniker (sort @view_monikers)
{
my $source = $dbicschema->source($moniker);
+ my $view_name = $source->name;
+
+ # FIXME - this isn't the right way to do it, but sqlt does not
+ # support quoting properly to be signaled about this
+ $view_name = $$view_name if ref $view_name eq 'SCALAR';
+
# Skip custom query sources
- next if ref($source->name);
+ next if ref $view_name;
# Its possible to have multiple DBIC source using same table
- next if $seen_tables{$source->name}++;
+ next if $views{$view_name}++;
- my $view = $schema->add_view(
- name => $source->name,
+ my $view = $schema->add_view (
+ name => $view_name,
fields => [ $source->columns ],
$source->view_definition ? ( 'sql' => $source->view_definition ) : ()
- );
- if ($source->result_class->can('sqlt_deploy_hook')) {
- $source->result_class->sqlt_deploy_hook($view);
- }
+ ) || $dbicschema->throw_exception ($schema->error);
$source->_invoke_sqlt_deploy_hook($view);
}
+
if ($dbicschema->can('sqlt_deploy_hook')) {
$dbicschema->sqlt_deploy_hook($schema);
}
@@ -256,6 +306,41 @@
return 1;
}
+#
+# Quick and dirty dependency graph calculator
+#
+sub _resolve_deps {
+ my ($table, $tables, $seen) = @_;
+
+ my $ret = {};
+ $seen ||= {};
+
+ # copy and bump all deps by one (so we can reconstruct the chain)
+ my %seen = map { $_ => $seen->{$_} + 1 } (keys %$seen);
+ $seen{$table} = 1;
+
+ for my $dep (keys %{$tables->{$table}{foreign_table_deps}} ) {
+
+ if ($seen->{$dep}) {
+
+ # warn and remove the circular constraint so we don't get flooded with the same warning over and over
+ #carp sprintf ("Circular dependency detected, schema may not be deployable:\n%s\n",
+ # join (' -> ', (sort { $seen->{$b} <=> $seen->{$a} } (keys %$seen) ), $table, $dep )
+ #);
+ #delete $tables->{$table}{foreign_table_deps}{$dep};
+
+ return {};
+ }
+
+ my $subdeps = _resolve_deps ($dep, $tables, \%seen);
+ $ret->{$_} += $subdeps->{$_} for ( keys %$subdeps );
+
+ ++$ret->{$dep};
+ }
+
+ return $ret;
+}
+
1;
=head1 NAME
@@ -275,7 +360,7 @@
## Standalone
use MyApp::Schema;
use SQL::Translator;
-
+
my $schema = MyApp::Schema->connect;
my $trans = SQL::Translator->new (
parser => 'SQL::Translator::Parser::DBIx::Class',
@@ -291,7 +376,7 @@
C<SQL::Translator::Parser::DBIx::Class> reads a DBIx::Class schema,
interrogates the columns, and stuffs it all in an $sqlt_schema object.
-It's primary use is in deploying database layouts described as a set
+Its primary use is in deploying database layouts described as a set
of L<DBIx::Class> classes, to a database. To do this, see
L<DBIx::Class::Schema/deploy>.
Modified: DBIx-Class/0.08/branches/prefetch/lib/SQL/Translator/Producer/DBIx/Class/File.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/lib/SQL/Translator/Producer/DBIx/Class/File.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/lib/SQL/Translator/Producer/DBIx/Class/File.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -128,7 +128,7 @@
$tableextras{$table->name} .= "\n__PACKAGE__->belongs_to('" .
$cont->fields->[0]->name . "', '" .
"${dbixschema}::" . $cont->reference_table . "');\n";
-
+
my $other = "\n__PACKAGE__->has_many('" .
"get_" . $table->name. "', '" .
"${dbixschema}::" . $table->name. "', '" .
Modified: DBIx-Class/0.08/branches/prefetch/t/03podcoverage.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/03podcoverage.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/03podcoverage.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -106,6 +106,7 @@
'DBIx::Class::ResultSetManager' => { skip => 1 },
'DBIx::Class::ResultSourceProxy' => { skip => 1 },
'DBIx::Class::Storage::DBI' => { skip => 1 },
+ 'DBIx::Class::Storage::DBI::Replicated::Types' => { skip => 1 },
'DBIx::Class::Storage::DBI::DB2' => { skip => 1 },
'DBIx::Class::Storage::DBI::MSSQL' => { skip => 1 },
'DBIx::Class::Storage::DBI::Sybase::MSSQL' => { skip => 1 },
@@ -116,7 +117,9 @@
'DBIx::Class::Storage::DBI::Pg' => { skip => 1 },
'DBIx::Class::Storage::DBI::SQLite' => { skip => 1 },
'DBIx::Class::Storage::DBI::mysql' => { skip => 1 },
+ 'DBIx::Class::SQLAHacks' => { skip => 1 },
'DBIx::Class::SQLAHacks::MySQL' => { skip => 1 },
+ 'DBIx::Class::SQLAHacks::MSSQL' => { skip => 1 },
'SQL::Translator::Parser::DBIx::Class' => { skip => 1 },
'SQL::Translator::Producer::DBIx::Class::File' => { skip => 1 },
Modified: DBIx-Class/0.08/branches/prefetch/t/19quotes.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/19quotes.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/19quotes.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -36,7 +36,7 @@
eval { $rs->count };
is_same_sql_bind(
$sql, \@bind,
- "SELECT COUNT( * ) FROM `cd` `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )", ["'Caterwauler McCrae'", "'2001'"],
+ "SELECT COUNT( * ) FROM cd `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )", ["'Caterwauler McCrae'", "'2001'"],
'got correct SQL for count query with quoting'
);
@@ -60,7 +60,7 @@
eval { $rs->count };
is_same_sql_bind(
$sql, \@bind,
- "SELECT COUNT( * ) FROM [cd] [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )", ["'Caterwauler McCrae'", "'2001'"],
+ "SELECT COUNT( * ) FROM cd [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )", ["'Caterwauler McCrae'", "'2001'"],
'got correct SQL for count query with bracket quoting'
);
Modified: DBIx-Class/0.08/branches/prefetch/t/19quotes_newstyle.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/19quotes_newstyle.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/19quotes_newstyle.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -42,7 +42,7 @@
eval { $rs->count };
is_same_sql_bind(
$sql, \@bind,
- "SELECT COUNT( * ) FROM `cd` `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )", ["'Caterwauler McCrae'", "'2001'"],
+ "SELECT COUNT( * ) FROM cd `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )", ["'Caterwauler McCrae'", "'2001'"],
'got correct SQL for count query with quoting'
);
@@ -73,7 +73,7 @@
eval { $rs->count };
is_same_sql_bind(
$sql, \@bind,
- "SELECT COUNT( * ) FROM [cd] [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )", ["'Caterwauler McCrae'", "'2001'"],
+ "SELECT COUNT( * ) FROM cd [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )", ["'Caterwauler McCrae'", "'2001'"],
'got correct SQL for count query with bracket quoting'
);
Modified: DBIx-Class/0.08/branches/prefetch/t/31stats.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/31stats.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/31stats.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -4,12 +4,7 @@
use warnings;
use Test::More;
-BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 12 );
-}
+plan tests => 12;
use lib qw(t/lib);
Modified: DBIx-Class/0.08/branches/prefetch/t/42toplimit.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/42toplimit.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/42toplimit.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -10,12 +10,31 @@
# Trick the sqlite DB to use Top limit emulation
# We could test all of this via $sq->$op directly,
-# but some conditions needs a $rsrc
+# but some conditions need a $rsrc
delete $schema->storage->_sql_maker->{_cached_syntax};
$schema->storage->_sql_maker->limit_dialect ('Top');
-my $rs = $schema->resultset ('FourKeys')->search ({}, { rows => 1, offset => 3 });
+my $rs = $schema->resultset ('BooksInLibrary')->search ({}, { prefetch => 'owner', rows => 1, offset => 3 });
+sub default_test_order {
+ my $order_by = shift;
+ is_same_sql_bind(
+ $rs->search ({}, {order_by => $order_by})->as_query,
+ "(SELECT
+ TOP 1 me__id, source, owner, title, price, owner__id, name FROM
+ (SELECT
+ TOP 4 me.id AS me__id, me.source, me.owner, me.title, me.price, owner.id AS owner__id, owner.name
+ FROM books me
+ JOIN owners owner ON
+ owner.id = me.owner
+ WHERE ( source = ? )
+ ORDER BY me__id ASC
+ ) me ORDER BY me__id DESC
+ )",
+ [ [ source => 'Library' ] ],
+ );
+}
+
sub test_order {
my $args = shift;
@@ -26,24 +45,29 @@
is_same_sql_bind(
$rs->search ({}, {order_by => $args->{order_by}})->as_query,
- "(
- SELECT * FROM (
- SELECT TOP 1 * FROM (
- SELECT TOP 4 me.foo, me.bar, me.hello, me.goodbye, me.sensors, me.read_count FROM fourkeys me ORDER BY $args->{order_inner}
- ) foo ORDER BY $args->{order_outer}
- ) bar
- $req_order
+ "(SELECT
+ me__id, source, owner, title, price, owner__id, name FROM
+ (SELECT
+ TOP 1 me__id, source, owner, title, price, owner__id, name FROM
+ (SELECT
+ TOP 4 me.id AS me__id, me.source, me.owner, me.title, me.price, owner.id AS owner__id, owner.name FROM
+ books me
+ JOIN owners owner ON owner.id = me.owner
+ WHERE ( source = ? )
+ ORDER BY $args->{order_inner}
+ ) me ORDER BY $args->{order_outer}
+ ) me $req_order
)",
- [],
+ [ [ source => 'Library' ] ],
);
}
my @tests = (
{
- order_by => \ 'foo DESC',
+ order_by => \'foo DESC',
order_req => 'foo DESC',
order_inner => 'foo DESC',
- order_outer => 'foo ASC'
+ order_outer => 'foo ASC'
},
{
order_by => { -asc => 'foo' },
@@ -91,48 +115,38 @@
order_inner => 'foo ASC, bar DESC, hello ASC, sensors ASC',
order_outer => 'foo DESC, bar ASC, hello DESC, sensors DESC',
},
- {
- order_by => undef,
- order_req => undef,
- order_inner => 'foo ASC, bar ASC, hello ASC, goodbye ASC',
- order_outer => 'foo DESC, bar DESC, hello DESC, goodbye DESC',
- },
- {
- order_by => '',
- order_req => undef,
- order_inner => 'foo ASC, bar ASC, hello ASC, goodbye ASC',
- order_outer => 'foo DESC, bar DESC, hello DESC, goodbye DESC',
- },
- {
- order_by => {},
- order_req => undef,
- order_inner => 'foo ASC, bar ASC, hello ASC, goodbye ASC',
- order_outer => 'foo DESC, bar DESC, hello DESC, goodbye DESC',
- },
- {
- order_by => [],
- order_req => undef,
- order_inner => 'foo ASC, bar ASC, hello ASC, goodbye ASC',
- order_outer => 'foo DESC, bar DESC, hello DESC, goodbye DESC',
- },
);
-plan (tests => scalar @tests + 1);
+my @default_tests = ( undef, '', {}, [] );
+plan (tests => scalar @tests + scalar @default_tests + 1);
+
test_order ($_) for @tests;
+default_test_order ($_) for @default_tests;
+
is_same_sql_bind (
- $rs->search ({}, { group_by => 'bar', order_by => 'bar' })->as_query,
- '(
- SELECT * FROM
- (
- SELECT TOP 1 * FROM
- (
- SELECT TOP 4 me.foo, me.bar, me.hello, me.goodbye, me.sensors, me.read_count FROM fourkeys me GROUP BY bar ORDER BY bar ASC
- ) AS foo
- ORDER BY bar DESC
- ) AS bar
- ORDER BY bar
- )',
- [],
+ $rs->search ({}, { group_by => 'title', order_by => 'title' })->as_query,
+'(SELECT
+me.id, me.source, me.owner, me.title, me.price, owner.id, owner.name FROM
+ ( SELECT
+ id, source, owner, title, price FROM
+ ( SELECT
+ TOP 1 id, source, owner, title, price FROM
+ ( SELECT
+ TOP 4 me.id, me.source, me.owner, me.title, me.price FROM
+ books me JOIN
+ owners owner ON owner.id = me.owner
+ WHERE ( source = ? )
+ GROUP BY title
+ ORDER BY title ASC
+ ) me
+ ORDER BY title DESC
+ ) me
+ ORDER BY title
+ ) me JOIN
+ owners owner ON owner.id = me.owner WHERE
+ ( source = ? )
+ ORDER BY title)' ,
+ [ [ source => 'Library' ], [ source => 'Library' ] ],
);
Modified: DBIx-Class/0.08/branches/prefetch/t/46where_attribute.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/46where_attribute.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/46where_attribute.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -7,7 +7,7 @@
use DBICTest;
my $schema = DBICTest->init_schema();
-plan tests => 16;
+plan tests => 19;
# select from a class with resultset_attributes
my $resultset = $schema->resultset('BooksInLibrary');
@@ -72,3 +72,14 @@
if ($@) { print $@ }
ok( !$@, 'many_to_many add_to_$rel($hash) did not throw');
is($round_objects->count, $round_count+1, 'many_to_many add_to_$rel($hash) count correct');
+
+# test set_$rel
+$round_count = $round_objects->count();
+$pointy_count = $pointy_objects->count();
+my @all_pointy_objects = $pointy_objects->all;
+# doing a set on pointy objects with its current set should not change any counts
+eval {$collection->set_pointy_objects(\@all_pointy_objects)};
+if ($@) { print $@ }
+ok( !$@, 'many_to_many set_$rel(\@objects) did not throw');
+is($pointy_objects->count, $pointy_count, 'many_to_many set_$rel($hash) count correct');
+is($round_objects->count, $round_count, 'many_to_many set_$rel($hash) other rel count correct');
Modified: DBIx-Class/0.08/branches/prefetch/t/60core.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/60core.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/60core.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -9,8 +9,6 @@
my $schema = DBICTest->init_schema();
-plan tests => 106;
-
eval { require DateTime::Format::SQLite };
my $NO_DTFM = $@ ? 1 : 0;
@@ -229,20 +227,6 @@
is ($collapsed_or_rs->all, 4, 'Collapsed joined search with OR returned correct number of rows');
is ($collapsed_or_rs->count, 4, 'Collapsed search count with OR ok');
-my $pref_or_rs = $collapsed_or_rs->search ({}, { prefetch => [qw/tags/] });
-is_same_sql_bind (
- $pref_or_rs->as_query,
- '(SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track, tags.tagid, tags.cd, tags.tag FROM cd me LEFT JOIN tags tags ON tags.cd = me.cdid WHERE ( ( tags.tag = ? OR tags.tag = ? ) ) GROUP BY me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track, tags.tagid, tags.cd, tags.tag ORDER BY cdid, tags.cd, tags.tag)',
- [
- [ 'tags.tag' => 'Cheesy' ],
- [ 'tags.tag' => 'Blue' ],
- ],
- 'Prefetch + distinct resulted in correct group_by',
-);
-is ($pref_or_rs->all, 4, 'Prefetched grouped search with OR returned correct number of rows');
-is ($pref_or_rs->count, 4, 'Prefetched grouped count with OR ok');
-
-
{
my $tcount = $schema->resultset('Track')->search(
{},
@@ -422,3 +406,52 @@
ok (! DBIx::Class::ResultSource->can ($_), "$_ no longer provided by DBIx::Class::ResultSource");
}
}
+
+#------------------------------
+# READ THIS BEFORE "FIXING"
+#------------------------------
+#
+# make sure we got rid of discard_changes mess - this is a mess and a source
+# of great confusion. Here I simply die if the methods are available, which
+# is wrong on its own (we *have* to provide some sort of back-compat, even
+# if with warnings). Here is how I envision things should actually be. Also
+# note that a lot of the deprecation can be started today (i.e. the switch
+# from get_from_storage to copy_from_storage). So:
+#
+# $row->discard_changes =>
+# warning, and delegation to reload_from_storage
+#
+# $row->reload_from_storage =>
+# does what discard changes did in 0.08 - issues a query to the db
+# and repopulates all column slots, regardless of dirty states etc.
+#
+# $row->revert_changes =>
+# does what discard_changes should have done initially (before it became
+# a dual-purpose call). In order to make this work we will have to
+# augment $row to carry its own initial-state, much like svn has a
+# copy of the current checkout in contrast to cvs.
+#
+# my $db_row = $row->get_from_storage =>
+# warns and delegates to an improved name copy_from_storage, with the
+# same semantics
+#
+# my $db_row = $row->copy_from_storage =>
+# a much better/descriptive name than get_from_storage
+#
+#------------------------------
+# READ THIS BEFORE "FIXING"
+#------------------------------
+#
+SKIP: {
+ skip "Something needs to be done before 0.09", 2 if $DBIx::Class::VERSION < 0.09;
+
+ my $row = $schema->resultset ('Artist')->next;
+
+ for (qw/discard_changes get_from_storage/) {
+ ok (! $row->can ($_), "$_ needs *some* sort of facelift before 0.09 ships - current state of affairs is unacceptable");
+ }
+}
+
+throws_ok { $schema->resultset} qr/resultset\(\) expects a source name/, 'resultset with no argument throws exception';
+
+done_testing;
Modified: DBIx-Class/0.08/branches/prefetch/t/71mysql.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/71mysql.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/71mysql.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -155,41 +155,38 @@
is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
}
+my $cd = $schema->resultset ('CD')->create ({});
+my $producer = $schema->resultset ('Producer')->create ({});
+lives_ok { $cd->set_producers ([ $producer ]) } 'set_relationship doesnt die';
+
+
## Can we properly deal with the null search problem?
##
## Only way is to do a SET SQL_AUTO_IS_NULL = 0; on connect
## But I'm not sure if we should do this or not (Ash, 2008/06/03)
+#
+# There is now a built-in function to do this, test that everything works
+# with it (ribasushi, 2009/07/03)
NULLINSEARCH: {
-
- ok my $artist1_rs = $schema->resultset('Artist')->search({artistid=>6666})
- => 'Created an artist resultset of 6666';
-
+ my $ansi_schema = DBICTest::Schema->connect ($dsn, $user, $pass, { on_connect_call => 'set_strict_mode' });
+
+ $ansi_schema->resultset('Artist')->create ({ name => 'last created artist' });
+
+ ok my $artist1_rs = $ansi_schema->resultset('Artist')->search({artistid=>6666})
+ => 'Created an artist resultset of 6666';
+
is $artist1_rs->count, 0
- => 'Got no returned rows';
-
- ok my $artist2_rs = $schema->resultset('Artist')->search({artistid=>undef})
- => 'Created an artist resultset of undef';
-
- TODO: {
- local $TODO = "need to fix the row count =1 when select * from table where pk IS NULL problem";
- is $artist2_rs->count, 0
- => 'got no rows';
- }
+ => 'Got no returned rows';
- my $artist = $artist2_rs->single;
-
- is $artist => undef
- => 'Nothing Found!';
-}
-
-my $cd = $schema->resultset ('CD')->create ({});
+ ok my $artist2_rs = $ansi_schema->resultset('Artist')->search({artistid=>undef})
+ => 'Created an artist resultset of undef';
-my $producer = $schema->resultset ('Producer')->create ({});
+ is $artist2_rs->count, 0
+ => 'got no rows';
-lives_ok { $cd->set_producers ([ $producer ]) } 'set_relationship doesnt die';
+ my $artist = $artist2_rs->single;
-# clean up our mess
-END {
- #$dbh->do("DROP TABLE artist") if $dbh;
+ is $artist => undef
+ => 'Nothing Found!';
}
Modified: DBIx-Class/0.08/branches/prefetch/t/72pg.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/72pg.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/72pg.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,5 +1,5 @@
use strict;
-use warnings;
+use warnings;
use Test::More;
use Test::Exception;
@@ -46,14 +46,11 @@
plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test '.
'(note: This test drops and creates tables called \'artist\', \'casecheck\', \'array_test\' and \'sequence_test\''.
' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\''.
- ' as well as following schemas: \'testschema\'!)'
+ ' as well as following schemas: \'testschema\',\'anothertestschema\'!)'
unless ($dsn && $user);
-
-plan tests => 39;
-
DBICTest::Schema->load_classes( 'Casecheck', 'ArrayTest' );
-my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+my $schema = DBICTest::Schema->connect($dsn, $user, $pass,);
# Check that datetime_parser returns correctly before we explicitly connect.
SKIP: {
@@ -74,14 +71,28 @@
local $SIG{__WARN__} = sub {};
_cleanup ($dbh);
+ my $artist_table_def = <<EOS;
+(
+ artistid serial PRIMARY KEY
+ , name VARCHAR(100)
+ , rank INTEGER NOT NULL DEFAULT '13'
+ , charfield CHAR(10)
+ , arrayfield INTEGER[]
+)
+EOS
$dbh->do("CREATE SCHEMA testschema;");
- $dbh->do("CREATE TABLE testschema.artist (artistid serial PRIMARY KEY, name VARCHAR(100), rank INTEGER NOT NULL DEFAULT '13', charfield CHAR(10), arrayfield INTEGER[]);");
+ $dbh->do("CREATE TABLE testschema.artist $artist_table_def;");
$dbh->do("CREATE TABLE testschema.sequence_test (pkid1 integer, pkid2 integer, nonpkid integer, name VARCHAR(100), CONSTRAINT pk PRIMARY KEY(pkid1, pkid2));");
$dbh->do("CREATE SEQUENCE pkid1_seq START 1 MAXVALUE 999999 MINVALUE 0");
$dbh->do("CREATE SEQUENCE pkid2_seq START 10 MAXVALUE 999999 MINVALUE 0");
$dbh->do("CREATE SEQUENCE nonpkid_seq START 20 MAXVALUE 999999 MINVALUE 0");
ok ( $dbh->do('CREATE TABLE testschema.casecheck (id serial PRIMARY KEY, "name" VARCHAR(1), "NAME" VARCHAR(2), "UC_NAME" VARCHAR(3), "storecolumn" VARCHAR(10));'), 'Creation of casecheck table');
ok ( $dbh->do('CREATE TABLE testschema.array_test (id serial PRIMARY KEY, arrayfield INTEGER[]);'), 'Creation of array_test table');
+ $dbh->do("CREATE SCHEMA anothertestschema;");
+ $dbh->do("CREATE TABLE anothertestschema.artist $artist_table_def;");
+ $dbh->do("CREATE SCHEMA yetanothertestschema;");
+ $dbh->do("CREATE TABLE yetanothertestschema.artist $artist_table_def;");
+ $dbh->do('set search_path=testschema,public');
}
# store_column is called once for create() for non sequence columns
@@ -94,14 +105,43 @@
# This is in Core now, but it's here just to test that it doesn't break
$schema->class('Artist')->load_components('PK::Auto');
+cmp_ok( $schema->resultset('Artist')->count, '==', 0, 'this should start with an empty artist table');
+
+{ # test that auto-pk also works with the defined search path by
+ # un-schema-qualifying the table name
+ my $artist_name_save = $schema->source("Artist")->name;
+ $schema->source("Artist")->name("artist");
+
+ my $unq_new;
+ lives_ok {
+ $unq_new = $schema->resultset('Artist')->create({ name => 'baz' });
+ } 'insert into unqualified, shadowed table succeeds';
+
+ is($unq_new && $unq_new->artistid, 1, "and got correct artistid");
+
+ #test with anothertestschema
+ $schema->source('Artist')->name('anothertestschema.artist');
+ my $another_new = $schema->resultset('Artist')->create({ name => 'ribasushi'});
+ is( $another_new->artistid,1, 'got correct artistid for yetanotherschema');
+
+ #test with yetanothertestschema
+ $schema->source('Artist')->name('yetanothertestschema.artist');
+ my $yetanother_new = $schema->resultset('Artist')->create({ name => 'ribasushi'});
+ is( $yetanother_new->artistid,1, 'got correct artistid for yetanotherschema');
+ is( $yetanother_new->artistid,1, 'got correct artistid for yetanotherschema');
+
+ $schema->source("Artist")->name($artist_name_save);
+}
+
my $new = $schema->resultset('Artist')->create({ name => 'foo' });
-is($new->artistid, 1, "Auto-PK worked");
+is($new->artistid, 2, "Auto-PK worked");
$new = $schema->resultset('Artist')->create({ name => 'bar' });
-is($new->artistid, 2, "Auto-PK worked");
+is($new->artistid, 3, "Auto-PK worked");
+
my $test_type_info = {
'artistid' => {
'data_type' => 'integer',
@@ -144,7 +184,9 @@
is_deeply($type_info, $test_type_info,
'columns_info_for - column data types');
-{
+SKIP: {
+ skip "Need DBD::Pg 2.9.2 or newer for array tests", 4 if $DBD::Pg::VERSION < 2.009002;
+
lives_ok {
$schema->resultset('ArrayTest')->create({
arrayfield => [1, 2],
@@ -278,9 +320,15 @@
'DROP SEQUENCE pkid2_seq',
'DROP SEQUENCE nonpkid_seq',
'DROP SCHEMA testschema',
+ 'DROP TABLE anothertestschema.artist',
+ 'DROP SCHEMA anothertestschema',
+ 'DROP TABLE yetanothertestschema.artist',
+ 'DROP SCHEMA yetanothertestschema',
) {
eval { $dbh->do ($stat) };
}
}
+done_testing;
+
END { _cleanup($dbh) }
Modified: DBIx-Class/0.08/branches/prefetch/t/73oracle.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/73oracle.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/73oracle.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -40,7 +40,7 @@
' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\''
unless ($dsn && $user && $pass);
-plan tests => 34;
+plan tests => 35;
DBICTest::Schema->load_classes('ArtistFQN');
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
@@ -64,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, last_updated_at 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, small_dt 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))");
@@ -113,15 +113,19 @@
is( $new->artistid, 2, "Oracle Auto-PK worked with fully-qualified tablename" );
# test join with row count ambiguity
+
my $cd = $schema->resultset('CD')->create({ cdid => 1, artist => 1, title => 'EP C', year => '2003' });
-my $track = $schema->resultset('Track')->create({ trackid => 1, cd => 1, position => 1, title => 'Track1' });
+my $track = $schema->resultset('Track')->create({ trackid => 1, cd => 1,
+ position => 1, title => 'Track1' });
my $tjoin = $schema->resultset('Track')->search({ 'me.title' => 'Track1'},
{ join => 'cd',
rows => 2 }
);
-is($tjoin->next->title, 'Track1', "ambiguous column ok");
+ok(my $row = $tjoin->next);
+is($row->title, 'Track1', "ambiguous column ok");
+
# check count distinct with multiple columns
my $other_track = $schema->resultset('Track')->create({ trackid => 2, cd => 1, position => 1, title => 'Track2' });
Deleted: DBIx-Class/0.08/branches/prefetch/t/73oracle_inflate.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/73oracle_inflate.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/73oracle_inflate.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,76 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use lib qw(t/lib);
-use DBICTest;
-
-my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_ORA_${_}" } qw/DSN USER PASS/};
-
-if (not ($dsn && $user && $pass)) {
- plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test. ' .
- 'Warning: This test drops and creates a table called \'track\'';
-}
-else {
- eval "use DateTime; use DateTime::Format::Oracle;";
- if ($@) {
- plan skip_all => 'needs DateTime and DateTime::Format::Oracle for testing';
- }
- else {
- 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);
-
-# Need to redefine the last_updated_on column
-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, 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', last_updated_at => '2009-05-03 21:17:18.5' });
-is($new->trackid, 1, "insert sucessful");
-
-my $track = $schema->resultset('Track')->find( 1 );
-
-is( ref($track->last_updated_on), 'DateTime', "last_updated_on inflated ok");
-
-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 {
- if($dbh) {
- $dbh->do("DROP TABLE track");
- }
-}
-
Modified: DBIx-Class/0.08/branches/prefetch/t/745db2.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/745db2.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/745db2.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -85,5 +85,6 @@
# clean up our mess
END {
+ my $dbh = eval { $schema->storage->_dbh };
$dbh->do("DROP TABLE artist") if $dbh;
}
Modified: DBIx-Class/0.08/branches/prefetch/t/746db2_400.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/746db2_400.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/746db2_400.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -82,6 +82,6 @@
# clean up our mess
END {
+ my $dbh = eval { $schema->storage->_dbh };
$dbh->do("DROP TABLE artist") if $dbh;
}
-
Modified: DBIx-Class/0.08/branches/prefetch/t/746mssql.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/746mssql.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/746mssql.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,18 +1,21 @@
use strict;
-use warnings;
+use warnings;
use Test::More;
+use Test::Exception;
use lib qw(t/lib);
use DBICTest;
+use DBIC::SqlMakerTest;
my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/};
plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test'
unless ($dsn && $user);
-plan tests => 13;
+plan tests => 39;
-my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {AutoCommit => 1});
+DBICTest::Schema->load_classes('ArtistGUID');
+my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
{
no warnings 'redefine';
@@ -31,7 +34,6 @@
my ($storage, $dbh) = @_;
eval { $dbh->do("DROP TABLE artist") };
$dbh->do(<<'SQL');
-
CREATE TABLE artist (
artistid INT IDENTITY NOT NULL,
name VARCHAR(100),
@@ -39,20 +41,39 @@
charfield CHAR(10) NULL,
primary key(artistid)
)
-
SQL
-
});
my %seen_id;
-# fresh $schema so we start unconnected
-$schema = DBICTest::Schema->connect($dsn, $user, $pass, {AutoCommit => 1});
+my @opts = (
+ { on_connect_call => 'use_dynamic_cursors' },
+ {},
+);
+my $new;
-# test primary key handling
-my $new = $schema->resultset('Artist')->create({ name => 'foo' });
-ok($new->artistid > 0, "Auto-PK worked");
+# test Auto-PK with different options
+for my $opts (@opts) {
+ SKIP: {
+ $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
+ eval {
+ $schema->storage->ensure_connected
+ };
+ if ($@ =~ /dynamic cursors/) {
+ skip
+'Dynamic Cursors not functional, tds_version 8.0 or greater required if using'.
+' FreeTDS', 1;
+ }
+
+ $schema->resultset('Artist')->search({ name => 'foo' })->delete;
+
+ $new = $schema->resultset('Artist')->create({ name => 'foo' });
+
+ ok($new->artistid > 0, "Auto-PK worked");
+ }
+}
+
$seen_id{$new->artistid}++;
# test LIMIT support
@@ -73,10 +94,245 @@
is( $it->next->name, "Artist 2", "iterator->next ok" );
is( $it->next, undef, "next past end of resultset ok" );
+# test GUID columns
+$schema->storage->dbh_do (sub {
+ my ($storage, $dbh) = @_;
+ eval { $dbh->do("DROP TABLE artist") };
+ $dbh->do(<<'SQL');
+CREATE TABLE artist (
+ artistid UNIQUEIDENTIFIER NOT NULL,
+ name VARCHAR(100),
+ rank INT NOT NULL DEFAULT '13',
+ charfield CHAR(10) NULL,
+ a_guid UNIQUEIDENTIFIER,
+ primary key(artistid)
+)
+SQL
+});
+
+# start disconnected to make sure insert works on an un-reblessed storage
+$schema = DBICTest::Schema->connect($dsn, $user, $pass);
+
+my $row;
+lives_ok {
+ $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
+} 'created a row with a GUID';
+
+ok(
+ eval { $row->artistid },
+ 'row has GUID PK col populated',
+);
+diag $@ if $@;
+
+ok(
+ eval { $row->a_guid },
+ 'row has a GUID col with auto_nextval populated',
+);
+diag $@ if $@;
+
+my $row_from_db = $schema->resultset('ArtistGUID')
+ ->search({ name => 'mtfnpy' })->first;
+
+is $row_from_db->artistid, $row->artistid,
+ 'PK GUID round trip';
+
+is $row_from_db->a_guid, $row->a_guid,
+ 'NON-PK GUID round trip';
+
+# test MONEY type
+$schema->storage->dbh_do (sub {
+ my ($storage, $dbh) = @_;
+ eval { $dbh->do("DROP TABLE money_test") };
+ $dbh->do(<<'SQL');
+
+CREATE TABLE money_test (
+ id INT IDENTITY PRIMARY KEY,
+ amount MONEY NULL
+)
+
+SQL
+
+});
+
+my $rs = $schema->resultset('Money');
+
+lives_ok {
+ $row = $rs->create({ amount => 100 });
+} 'inserted a money value';
+
+cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip';
+
+lives_ok {
+ $row->update({ amount => 200 });
+} 'updated a money value';
+
+cmp_ok $rs->find($row->id)->amount, '==', 200,
+ 'updated money value round-trip';
+
+lives_ok {
+ $row->update({ amount => undef });
+} 'updated a money value to NULL';
+
+is $rs->find($row->id)->amount, undef,'updated money value to NULL round-trip';
+
+$schema->storage->dbh_do (sub {
+ my ($storage, $dbh) = @_;
+ eval { $dbh->do("DROP TABLE Owners") };
+ eval { $dbh->do("DROP TABLE Books") };
+ $dbh->do(<<'SQL');
+CREATE TABLE Books (
+ id INT IDENTITY (1, 1) NOT NULL,
+ source VARCHAR(100),
+ owner INT,
+ title VARCHAR(10),
+ price INT NULL
+)
+
+CREATE TABLE Owners (
+ id INT IDENTITY (1, 1) NOT NULL,
+ name VARCHAR(100),
+)
+SQL
+
+});
+
+lives_ok ( sub {
+ $schema->populate ('Owners', [
+ [qw/id name /],
+ [qw/1 wiggle/],
+ [qw/2 woggle/],
+ [qw/3 boggle/],
+ [qw/4 fREW/],
+ [qw/5 fRIOUX/],
+ [qw/6 fROOH/],
+ [qw/7 fRUE/],
+ [qw/8 fISMBoC/],
+ [qw/9 station/],
+ [qw/10 mirror/],
+ [qw/11 dimly/],
+ [qw/12 face_to_face/],
+ [qw/13 icarus/],
+ [qw/14 dream/],
+ [qw/15 dyrstyggyr/],
+ ]);
+}, 'populate with PKs supplied ok' );
+
+lives_ok ( sub {
+ $schema->populate ('BooksInLibrary', [
+ [qw/source owner title /],
+ [qw/Library 1 secrets0/],
+ [qw/Library 1 secrets1/],
+ [qw/Eatery 1 secrets2/],
+ [qw/Library 2 secrets3/],
+ [qw/Library 3 secrets4/],
+ [qw/Eatery 3 secrets5/],
+ [qw/Library 4 secrets6/],
+ [qw/Library 5 secrets7/],
+ [qw/Eatery 5 secrets8/],
+ [qw/Library 6 secrets9/],
+ [qw/Library 7 secrets10/],
+ [qw/Eatery 7 secrets11/],
+ [qw/Library 8 secrets12/],
+ ]);
+}, 'populate without PKs supplied ok' );
+
+#
+# try a prefetch on tables with identically named columns
+#
+
+# set quote char - make sure things work while quoted
+$schema->storage->_sql_maker->{quote_char} = [qw/[ ]/];
+$schema->storage->_sql_maker->{name_sep} = '.';
+
+{
+ # try a ->has_many direction
+ my $owners = $schema->resultset ('Owners')->search ({
+ 'books.id' => { '!=', undef }
+ }, {
+ prefetch => 'books',
+ order_by => 'name',
+ rows => 3, # 8 results total
+ });
+
+ is ($owners->page(1)->all, 3, 'has_many prefetch returns correct number of rows');
+ is ($owners->page(1)->count, 3, 'has-many prefetch returns correct count');
+
+ TODO: {
+ local $TODO = 'limit past end of resultset problem';
+ is ($owners->page(3)->all, 2, 'has_many prefetch returns correct number of rows');
+ is ($owners->page(3)->count, 2, 'has-many prefetch returns correct count');
+ is ($owners->page(3)->count_rs->next, 2, 'has-many prefetch returns correct count_rs');
+
+ # make sure count does not become overly complex
+ is_same_sql_bind (
+ $owners->page(3)->count_rs->as_query,
+ '(
+ SELECT COUNT( * )
+ FROM (
+ SELECT TOP 3 [me].[id]
+ FROM [owners] [me]
+ LEFT JOIN [books] [books] ON [books].[owner] = [me].[id]
+ WHERE ( [books].[id] IS NOT NULL )
+ GROUP BY [me].[id]
+ ORDER BY [me].[id] DESC
+ ) [count_subq]
+ )',
+ [],
+ );
+ }
+
+ # try a ->belongs_to direction (no select collapse, group_by should work)
+ my $books = $schema->resultset ('BooksInLibrary')->search ({
+ 'owner.name' => [qw/wiggle woggle/],
+ }, {
+ distinct => 1,
+ prefetch => 'owner',
+ rows => 2, # 3 results total
+ order_by => { -desc => 'owner' },
+ # there is no sane way to order by the right side of a grouped prefetch currently :(
+ #order_by => { -desc => 'owner.name' },
+ });
+
+
+ is ($books->page(1)->all, 2, 'Prefetched grouped search returns correct number of rows');
+ is ($books->page(1)->count, 2, 'Prefetched grouped search returns correct count');
+
+ TODO: {
+ local $TODO = 'limit past end of resultset problem';
+ is ($books->page(2)->all, 1, 'Prefetched grouped search returns correct number of rows');
+ is ($books->page(2)->count, 1, 'Prefetched grouped search returns correct count');
+ is ($books->page(2)->count_rs->next, 1, 'Prefetched grouped search returns correct count_rs');
+
+ # make sure count does not become overly complex (FIXME - the distinct-induced group_by is incorrect)
+ is_same_sql_bind (
+ $books->page(2)->count_rs->as_query,
+ '(
+ SELECT COUNT( * )
+ FROM (
+ SELECT TOP 2 [me].[id]
+ FROM [books] [me]
+ JOIN [owners] [owner] ON [owner].[id] = [me].[owner]
+ WHERE ( ( ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ? ) )
+ GROUP BY [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
+ ORDER BY [me].[id] DESC
+ ) [count_subq]
+ )',
+ [
+ [ 'owner.name' => 'wiggle' ],
+ [ 'owner.name' => 'woggle' ],
+ [ 'source' => 'Library' ],
+ ],
+ );
+ }
+
+}
+
# clean up our mess
END {
- my $dbh = eval { $schema->storage->_dbh };
- $dbh->do('DROP TABLE artist') if $dbh;
+ if (my $dbh = eval { $schema->storage->_dbh }) {
+ eval { $dbh->do("DROP TABLE $_") }
+ for qw/artist money_test Books Owners/;
+ }
}
-
+# vim:sw=2 sts=2
Modified: DBIx-Class/0.08/branches/prefetch/t/746sybase.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/746sybase.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/746sybase.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -2,6 +2,7 @@
use warnings;
use Test::More;
+use Test::Exception;
use lib qw(t/lib);
use DBICTest;
@@ -10,13 +11,21 @@
plan skip_all => 'Set $ENV{DBICTEST_SYBASE_DSN}, _USER and _PASS to run this test'
unless ($dsn && $user);
-plan tests => 12;
+plan tests => 13;
my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {AutoCommit => 1});
+# start disconnected to test reconnection
$schema->storage->ensure_connected;
+$schema->storage->_dbh->disconnect;
+
isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::Sybase' );
+my $dbh;
+lives_ok (sub {
+ $dbh = $schema->storage->dbh;
+}, 'reconnect works');
+
$schema->storage->dbh_do (sub {
my ($storage, $dbh) = @_;
eval { $dbh->do("DROP TABLE artist") };
Modified: DBIx-Class/0.08/branches/prefetch/t/74mssql.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/74mssql.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/74mssql.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -9,6 +9,7 @@
}
use Test::More;
+use Test::Exception;
use lib qw(t/lib);
use DBICTest;
@@ -17,59 +18,128 @@
plan skip_all => 'Set $ENV{DBICTEST_MSSQL_DSN}, _USER and _PASS to run this test'
unless ($dsn);
-plan tests => 6;
+my $TESTS = 13;
-my $schema = DBICTest::Schema->clone;
-$schema->connection($dsn, $user, $pass);
+plan tests => $TESTS * 2;
-my $dbh = $schema->storage->dbh;
+my @storage_types = (
+ 'DBI::Sybase::Microsoft_SQL_Server',
+ 'DBI::Sybase::Microsoft_SQL_Server::NoBindVars',
+);
+my $storage_idx = -1;
+my $schema;
-isa_ok($schema->storage, 'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server');
+for my $storage_type (@storage_types) {
+ $storage_idx++;
-$dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL
- DROP TABLE artist");
-$dbh->do("IF OBJECT_ID('cd', 'U') IS NOT NULL
- DROP TABLE cd");
+ $schema = DBICTest::Schema->clone;
-$dbh->do("CREATE TABLE artist (artistid INT IDENTITY PRIMARY KEY, name VARCHAR(100), rank INT DEFAULT '13', charfield CHAR(10) NULL);");
-$dbh->do("CREATE TABLE cd (cdid INT IDENTITY PRIMARY KEY, artist INT, title VARCHAR(100), year VARCHAR(100), genreid INT NULL, single_track INT NULL);");
+ if ($storage_idx != 0) { # autodetect
+ $schema->storage_type("::$storage_type");
+ }
+
+ $schema->connection($dsn, $user, $pass);
+
+ $schema->storage->ensure_connected;
+
+ if ($storage_idx == 0 && ref($schema->storage) =~ /NoBindVars\z/) {
+ my $tb = Test::More->builder;
+ $tb->skip('no placeholders') for 1..$TESTS;
+ next;
+ }
+
+ isa_ok($schema->storage, "DBIx::Class::Storage::$storage_type");
+
+# start disconnected to test reconnection
+ $schema->storage->_dbh->disconnect;
+
+ my $dbh;
+ lives_ok (sub {
+ $dbh = $schema->storage->dbh;
+ }, 'reconnect works');
+
+ $dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL
+ DROP TABLE artist");
+ $dbh->do("IF OBJECT_ID('cd', 'U') IS NOT NULL
+ DROP TABLE cd");
+
+ $dbh->do("CREATE TABLE artist (artistid INT IDENTITY PRIMARY KEY, name VARCHAR(100), rank INT DEFAULT '13', charfield CHAR(10) NULL);");
+ $dbh->do("CREATE TABLE cd (cdid INT IDENTITY PRIMARY KEY, artist INT, title VARCHAR(100), year VARCHAR(100), genreid INT NULL, single_track INT NULL);");
# Just to test compat shim, Auto is in Core
-$schema->class('Artist')->load_components('PK::Auto::MSSQL');
+ $schema->class('Artist')->load_components('PK::Auto::MSSQL');
# Test PK
-my $new = $schema->resultset('Artist')->create( { name => 'foo' } );
-ok($new->artistid, "Auto-PK worked");
+ my $new = $schema->resultset('Artist')->create( { name => 'foo' } );
+ ok($new->artistid, "Auto-PK worked");
# Test LIMIT
-for (1..6) {
- $schema->resultset('Artist')->create( { name => 'Artist ' . $_, rank => $_ } );
-}
+ for (1..6) {
+ $schema->resultset('Artist')->create( { name => 'Artist ' . $_, rank => $_ } );
+ }
-my $it = $schema->resultset('Artist')->search( { },
- { rows => 3,
- offset => 2,
- order_by => 'artistid'
- }
-);
+ my $it = $schema->resultset('Artist')->search( { },
+ { rows => 3,
+ offset => 2,
+ order_by => 'artistid'
+ }
+ );
# Test ? in data don't get treated as placeholders
-my $cd = $schema->resultset('CD')->create( {
- artist => 1,
- title => 'Does this break things?',
- year => 2007,
-} );
-ok($cd->id, 'Not treating ? in data as placeholders');
+ my $cd = $schema->resultset('CD')->create( {
+ artist => 1,
+ title => 'Does this break things?',
+ year => 2007,
+ } );
+ ok($cd->id, 'Not treating ? in data as placeholders');
-is( $it->count, 3, "LIMIT count ok" );
-ok( $it->next->name, "iterator->next ok" );
-$it->next;
-$it->next;
-is( $it->next, undef, "next past end of resultset ok" );
+ is( $it->count, 3, "LIMIT count ok" );
+ ok( $it->next->name, "iterator->next ok" );
+ $it->next;
+ $it->next;
+ is( $it->next, undef, "next past end of resultset ok" );
+# test MONEY column support
+ $schema->storage->dbh_do (sub {
+ my ($storage, $dbh) = @_;
+ eval { $dbh->do("DROP TABLE money_test") };
+ $dbh->do(<<'SQL');
+ CREATE TABLE money_test (
+ id INT IDENTITY PRIMARY KEY,
+ amount MONEY NULL
+ )
+SQL
+
+ });
+
+ my $rs = $schema->resultset('Money');
+
+ my $row;
+ lives_ok {
+ $row = $rs->create({ amount => 100 });
+ } 'inserted a money value';
+
+ cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip';
+
+ lives_ok {
+ $row->update({ amount => 200 });
+ } 'updated a money value';
+
+ cmp_ok $rs->find($row->id)->amount, '==', 200,
+ 'updated money value round-trip';
+
+ lives_ok {
+ $row->update({ amount => undef });
+ } 'updated a money value to NULL';
+
+ is $rs->find($row->id)->amount,
+ undef, 'updated money value to NULL round-trip';
+}
+
# clean up our mess
END {
- $dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL DROP TABLE artist")
- if $dbh;
- $dbh->do("IF OBJECT_ID('cd', 'U') IS NOT NULL DROP TABLE cd")
- if $dbh;
+ if (my $dbh = eval { $schema->storage->dbh }) {
+ $dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL DROP TABLE artist");
+ $dbh->do("IF OBJECT_ID('cd', 'U') IS NOT NULL DROP TABLE cd");
+ $dbh->do("IF OBJECT_ID('money_test', 'U') IS NOT NULL DROP TABLE money_test");
+ }
}
Modified: DBIx-Class/0.08/branches/prefetch/t/76select.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/76select.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/76select.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -64,6 +64,7 @@
cmp_ok ($cds->count, '>', 2, 'Initially populated with more than 2 CDs');
my $table = $cds->result_source->name;
+$table = $$table if ref $table eq 'SCALAR';
my $subsel = $cds->search ({}, {
columns => [qw/cdid title/],
from => \ "(SELECT cdid, title FROM $table LIMIT 2) me",
Modified: DBIx-Class/0.08/branches/prefetch/t/83cache.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/83cache.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/83cache.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -8,10 +8,9 @@
my $schema = DBICTest->init_schema();
my $queries;
-$schema->storage->debugcb( sub{ $queries++ } );
+my $debugcb = sub{ $queries++ };
+my $sdebug = $schema->storage->debug;
-eval "use DBD::SQLite";
-plan skip_all => 'needs DBD::SQLite for testing' if $@;
plan tests => 23;
my $rs = $schema->resultset("Artist")->search(
@@ -46,6 +45,7 @@
$queries = 0;
$schema->storage->debug(1);
+$schema->storage->debugcb ($debugcb);
$rs = $schema->resultset('Artist')->search( undef, { cache => 1 } );
while( $artist = $rs->next ) {}
@@ -53,7 +53,8 @@
is( $queries, 1, 'revisiting a row does not issue a query when cache => 1' );
-$schema->storage->debug(0);
+$schema->storage->debug($sdebug);
+$schema->storage->debugcb (undef);
my @a = $schema->resultset("Artist")->search(
{ },
@@ -78,6 +79,7 @@
# start test for prefetch SELECT count
$queries = 0;
$schema->storage->debug(1);
+$schema->storage->debugcb ($debugcb);
$artist = $rs->first;
$rs->reset();
@@ -99,7 +101,8 @@
is($queries, 1, 'only one SQL statement executed');
-$schema->storage->debug(0);
+$schema->storage->debug($sdebug);
+$schema->storage->debugcb (undef);
# make sure related_resultset is deleted after object is updated
$artist->set_column('name', 'New Name');
@@ -131,18 +134,21 @@
# SELECT count for nested has_many prefetch
$queries = 0;
$schema->storage->debug(1);
+$schema->storage->debugcb ($debugcb);
$artist = ($rs->all)[0];
is($queries, 1, 'only one SQL statement executed');
-$schema->storage->debug(0);
+$schema->storage->debug($sdebug);
+$schema->storage->debugcb (undef);
my @objs;
#$artist = $rs->find(1);
$queries = 0;
$schema->storage->debug(1);
+$schema->storage->debugcb ($debugcb);
my $cds = $artist->cds;
my $tags = $cds->next->tags;
@@ -185,5 +191,5 @@
is( $queries, 1, 'only one select statement on find with has_many prefetch on resultset' );
-$schema->storage->debug(0);
-
+$schema->storage->debug($sdebug);
+$schema->storage->debugcb (undef);
Modified: DBIx-Class/0.08/branches/prefetch/t/85utf8.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/85utf8.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/85utf8.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -16,34 +16,24 @@
eval 'use utf8; 1' or plan skip_all => 'Need utf8 run this test';
}
-plan tests => 5;
+plan tests => 6;
DBICTest::Schema::CD->load_components('UTF8Columns');
DBICTest::Schema::CD->utf8_columns('title');
Class::C3->reinitialize();
-my $cd = $schema->resultset('CD')->create( { artist => 1, title => 'øni', year => 'foo' } );
+my $cd = $schema->resultset('CD')->create( { artist => 1, title => 'øni', year => '2048' } );
my $utf8_char = 'uniuni';
-if ($] <= 5.008000) {
- ok( Encode::is_utf8( $cd->title ), 'got title with utf8 flag' );
- ok( !Encode::is_utf8( $cd->year ), 'got year without utf8 flag' );
+ok( _is_utf8( $cd->title ), 'got title with utf8 flag' );
+ok(! _is_utf8( $cd->year ), 'got year without utf8 flag' );
- Encode::_utf8_on($utf8_char);
- $cd->title($utf8_char);
- ok( !Encode::is_utf8( $cd->{_column_data}{title} ), 'store utf8-less chars' );
+_force_utf8($utf8_char);
+$cd->title($utf8_char);
+ok(! _is_utf8( $cd->{_column_data}{title} ), 'store utf8-less chars' );
-} else {
- ok( utf8::is_utf8( $cd->title ), 'got title with utf8 flag' );
- ok( !utf8::is_utf8( $cd->year ), 'got year without utf8 flag' );
-
- utf8::decode($utf8_char);
- $cd->title($utf8_char);
- ok( !utf8::is_utf8( $cd->{_column_data}{title} ), 'store utf8-less chars' );
-}
-
my $v_utf8 = "\x{219}";
$cd->update ({ title => $v_utf8 });
@@ -53,3 +43,28 @@
$cd->update ({ title => $v_utf8 });
$cd->title('something_else');
ok( $cd->is_column_changed('title'), 'column is dirty after setting to something completely different');
+
+TODO: {
+ local $TODO = 'There is currently no way to propagate aliases to inflate_result()';
+ $cd = $schema->resultset('CD')->find ({ title => $v_utf8 }, { select => 'title', as => 'name' });
+ ok (_is_utf8( $cd->get_column ('name') ), 'utf8 flag propagates via as');
+}
+
+
+sub _force_utf8 {
+ if ($] <= 5.008000) {
+ Encode::_utf8_on ($_[0]);
+ }
+ else {
+ utf8::decode ($_[0]);
+ }
+}
+
+sub _is_utf8 {
+ if ($] <= 5.008000) {
+ return Encode::is_utf8 (shift);
+ }
+ else {
+ return utf8::is_utf8 (shift);
+ }
+}
Modified: DBIx-Class/0.08/branches/prefetch/t/86might_have.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/86might_have.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/86might_have.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -8,14 +8,11 @@
my $schema = DBICTest->init_schema();
my $queries;
-#$schema->storage->debugfh(IO::File->new('t/var/temp.trace', 'w'));
$schema->storage->debugcb( sub{ $queries++ } );
+my $sdebug = $schema->storage->debug;
-eval "use DBD::SQLite";
-plan skip_all => 'needs DBD::SQLite for testing' if $@;
plan tests => 2;
-
my $cd = $schema->resultset("CD")->find(1);
$cd->title('test');
@@ -28,7 +25,7 @@
is($queries, 1, 'liner_notes (might_have) not prefetched - do not load
liner_notes on update');
-$schema->storage->debug(0);
+$schema->storage->debug($sdebug);
my $cd2 = $schema->resultset("CD")->find(2, {prefetch => 'liner_notes'});
@@ -43,5 +40,4 @@
is($queries, 1, 'liner_notes (might_have) prefetched - do not load
liner_notes on update');
-$schema->storage->debug(0);
-
+$schema->storage->debug($sdebug);
Modified: DBIx-Class/0.08/branches/prefetch/t/86sqlt.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/86sqlt.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/86sqlt.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -8,10 +8,30 @@
eval "use SQL::Translator";
plan skip_all => 'SQL::Translator required' if $@;
-my $schema = DBICTest->init_schema;
+my $schema = DBICTest->init_schema (no_deploy => 1);
-plan tests => 133;
+# replace the sqlt calback with a custom version ading an index
+$schema->source('Track')->sqlt_deploy_callback(sub {
+ my ($self, $sqlt_table) = @_;
+ is (
+ $sqlt_table->schema->translator->producer_type,
+ join ('::', 'SQL::Translator::Producer', $schema->storage->sqlt_type),
+ 'Production type passed to translator object',
+ );
+
+ if ($schema->storage->sqlt_type eq 'SQLite' ) {
+ $sqlt_table->add_index( name => 'track_title', fields => ['title'] )
+ or die $sqlt_table->error;
+ }
+
+ $self->default_sqlt_deploy_hook($sqlt_table);
+});
+
+$schema->deploy; # do not remove, this fires the is() test in the callback above
+
+
+
my $translator = SQL::Translator->new(
parser_args => {
'DBIx::Schema' => $schema,
@@ -26,17 +46,7 @@
my $relinfo = $schema->source('Artist')->relationship_info ('cds');
local $relinfo->{attrs}{on_delete} = 'restrict';
- $schema->source('Track')->sqlt_deploy_callback(sub {
- my ($self, $sqlt_table) = @_;
- if ($schema->storage->sqlt_type eq 'SQLite' ) {
- $sqlt_table->add_index( name => 'track_title', fields => ['title'] )
- or die $sqlt_table->error;
- }
-
- $self->default_sqlt_deploy_hook($sqlt_table);
- });
-
$translator->parser('SQL::Translator::Parser::DBIx::Class');
$translator->producer('SQLite');
@@ -45,7 +55,12 @@
ok($output, "SQLT produced someoutput")
or diag($translator->error);
- like ($warn, qr/^SQLT attribute .+? was supplied for relationship/, 'Warn about dubious on_delete/on_update attributes');
+
+ like (
+ $warn,
+ qr/SQLT attribute .+? was supplied for relationship .+? which does not appear to be a foreign constraint/,
+ 'Warn about dubious on_delete/on_update attributes',
+ );
}
# Note that the constraints listed here are the only ones that are tested -- if
@@ -155,7 +170,7 @@
'name' => 'artist_undirected_map_fk_id2', 'index_name' => 'artist_undirected_map_idx_id2',
'selftable' => 'artist_undirected_map', 'foreigntable' => 'artist',
'selfcols' => ['id2'], 'foreigncols' => ['artistid'],
- on_delete => '', on_update => 'CASCADE', deferrable => 1,
+ on_delete => '', on_update => '', deferrable => 1,
},
],
@@ -439,3 +454,5 @@
is( $got->name, $expected->{name},
"name parameter correct for `$desc'" );
}
+
+done_testing;
Modified: DBIx-Class/0.08/branches/prefetch/t/87ordered.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/87ordered.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/87ordered.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -10,8 +10,6 @@
my $schema = DBICTest->init_schema();
-plan tests => 1269;
-
my $employees = $schema->resultset('Employee');
$employees->delete();
@@ -42,11 +40,9 @@
my $group_3 = $employees->search({group_id=>3});
my $to_group = 1;
my $to_pos = undef;
-# now that we have transactions we need to work around stupid sqlite
{
my @empl = $group_3->all;
while (my $employee = shift @empl) {
- $employee->discard_changes; # since we are effective shift()ing the $rs while doing this
$employee->move_to_group($to_group, $to_pos);
$to_pos++;
$to_group = $to_group==1 ? 2 : 1;
@@ -54,7 +50,6 @@
}
foreach my $group_id (1..4) {
my $group_employees = $employees->search({group_id=>$group_id});
- $group_employees->all();
ok( check_rs($group_employees), "group positions after move_to_group" );
}
@@ -129,7 +124,6 @@
my $to_group_2 = 1;
$to_pos = undef;
-# now that we have transactions we need to work around stupid sqlite
{
my @empl = $group_3->all;
while (my $employee = shift @empl) {
@@ -143,7 +137,6 @@
foreach my $group_id_2 (1..4) {
foreach my $group_id_3 (1..4) {
my $group_employees = $employees->search({group_id_2=>$group_id_2,group_id_3=>$group_id_3});
- $group_employees->all();
ok( check_rs($group_employees), "group positions after move_to_group" );
}
}
@@ -275,3 +268,4 @@
return 1;
}
+done_testing;
Modified: DBIx-Class/0.08/branches/prefetch/t/88result_set_column.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/88result_set_column.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/88result_set_column.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -8,10 +8,9 @@
my $schema = DBICTest->init_schema();
-plan tests => 18;
+plan tests => 20;
-my $cd;
-my $rs = $cd = $schema->resultset("CD")->search({}, { order_by => 'cdid' });
+my $rs = $schema->resultset("CD")->search({}, { order_by => 'cdid' });
my $rs_title = $rs->get_column('title');
my $rs_year = $rs->get_column('year');
@@ -76,3 +75,22 @@
my $owner = $schema->resultset('Owners')->find ({ name => 'Newton' });
ok ($owner->books->count > 1, 'Owner Newton has multiple books');
is ($owner->search_related ('books')->get_column ('price')->sum, 60, 'Correctly calculated price of all owned books');
+
+
+# make sure joined/prefetched get_column of a PK dtrt
+
+$rs->reset;
+my $j_rs = $rs->search ({}, { join => 'tracks' })->get_column ('cdid');
+is_deeply (
+ [ $j_rs->all ],
+ [ map { my $c = $rs->next; ( ($c->id) x $c->tracks->count ) } (1 .. $rs->count) ],
+ 'join properly explodes amount of rows from get_column',
+);
+
+$rs->reset;
+my $p_rs = $rs->search ({}, { prefetch => 'tracks' })->get_column ('cdid');
+is_deeply (
+ [ $p_rs->all ],
+ [ $rs->get_column ('cdid')->all ],
+ 'prefetch properly collapses amount of rows from get_column',
+);
Modified: DBIx-Class/0.08/branches/prefetch/t/90join_torture.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/90join_torture.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/90join_torture.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -46,9 +46,9 @@
my $rs3 = $rs2->search_related('cds');
-cmp_ok(scalar($rs3->all), '==', 45, "All cds for artist returned");
+cmp_ok(scalar($rs3->all), '==', 15, "All cds for artist returned");
-cmp_ok($rs3->count, '==', 45, "All cds for artist returned via count");
+cmp_ok($rs3->count, '==', 15, "All cds for artist returned via count");
my $rs4 = $schema->resultset("CD")->search({ 'artist.artistid' => '1' }, { join => ['tracks', 'artist'], prefetch => 'artist' });
my @rs4_results = $rs4->all;
Modified: DBIx-Class/0.08/branches/prefetch/t/92storage.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/92storage.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/92storage.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -93,6 +93,7 @@
'bar',
undef,
{
+ %{$storage->_default_dbi_connect_attributes || {} },
PrintError => 0,
AutoCommit => 1,
},
@@ -122,8 +123,8 @@
args => [
{
on_connect_do => [qw/a b c/],
- PrintError => 0,
- AutoCommit => 1,
+ PrintError => 1,
+ AutoCommit => 0,
on_disconnect_do => [qw/d e f/],
user => 'bar',
dsn => 'foo',
@@ -138,8 +139,9 @@
'bar',
undef,
{
- PrintError => 0,
- AutoCommit => 1,
+ %{$storage->_default_dbi_connect_attributes || {} },
+ PrintError => 1,
+ AutoCommit => 0,
},
],
},
Added: DBIx-Class/0.08/branches/prefetch/t/92storage_on_connect_call.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/92storage_on_connect_call.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/92storage_on_connect_call.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,68 @@
+use strict;
+use warnings;
+no warnings qw/once redefine/;
+
+use lib qw(t/lib);
+use DBICTest;
+
+use Test::More tests => 9;
+
+my $schema = DBICTest->init_schema(
+ no_connect => 1,
+ no_deploy => 1,
+);
+
+local *DBIx::Class::Storage::DBI::connect_call_foo = sub {
+ isa_ok $_[0], 'DBIx::Class::Storage::DBI',
+ 'got storage in connect_call method';
+ is $_[1], 'bar', 'got param in connect_call method';
+};
+
+local *DBIx::Class::Storage::DBI::disconnect_call_foo = sub {
+ isa_ok $_[0], 'DBIx::Class::Storage::DBI',
+ 'got storage in disconnect_call method';
+};
+
+ok $schema->connection(
+ DBICTest->_database,
+ {
+ on_connect_call => [
+ [ do_sql => 'create table test1 (id integer)' ],
+ [ do_sql => [ 'insert into test1 values (?)', {}, 1 ] ],
+ [ do_sql => sub { ['insert into test1 values (2)'] } ],
+ [ sub { $_[0]->dbh->do($_[1]) }, 'insert into test1 values (3)' ],
+ # this invokes $storage->connect_call_foo('bar') (above)
+ [ foo => 'bar' ],
+ ],
+ on_connect_do => 'insert into test1 values (4)',
+ on_disconnect_call => 'foo',
+ },
+), 'connection()';
+
+is_deeply (
+ $schema->storage->dbh->selectall_arrayref('select * from test1'),
+ [ [ 1 ], [ 2 ], [ 3 ], [ 4 ] ],
+ 'on_connect_call/do actions worked'
+);
+
+local *DBIx::Class::Storage::DBI::connect_call_foo = sub {
+ isa_ok $_[0], 'DBIx::Class::Storage::DBI',
+ 'got storage in connect_call method';
+};
+
+local *DBIx::Class::Storage::DBI::connect_call_bar = sub {
+ isa_ok $_[0], 'DBIx::Class::Storage::DBI',
+ 'got storage in connect_call method';
+};
+
+$schema->storage->disconnect;
+
+ok $schema->connection(
+ DBICTest->_database,
+ {
+ # method list form
+ on_connect_call => [ 'foo', sub { ok 1, "coderef in list form" }, 'bar' ],
+ },
+), 'connection()';
+
+$schema->storage->ensure_connected;
Added: DBIx-Class/0.08/branches/prefetch/t/92storage_ping_count.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/92storage_ping_count.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/92storage_ping_count.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,61 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use Data::Dumper;
+use DBIC::SqlMakerTest;
+
+my $ping_count = 0;
+
+{
+ local $SIG{__WARN__} = sub {};
+ require DBIx::Class::Storage::DBI;
+
+ my $ping = \&DBIx::Class::Storage::DBI::_ping;
+
+ *DBIx::Class::Storage::DBI::_ping = sub {
+ $ping_count++;
+ goto &$ping;
+ };
+}
+
+
+# measure pings around deploy() separately
+my $schema = DBICTest->init_schema( sqlite_use_file => 1, no_populate => 1 );
+
+is ($ping_count, 0, 'no _ping() calls during deploy');
+$ping_count = 0;
+
+
+
+DBICTest->populate_schema ($schema);
+
+# perform some operations and make sure they don't ping
+
+$schema->resultset('CD')->create({
+ cdid => 6, artist => 3, title => 'mtfnpy', year => 2009
+});
+
+$schema->resultset('CD')->create({
+ cdid => 7, artist => 3, title => 'mtfnpy2', year => 2009
+});
+
+$schema->storage->_dbh->disconnect;
+
+$schema->resultset('CD')->create({
+ cdid => 8, artist => 3, title => 'mtfnpy3', year => 2009
+});
+
+$schema->storage->_dbh->disconnect;
+
+$schema->txn_do(sub {
+ $schema->resultset('CD')->create({
+ cdid => 9, artist => 3, title => 'mtfnpy4', year => 2009
+ });
+});
+
+is $ping_count, 0, 'no _ping() calls';
+
+done_testing;
Modified: DBIx-Class/0.08/branches/prefetch/t/93nobindvars.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/93nobindvars.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/93nobindvars.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -65,5 +65,6 @@
# clean up our mess
END {
+ my $dbh = eval { $schema->storage->_dbh };
$dbh->do("DROP TABLE artist") if $dbh;
}
Modified: DBIx-Class/0.08/branches/prefetch/t/93storage_replication.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/93storage_replication.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/93storage_replication.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -6,13 +6,12 @@
use DBICTest;
use List::Util 'first';
use Scalar::Util 'reftype';
+use File::Spec;
use IO::Handle;
BEGIN {
eval "use DBIx::Class::Storage::DBI::Replicated; use Test::Moose";
- plan $@
- ? ( skip_all => "Deps not installed: $@" )
- : ( tests => 90 );
+ plan skip_all => "Deps not installed: $@" if $@;
}
use_ok 'DBIx::Class::Storage::DBI::Replicated::Pool';
@@ -20,6 +19,10 @@
use_ok 'DBIx::Class::Storage::DBI::Replicated::Replicant';
use_ok 'DBIx::Class::Storage::DBI::Replicated';
+use Moose();
+use MooseX::Types();
+diag "Using Moose version $Moose::VERSION and MooseX::Types version $MooseX::Types::VERSION";
+
=head1 HOW TO USE
This is a test of the replicated storage system. This will work in one of
@@ -28,7 +31,7 @@
will try to test those. If you do that, it will assume the setup is properly
replicating. Your results may vary, but I have demonstrated this to work with
mysql native replication.
-
+
=cut
@@ -41,26 +44,26 @@
## --------------------------------------------------------------------- ##
## Create an object to contain your replicated stuff.
## --------------------------------------------------------------------- ##
-
+
package DBIx::Class::DBI::Replicated::TestReplication;
-
+
use DBICTest;
use base qw/Class::Accessor::Fast/;
-
+
__PACKAGE__->mk_accessors( qw/schema/ );
## Initialize the object
-
- sub new {
- my ($class, $schema_method) = (shift, shift);
- my $self = $class->SUPER::new(@_);
-
- $self->schema( $self->init_schema($schema_method) );
- return $self;
- }
-
+
+ sub new {
+ my ($class, $schema_method) = (shift, shift);
+ my $self = $class->SUPER::new(@_);
+
+ $self->schema( $self->init_schema($schema_method) );
+ return $self;
+ }
+
## Get the Schema and set the replication storage type
-
+
sub init_schema {
# current SQLT SQLite producer does not handle DROP TABLE IF EXISTS, trap warnings here
local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /no such table.+DROP TABLE/ };
@@ -81,7 +84,7 @@
balancer_type=>'::Random',
balancer_args=>{
auto_validate_every=>100,
- master_read_weight => 1
+ master_read_weight => 1
},
}
},
@@ -98,7 +101,7 @@
balancer_type=>'::Random',
balancer_args=> {
auto_validate_every=>100,
- master_read_weight => 1
+ master_read_weight => 1
},
deploy_args=>{
add_drop_table => 1,
@@ -130,47 +133,50 @@
no Moose;
}
-
+
## --------------------------------------------------------------------- ##
## Subclass for when you are using SQLite for testing, this provides a fake
## replication support.
## --------------------------------------------------------------------- ##
-
+
package DBIx::Class::DBI::Replicated::TestReplication::SQLite;
use DBICTest;
- use File::Copy;
+ use File::Copy;
use base 'DBIx::Class::DBI::Replicated::TestReplication';
-
- __PACKAGE__->mk_accessors( qw/master_path slave_paths/ );
-
- ## Set the mastep path from DBICTest
-
- sub new {
- my $class = shift @_;
- my $self = $class->SUPER::new(@_);
-
- $self->master_path( DBICTest->_sqlite_dbfilename );
- $self->slave_paths([
- "t/var/DBIxClass_slave1.db",
- "t/var/DBIxClass_slave2.db",
+
+ __PACKAGE__->mk_accessors(qw/master_path slave_paths/);
+
+ ## Set the master path from DBICTest
+
+ sub new {
+ my $class = shift @_;
+ my $self = $class->SUPER::new(@_);
+
+ $self->master_path( DBICTest->_sqlite_dbfilename );
+ $self->slave_paths([
+ File::Spec->catfile(qw/t var DBIxClass_slave1.db/),
+ File::Spec->catfile(qw/t var DBIxClass_slave2.db/),
]);
-
- return $self;
- }
-
+
+ return $self;
+ }
+
## Return an Array of ArrayRefs where each ArrayRef is suitable to use for
## $storage->connect_info to be used for connecting replicants.
-
+
sub generate_replicant_connect_info {
my $self = shift @_;
my @dsn = map {
"dbi:SQLite:${_}";
} @{$self->slave_paths};
-
+
my @connect_infos = map { [$_,'','',{AutoCommit=>1}] } @dsn;
- # try a hashref too
+ ## Make sure nothing is left over from a failed test
+ $self->cleanup;
+
+ ## try a hashref too
my $c = $connect_infos[0];
$connect_infos[0] = {
dsn => $c->[0],
@@ -185,23 +191,25 @@
## Do a 'good enough' replication by copying the master dbfile over each of
## the slave dbfiles. If the master is SQLite we do this, otherwise we
## just do a one second pause to let the slaves catch up.
-
+
sub replicate {
my $self = shift @_;
foreach my $slave (@{$self->slave_paths}) {
copy($self->master_path, $slave);
}
}
-
+
## Cleanup after ourselves. Unlink all gthe slave paths.
-
+
sub cleanup {
my $self = shift @_;
foreach my $slave (@{$self->slave_paths}) {
- unlink $slave;
- }
+ if(-e $slave) {
+ unlink $slave;
+ }
+ }
}
-
+
## --------------------------------------------------------------------- ##
## Subclass for when you are setting the databases via custom export vars
## This is for when you have a replicating database setup that you are
@@ -209,25 +217,25 @@
## two slave databases to test against, as well as a replication system
## that will replicate in less than 1 second.
## --------------------------------------------------------------------- ##
-
- package DBIx::Class::DBI::Replicated::TestReplication::Custom;
+
+ package DBIx::Class::DBI::Replicated::TestReplication::Custom;
use base 'DBIx::Class::DBI::Replicated::TestReplication';
-
+
## Return an Array of ArrayRefs where each ArrayRef is suitable to use for
## $storage->connect_info to be used for connecting replicants.
-
- sub generate_replicant_connect_info {
+
+ sub generate_replicant_connect_info {
return (
[$ENV{"DBICTEST_SLAVE0_DSN"}, $ENV{"DBICTEST_SLAVE0_DBUSER"}, $ENV{"DBICTEST_SLAVE0_DBPASS"}, {AutoCommit => 1}],
- [$ENV{"DBICTEST_SLAVE1_DSN"}, $ENV{"DBICTEST_SLAVE1_DBUSER"}, $ENV{"DBICTEST_SLAVE1_DBPASS"}, {AutoCommit => 1}],
+ [$ENV{"DBICTEST_SLAVE1_DSN"}, $ENV{"DBICTEST_SLAVE1_DBUSER"}, $ENV{"DBICTEST_SLAVE1_DBPASS"}, {AutoCommit => 1}],
);
}
-
- ## pause a bit to let the replication catch up
-
+
+ ## pause a bit to let the replication catch up
+
sub replicate {
- sleep 1;
- }
+ sleep 1;
+ }
}
## ----------------------------------------------------------------------------
@@ -243,12 +251,13 @@
my $replicated;
for my $method (qw/by_connect_info by_storage_type/) {
+ undef $replicated;
ok $replicated = $replicated_class->new($method)
=> "Created a replication object $method";
-
+
isa_ok $replicated->schema
=> 'DBIx::Class::Schema';
-
+
isa_ok $replicated->schema->storage
=> 'DBIx::Class::Storage::DBI::Replicated';
@@ -259,15 +268,15 @@
ok $replicated->schema->storage->meta
=> 'has a meta object';
-
+
isa_ok $replicated->schema->storage->master
=> 'DBIx::Class::Storage::DBI';
-
+
isa_ok $replicated->schema->storage->pool
=> 'DBIx::Class::Storage::DBI::Replicated::Pool';
-
+
does_ok $replicated->schema->storage->balancer
- => 'DBIx::Class::Storage::DBI::Replicated::Balancer';
+ => 'DBIx::Class::Storage::DBI::Replicated::Balancer';
ok my @replicant_connects = $replicated->generate_replicant_connect_info
=> 'got replication connect information';
@@ -275,6 +284,19 @@
ok my @replicated_storages = $replicated->schema->storage->connect_replicants(@replicant_connects)
=> 'Created some storages suitable for replicants';
+our %debug;
+$replicated->schema->storage->debug(1);
+$replicated->schema->storage->debugcb(sub {
+ my ($op, $info) = @_;
+ ##warn "\n$op, $info\n";
+ %debug = (
+ op => $op,
+ info => $info,
+ dsn => ($info=~m/\[(.+)\]/)[0],
+ storage_type => $info=~m/REPLICANT/ ? 'REPLICANT' : 'MASTER',
+ );
+});
+
ok my @all_storages = $replicated->schema->storage->all_storages
=> '->all_storages';
@@ -293,36 +315,38 @@
is ((grep $_->{master_option}, @all_storage_opts),
3
=> 'connect_info was merged from master to replicants');
-
+
my @replicant_names = keys %{ $replicated->schema->storage->replicants };
+ok @replicant_names, "found replicant names @replicant_names";
+
## Silence warning about not supporting the is_replicating method if using the
## sqlite dbs.
$replicated->schema->storage->debugobj->silence(1)
if first { m{^t/} } @replicant_names;
-
+
isa_ok $replicated->schema->storage->balancer->current_replicant
- => 'DBIx::Class::Storage::DBI';
+ => 'DBIx::Class::Storage::DBI';
$replicated->schema->storage->debugobj->silence(0);
ok $replicated->schema->storage->pool->has_replicants
- => 'does have replicants';
+ => 'does have replicants';
is $replicated->schema->storage->pool->num_replicants => 2
=> 'has two replicants';
-
+
does_ok $replicated_storages[0]
=> 'DBIx::Class::Storage::DBI::Replicated::Replicant';
does_ok $replicated_storages[1]
=> 'DBIx::Class::Storage::DBI::Replicated::Replicant';
-
+
does_ok $replicated->schema->storage->replicants->{$replicant_names[0]}
=> 'DBIx::Class::Storage::DBI::Replicated::Replicant';
does_ok $replicated->schema->storage->replicants->{$replicant_names[1]}
- => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
+ => 'DBIx::Class::Storage::DBI::Replicated::Replicant';
## Add some info to the database
@@ -332,7 +356,12 @@
[ qw/artistid name/ ],
[ 4, "Ozric Tentacles"],
]);
-
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
+ like $debug{info}, qr/INSERT/, 'Last was an insert';
+
## Make sure all the slaves have the table definitions
$replicated->replicate;
@@ -343,7 +372,7 @@
## sqlite dbs.
$replicated->schema->storage->debugobj->silence(1)
if first { m{^t/} } @replicant_names;
-
+
$replicated->schema->storage->pool->validate_replicants;
$replicated->schema->storage->debugobj->silence(0);
@@ -353,9 +382,14 @@
ok my $artist1 = $replicated->schema->resultset('Artist')->find(4)
=> 'Created Result';
+## We removed testing here since master read weight is on, so we can't tell in
+## advance what storage to expect. We turn master read weight off a bit lower
+## is $debug{storage_type}, 'REPLICANT'
+## => "got last query from a replicant: $debug{dsn}, $debug{info}";
+
isa_ok $artist1
=> 'DBICTest::Artist';
-
+
is $artist1->name, 'Ozric Tentacles'
=> 'Found expected name for first result';
@@ -365,7 +399,7 @@
local
*DBIx::Class::Storage::DBI::Replicated::Balancer::Random::_random_number =
- sub { 999 };
+ sub { 999 };
$replicated->schema->storage->balancer->increment_storage;
@@ -391,6 +425,11 @@
[ 7, "Watergate"],
]);
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
+ like $debug{info}, qr/INSERT/, 'Last was an insert';
+
## Make sure all the slaves have the table definitions
$replicated->replicate;
@@ -398,10 +437,13 @@
ok my $artist2 = $replicated->schema->resultset('Artist')->find(5)
=> 'Sync succeed';
-
+
+is $debug{storage_type}, 'REPLICANT'
+ => "got last query from a replicant: $debug{dsn}";
+
isa_ok $artist2
=> 'DBICTest::Artist';
-
+
is $artist2->name, "Doom's Children"
=> 'Found expected name for first result';
@@ -409,7 +451,7 @@
is $replicated->schema->storage->pool->connected_replicants => 2
=> "both replicants are connected";
-
+
$replicated->schema->storage->replicants->{$replicant_names[0]}->disconnect;
$replicated->schema->storage->replicants->{$replicant_names[1]}->disconnect;
@@ -420,47 +462,68 @@
ok my $artist3 = $replicated->schema->resultset('Artist')->find(6)
=> 'Still finding stuff.';
-
+
+is $debug{storage_type}, 'REPLICANT'
+ => "got last query from a replicant: $debug{dsn}";
+
isa_ok $artist3
=> 'DBICTest::Artist';
-
+
is $artist3->name, "Dead On Arrival"
=> 'Found expected name for first result';
is $replicated->schema->storage->pool->connected_replicants => 1
=> "At Least One replicant reconnected to handle the job";
-
+
## What happens when we try to select something that doesn't exist?
ok ! $replicated->schema->resultset('Artist')->find(666)
=> 'Correctly failed to find something.';
-
+
+is $debug{storage_type}, 'REPLICANT'
+ => "got last query from a replicant: $debug{dsn}";
+
## test the reliable option
TESTRELIABLE: {
-
- $replicated->schema->storage->set_reliable_storage;
-
- ok $replicated->schema->resultset('Artist')->find(2)
- => 'Read from master 1';
-
- ok $replicated->schema->resultset('Artist')->find(5)
- => 'Read from master 2';
-
- $replicated->schema->storage->set_balanced_storage;
-
- ok $replicated->schema->resultset('Artist')->find(3)
+
+ $replicated->schema->storage->set_reliable_storage;
+
+ ok $replicated->schema->resultset('Artist')->find(2)
+ => 'Read from master 1';
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
+ ok $replicated->schema->resultset('Artist')->find(5)
+ => 'Read from master 2';
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
+ $replicated->schema->storage->set_balanced_storage;
+
+ ok $replicated->schema->resultset('Artist')->find(3)
=> 'Read from replicant';
+
+ is $debug{storage_type}, 'REPLICANT',
+ "got last query from a replicant: $debug{dsn}";
}
## Make sure when reliable goes out of scope, we are using replicants again
ok $replicated->schema->resultset('Artist')->find(1)
=> 'back to replicant 1.';
-
+
+ is $debug{storage_type}, 'REPLICANT',
+ "got last query from a replicant: $debug{dsn}";
+
ok $replicated->schema->resultset('Artist')->find(2)
=> 'back to replicant 2.';
+ is $debug{storage_type}, 'REPLICANT',
+ "got last query from a replicant: $debug{dsn}";
+
## set all the replicants to inactive, and make sure the balancer falls back to
## the master.
@@ -474,10 +537,13 @@
$replicated->schema->storage->debugfh($debugfh);
ok $replicated->schema->resultset('Artist')->find(2)
- => 'Fallback to master';
+ => 'Fallback to master';
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
like $fallback_warning, qr/falling back to master/
- => 'emits falling back to master warning';
+ => 'emits falling back to master warning';
$replicated->schema->storage->debugfh($oldfh);
}
@@ -489,88 +555,97 @@
## sqlite dbs.
$replicated->schema->storage->debugobj->silence(1)
if first { m{^t/} } @replicant_names;
-
+
$replicated->schema->storage->pool->validate_replicants;
$replicated->schema->storage->debugobj->silence(0);
ok $replicated->schema->resultset('Artist')->find(2)
=> 'Returned to replicates';
-
+
+is $debug{storage_type}, 'REPLICANT',
+ "got last query from a replicant: $debug{dsn}";
+
## Getting slave status tests
SKIP: {
## We skip this tests unless you have a custom replicants, since the default
## sqlite based replication tests don't support these functions.
-
- skip 'Cannot Test Replicant Status on Non Replicating Database', 9
+
+ skip 'Cannot Test Replicant Status on Non Replicating Database', 10
unless DBICTest->has_custom_dsn && $ENV{"DBICTEST_SLAVE0_DSN"};
$replicated->replicate; ## Give the slaves a chance to catchup.
- ok $replicated->schema->storage->replicants->{$replicant_names[0]}->is_replicating
- => 'Replicants are replicating';
-
- is $replicated->schema->storage->replicants->{$replicant_names[0]}->lag_behind_master, 0
- => 'Replicant is zero seconds behind master';
-
- ## Test the validate replicants
-
- $replicated->schema->storage->pool->validate_replicants;
-
- is $replicated->schema->storage->pool->active_replicants, 2
- => 'Still have 2 replicants after validation';
-
- ## Force the replicants to fail the validate test by required their lag to
- ## be negative (ie ahead of the master!)
-
+ ok $replicated->schema->storage->replicants->{$replicant_names[0]}->is_replicating
+ => 'Replicants are replicating';
+
+ is $replicated->schema->storage->replicants->{$replicant_names[0]}->lag_behind_master, 0
+ => 'Replicant is zero seconds behind master';
+
+ ## Test the validate replicants
+
+ $replicated->schema->storage->pool->validate_replicants;
+
+ is $replicated->schema->storage->pool->active_replicants, 2
+ => 'Still have 2 replicants after validation';
+
+ ## Force the replicants to fail the validate test by required their lag to
+ ## be negative (ie ahead of the master!)
+
$replicated->schema->storage->pool->maximum_lag(-10);
$replicated->schema->storage->pool->validate_replicants;
-
+
is $replicated->schema->storage->pool->active_replicants, 0
=> 'No way a replicant be be ahead of the master';
-
+
## Let's be fair to the replicants again. Let them lag up to 5
-
+
$replicated->schema->storage->pool->maximum_lag(5);
$replicated->schema->storage->pool->validate_replicants;
-
+
is $replicated->schema->storage->pool->active_replicants, 2
- => 'Both replicants in good standing again';
-
- ## Check auto validate
-
- is $replicated->schema->storage->balancer->auto_validate_every, 100
- => "Got the expected value for auto validate";
-
- ## This will make sure we auto validatge everytime
- $replicated->schema->storage->balancer->auto_validate_every(0);
-
- ## set all the replicants to inactive, and make sure the balancer falls back to
- ## the master.
-
- $replicated->schema->storage->replicants->{$replicant_names[0]}->active(0);
- $replicated->schema->storage->replicants->{$replicant_names[1]}->active(0);
-
- ## Ok, now when we go to run a query, autovalidate SHOULD reconnect
-
- is $replicated->schema->storage->pool->active_replicants => 0
- => "both replicants turned off";
-
- ok $replicated->schema->resultset('Artist')->find(5)
- => 'replicant reactivated';
-
- is $replicated->schema->storage->pool->active_replicants => 2
- => "both replicants reactivated";
+ => 'Both replicants in good standing again';
+
+ ## Check auto validate
+
+ is $replicated->schema->storage->balancer->auto_validate_every, 100
+ => "Got the expected value for auto validate";
+
+ ## This will make sure we auto validatge everytime
+ $replicated->schema->storage->balancer->auto_validate_every(0);
+
+ ## set all the replicants to inactive, and make sure the balancer falls back to
+ ## the master.
+
+ $replicated->schema->storage->replicants->{$replicant_names[0]}->active(0);
+ $replicated->schema->storage->replicants->{$replicant_names[1]}->active(0);
+
+ ## Ok, now when we go to run a query, autovalidate SHOULD reconnect
+
+ is $replicated->schema->storage->pool->active_replicants => 0
+ => "both replicants turned off";
+
+ ok $replicated->schema->resultset('Artist')->find(5)
+ => 'replicant reactivated';
+
+ is $debug{storage_type}, 'REPLICANT',
+ "got last query from a replicant: $debug{dsn}";
+
+ is $replicated->schema->storage->pool->active_replicants => 2
+ => "both replicants reactivated";
}
## Test the reliably callback
ok my $reliably = sub {
-
+
ok $replicated->schema->resultset('Artist')->find(5)
- => 'replicant reactivated';
-
+ => 'replicant reactivated';
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
} => 'created coderef properly';
$replicated->schema->storage->execute_reliably($reliably);
@@ -578,140 +653,201 @@
## Try something with an error
ok my $unreliably = sub {
-
+
ok $replicated->schema->resultset('ArtistXX')->find(5)
- => 'replicant reactivated';
-
+ => 'replicant reactivated';
+
} => 'created coderef properly';
-throws_ok {$replicated->schema->storage->execute_reliably($unreliably)}
+throws_ok {$replicated->schema->storage->execute_reliably($unreliably)}
qr/Can't find source for ArtistXX/
=> 'Bad coderef throws proper error';
-
+
## Make sure replication came back
ok $replicated->schema->resultset('Artist')->find(3)
=> 'replicant reactivated';
-
+
+is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
+
## make sure transactions are set to execute_reliably
ok my $transaction = sub {
-
- my $id = shift @_;
-
- $replicated
- ->schema
- ->populate('Artist', [
- [ qw/artistid name/ ],
- [ $id, "Children of the Grave"],
- ]);
-
+
+ my $id = shift @_;
+
+ $replicated
+ ->schema
+ ->populate('Artist', [
+ [ qw/artistid name/ ],
+ [ $id, "Children of the Grave"],
+ ]);
+
ok my $result = $replicated->schema->resultset('Artist')->find($id)
- => 'Found expected artist';
-
+ => "Found expected artist for $id";
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
ok my $more = $replicated->schema->resultset('Artist')->find(1)
- => 'Found expected artist again';
-
+ => 'Found expected artist again for 1';
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
return ($result, $more);
-
+
} => 'Created a coderef properly';
## Test the transaction with multi return
{
- ok my @return = $replicated->schema->txn_do($transaction, 666)
- => 'did transaction';
-
- is $return[0]->id, 666
- => 'first returned value is correct';
-
- is $return[1]->id, 1
- => 'second returned value is correct';
+ ok my @return = $replicated->schema->txn_do($transaction, 666)
+ => 'did transaction';
+
+ is $return[0]->id, 666
+ => 'first returned value is correct';
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
+ is $return[1]->id, 1
+ => 'second returned value is correct';
+
+ is $debug{storage_type}, 'MASTER',
+ "got last query from a master: $debug{dsn}";
+
}
## Test that asking for single return works
{
- ok my $return = $replicated->schema->txn_do($transaction, 777)
- => 'did transaction';
-
- is $return->id, 777
- => 'first returned value is correct';
+ ok my @return = $replicated->schema->txn_do($transaction, 777)
+ => 'did transaction';
+
+ is $return[0]->id, 777
+ => 'first returned value is correct';
+
+ is $return[1]->id, 1
+ => 'second returned value is correct';
}
## Test transaction returning a single value
{
- ok my $result = $replicated->schema->txn_do(sub {
- ok my $more = $replicated->schema->resultset('Artist')->find(1)
- => 'found inside a transaction';
- return $more;
- }) => 'successfully processed transaction';
-
- is $result->id, 1
- => 'Got expected single result from transaction';
+ ok my $result = $replicated->schema->txn_do(sub {
+ ok my $more = $replicated->schema->resultset('Artist')->find(1)
+ => 'found inside a transaction';
+ is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
+ return $more;
+ }) => 'successfully processed transaction';
+
+ is $result->id, 1
+ => 'Got expected single result from transaction';
}
## Make sure replication came back
ok $replicated->schema->resultset('Artist')->find(1)
=> 'replicant reactivated';
-
+
+is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
+
## Test Discard changes
{
- ok my $artist = $replicated->schema->resultset('Artist')->find(2)
- => 'got an artist to test discard changes';
-
- ok $artist->discard_changes
- => 'properly discard changes';
+ ok my $artist = $replicated->schema->resultset('Artist')->find(2)
+ => 'got an artist to test discard changes';
+
+ is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
+
+ ok $artist->get_from_storage({force_pool=>'master'})
+ => 'properly discard changes';
+
+ is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
+
+ ok $artist->discard_changes({force_pool=>'master'})
+ => 'properly called discard_changes against master (manual attrs)';
+
+ is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
+
+ ok $artist->discard_changes()
+ => 'properly called discard_changes against master (default attrs)';
+
+ is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
+
+ ok $artist->discard_changes({force_pool=>$replicant_names[0]})
+ => 'properly able to override the default attributes';
+
+ is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}"
}
## Test some edge cases, like trying to do a transaction inside a transaction, etc
{
ok my $result = $replicated->schema->txn_do(sub {
- return $replicated->schema->txn_do(sub {
- ok my $more = $replicated->schema->resultset('Artist')->find(1)
- => 'found inside a transaction inside a transaction';
- return $more;
- });
+ return $replicated->schema->txn_do(sub {
+ ok my $more = $replicated->schema->resultset('Artist')->find(1)
+ => 'found inside a transaction inside a transaction';
+ is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
+ return $more;
+ });
}) => 'successfully processed transaction';
-
+
is $result->id, 1
- => 'Got expected single result from transaction';
+ => 'Got expected single result from transaction';
}
{
ok my $result = $replicated->schema->txn_do(sub {
- return $replicated->schema->storage->execute_reliably(sub {
- return $replicated->schema->txn_do(sub {
- return $replicated->schema->storage->execute_reliably(sub {
- ok my $more = $replicated->schema->resultset('Artist')->find(1)
- => 'found inside crazy deep transactions and execute_reliably';
- return $more;
- });
- });
- });
+ return $replicated->schema->storage->execute_reliably(sub {
+ return $replicated->schema->txn_do(sub {
+ return $replicated->schema->storage->execute_reliably(sub {
+ ok my $more = $replicated->schema->resultset('Artist')->find(1)
+ => 'found inside crazy deep transactions and execute_reliably';
+ is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
+ return $more;
+ });
+ });
+ });
}) => 'successfully processed transaction';
-
+
is $result->id, 1
- => 'Got expected single result from transaction';
-}
+ => 'Got expected single result from transaction';
+}
## Test the force_pool resultset attribute.
{
- ok my $artist_rs = $replicated->schema->resultset('Artist')
+ ok my $artist_rs = $replicated->schema->resultset('Artist')
=> 'got artist resultset';
-
- ## Turn on Forced Pool Storage
- ok my $reliable_artist_rs = $artist_rs->search(undef, {force_pool=>'master'})
+
+ ## Turn on Forced Pool Storage
+ ok my $reliable_artist_rs = $artist_rs->search(undef, {force_pool=>'master'})
=> 'Created a resultset using force_pool storage';
-
- ok my $artist = $reliable_artist_rs->find(2)
+
+ ok my $artist = $reliable_artist_rs->find(2)
=> 'got an artist result via force_pool storage';
+
+ is $debug{storage_type}, 'MASTER', "got last query from a master: $debug{dsn}";
}
+## Test the force_pool resultset attribute part two.
+
+{
+ ok my $artist_rs = $replicated->schema->resultset('Artist')
+ => 'got artist resultset';
+
+ ## Turn on Forced Pool Storage
+ ok my $reliable_artist_rs = $artist_rs->search(undef, {force_pool=>$replicant_names[0]})
+ => 'Created a resultset using force_pool storage';
+
+ ok my $artist = $reliable_artist_rs->find(2)
+ => 'got an artist result via force_pool storage';
+
+ is $debug{storage_type}, 'REPLICANT', "got last query from a replicant: $debug{dsn}";
+}
## Delete the old database files
$replicated->cleanup;
+done_testing;
+
# vim: sw=4 sts=4 :
Modified: DBIx-Class/0.08/branches/prefetch/t/95sql_maker_quote.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/95sql_maker_quote.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/95sql_maker_quote.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -35,12 +35,21 @@
{
'artist.artistid' => 'me.artist'
}
- ]
+ ],
+ [
+ {
+ 'tracks' => 'tracks',
+ '-join_type' => 'left'
+ },
+ {
+ 'tracks.cd' => 'me.cdid'
+ }
+ ],
],
[
- {
- 'count' => '*'
- }
+ 'me.cdid',
+ { count => 'tracks.cd' },
+ { min => 'me.year', -as => 'me.minyear' },
],
{
'artist.name' => 'Caterwauler McCrae',
@@ -53,8 +62,15 @@
is_same_sql_bind(
$sql, \@bind,
- q/SELECT COUNT( * ) FROM `cd` `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )/, [ ['artist.name' => 'Caterwauler McCrae'], ['me.year' => 2001] ],
- 'got correct SQL and bind parameters for count query with quoting'
+ q/
+ SELECT `me`.`cdid`, COUNT( `tracks`.`cd` ), MIN( `me`.`year` ) AS `me`.`minyear`
+ FROM `cd` `me`
+ JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` )
+ LEFT JOIN `tracks` `tracks` ON ( `tracks`.`cd` = `me`.`cdid` )
+ WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )
+ /,
+ [ ['artist.name' => 'Caterwauler McCrae'], ['me.year' => 2001] ],
+ 'got correct SQL and bind parameters for complex select query with quoting'
);
@@ -276,7 +292,13 @@
],
[
{
- 'count' => '*'
+ max => 'rank',
+ -as => 'max_rank',
+ },
+ 'rank',
+ {
+ 'count' => '*',
+ -as => 'cnt',
}
],
{
@@ -290,7 +312,7 @@
is_same_sql_bind(
$sql, \@bind,
- q/SELECT COUNT( * ) FROM [cd] [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )/, [ ['artist.name' => 'Caterwauler McCrae'], ['me.year' => 2001] ],
+ q/SELECT MAX ( [rank] ) AS [max_rank], [rank], COUNT( * ) AS [cnt] FROM [cd] [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )/, [ ['artist.name' => 'Caterwauler McCrae'], ['me.year' => 2001] ],
'got correct SQL and bind parameters for count query with bracket quoting'
);
Deleted: DBIx-Class/0.08/branches/prefetch/t/96multi_create.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/96multi_create.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/96multi_create.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,487 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use Test::Exception;
-use lib qw(t/lib);
-use DBICTest;
-
-plan tests => 93;
-
-my $schema = DBICTest->init_schema();
-
-lives_ok ( sub {
- my $cd = $schema->resultset('CD')->create({
- artist => {
- name => 'Fred Bloggs'
- },
- title => 'Some CD',
- year => 1996
- });
-
- isa_ok($cd, 'DBICTest::CD', 'Created CD object');
- isa_ok($cd->artist, 'DBICTest::Artist', 'Created related Artist');
- is($cd->artist->name, 'Fred Bloggs', 'Artist created correctly');
-}, 'simple create + parent (the stuff $rs belongs_to) ok');
-
-lives_ok ( sub {
- my $bm_rs = $schema->resultset('Bookmark');
- my $bookmark = $bm_rs->create({
- link => {
- id => 66,
- },
- });
-
- isa_ok($bookmark, 'DBICTest::Bookmark', 'Created Bookrmark object');
- isa_ok($bookmark->link, 'DBICTest::Link', 'Created related Link');
- is (
- $bm_rs->search (
- { 'link.title' => $bookmark->link->title },
- { join => 'link' },
- )->count,
- 1,
- 'Bookmark and link made it to the DB',
- );
-}, 'simple create where the child and parent have no values, except for an explicit parent pk ok');
-
-lives_ok ( sub {
- my $artist = $schema->resultset('Artist')->first;
- my $cd = $artist->create_related (cds => {
- title => 'Music to code by',
- year => 2007,
- tags => [
- { 'tag' => 'rock' },
- ],
- });
-
- isa_ok($cd, 'DBICTest::CD', 'Created CD');
- is($cd->title, 'Music to code by', 'CD created correctly');
- is($cd->tags->count, 1, 'One tag created for CD');
- is($cd->tags->first->tag, 'rock', 'Tag created correctly');
-
-}, 'create over > 1 levels of has_many create (A => { has_many => { B => has_many => C } } )');
-
-throws_ok (
- sub {
- # Create via update - add a new CD <--- THIS SHOULD HAVE NEVER WORKED!
- $schema->resultset('Artist')->first->update({
- cds => [
- { title => 'Yet another CD',
- year => 2006,
- },
- ],
- });
- },
- qr/Recursive update is not supported over relationships of type multi/,
- 'create via update of multi relationships throws an exception'
-);
-
-lives_ok ( sub {
- my $artist = $schema->resultset('Artist')->first;
- my $c2p = $schema->resultset('CD_to_Producer')->create ({
- cd => {
- artist => $artist,
- title => 'Bad investment',
- year => 2008,
- tracks => [
- { title => 'Just buy' },
- { title => 'Why did we do it' },
- { title => 'Burn baby burn' },
- ],
- },
- producer => {
- name => 'Lehman Bros.',
- },
- });
-
- isa_ok ($c2p, 'DBICTest::CD_to_Producer', 'Linker object created');
- my $prod = $schema->resultset ('Producer')->find ({ name => 'Lehman Bros.' });
- isa_ok ($prod, 'DBICTest::Producer', 'Producer row found');
- is ($prod->cds->count, 1, 'Producer has one production');
- my $cd = $prod->cds->first;
- is ($cd->title, 'Bad investment', 'CD created correctly');
- is ($cd->tracks->count, 3, 'CD has 3 tracks');
-}, 'Create m2m while originating in the linker table');
-
-
-#CD -> has_many -> Tracks -> might have -> Single -> has_many -> Tracks
-# \
-# \-> has_many \
-# --> CD2Producer
-# /-> has_many /
-# /
-# Producer
-lives_ok ( sub {
- my $artist = $schema->resultset('Artist')->first;
- my $cd = $schema->resultset('CD')->create ({
- artist => $artist,
- title => 'Music to code by at night',
- year => 2008,
- tracks => [
- {
- title => 'Off by one again',
- },
- {
- title => 'The dereferencer',
- cd_single => {
- artist => $artist,
- year => 2008,
- title => 'Was that a null (Single)',
- tracks => [
- { title => 'The dereferencer' },
- { title => 'The dereferencer II' },
- ],
- cd_to_producer => [
- {
- producer => {
- name => 'K&R',
- }
- },
- {
- producer => {
- name => 'Don Knuth',
- }
- },
- ]
- },
- },
- ],
- });
-
- isa_ok ($cd, 'DBICTest::CD', 'Main CD object created');
- is ($cd->title, 'Music to code by at night', 'Correct CD title');
- is ($cd->tracks->count, 2, 'Two tracks on main CD');
-
- my ($t1, $t2) = $cd->tracks->all;
- is ($t1->title, 'Off by one again', 'Correct 1st track name');
- is ($t1->cd_single, undef, 'No single for 1st track');
- is ($t2->title, 'The dereferencer', 'Correct 2nd track name');
- isa_ok ($t2->cd_single, 'DBICTest::CD', 'Created a single for 2nd track');
-
- my $single = $t2->cd_single;
- is ($single->tracks->count, 2, 'Two tracks on single CD');
- is ($single->tracks->find ({ position => 1})->title, 'The dereferencer', 'Correct 1st track title');
- is ($single->tracks->find ({ position => 2})->title, 'The dereferencer II', 'Correct 2nd track title');
-
- is ($single->cd_to_producer->count, 2, 'Two producers created for the single cd');
- is_deeply (
- [ sort map { $_->producer->name } ($single->cd_to_producer->all) ],
- ['Don Knuth', 'K&R'],
- 'Producers named correctly',
- );
-}, 'Create over > 1 levels of might_have with multiple has_many and multiple m2m but starting at a has_many level');
-
-#Track -> might have -> Single -> has_many -> Tracks
-# \
-# \-> has_many \
-# --> CD2Producer
-# /-> has_many /
-# /
-# Producer
-lives_ok ( sub {
- my $cd = $schema->resultset('CD')->first;
- my $track = $schema->resultset('Track')->create ({
- cd => $cd,
- title => 'Multicreate rocks',
- cd_single => {
- artist => $cd->artist,
- year => 2008,
- title => 'Disemboweling MultiCreate',
- tracks => [
- { title => 'Why does mst write this way' },
- { title => 'Chainsaw celebration' },
- { title => 'Purl cleans up' },
- ],
- cd_to_producer => [
- {
- producer => {
- name => 'mst',
- }
- },
- {
- producer => {
- name => 'castaway',
- }
- },
- {
- producer => {
- name => 'theorbtwo',
- }
- },
- ]
- },
- });
-
- isa_ok ($track, 'DBICTest::Track', 'Main Track object created');
- is ($track->title, 'Multicreate rocks', 'Correct Track title');
-
- my $single = $track->cd_single;
- isa_ok ($single, 'DBICTest::CD', 'Created a single with the track');
- is ($single->tracks->count, 3, '3 tracks on single CD');
- is ($single->tracks->find ({ position => 1})->title, 'Why does mst write this way', 'Correct 1st track title');
- is ($single->tracks->find ({ position => 2})->title, 'Chainsaw celebration', 'Correct 2nd track title');
- is ($single->tracks->find ({ position => 3})->title, 'Purl cleans up', 'Correct 3rd track title');
-
- is ($single->cd_to_producer->count, 3, '3 producers created for the single cd');
- is_deeply (
- [ sort map { $_->producer->name } ($single->cd_to_producer->all) ],
- ['castaway', 'mst', 'theorbtwo'],
- 'Producers named correctly',
- );
-}, 'Create over > 1 levels of might_have with multiple has_many and multiple m2m but starting at the might_have directly');
-
-lives_ok ( sub {
- my $artist = $schema->resultset('Artist')->first;
- my $cd = $schema->resultset('CD')->create ({
- artist => $artist,
- title => 'Music to code by at twilight',
- year => 2008,
- artwork => {
- images => [
- { name => 'recursive descent' },
- { name => 'tail packing' },
- ],
- },
- });
-
- isa_ok ($cd, 'DBICTest::CD', 'Main CD object created');
- is ($cd->title, 'Music to code by at twilight', 'Correct CD title');
- isa_ok ($cd->artwork, 'DBICTest::Artwork', 'Artwork created');
-
- # this test might look weird, but it failed at one point, keep it there
- my $art_obj = $cd->artwork;
- ok ($art_obj->has_column_loaded ('cd_id'), 'PK/FK present on artwork object');
- is ($art_obj->images->count, 2, 'Correct artwork image count via the new object');
- is_deeply (
- [ sort $art_obj->images->get_column ('name')->all ],
- [ 'recursive descent', 'tail packing' ],
- 'Images named correctly in objects',
- );
-
- my $artwork = $schema->resultset('Artwork')->search (
- { 'cd.title' => 'Music to code by at twilight' },
- { join => 'cd' },
- )->single;
-
- is ($artwork->images->count, 2, 'Correct artwork image count via a new search');
-
- is_deeply (
- [ sort $artwork->images->get_column ('name')->all ],
- [ 'recursive descent', 'tail packing' ],
- 'Images named correctly after search',
- );
-}, 'Test might_have again but with a PK == FK in the middle (obviously not specified)');
-
-lives_ok ( sub {
- my $cd = $schema->resultset('CD')->first;
- my $track = $schema->resultset ('Track')->create ({
- cd => $cd,
- title => 'Black',
- lyrics => {
- lyric_versions => [
- { text => 'The color black' },
- { text => 'The colour black' },
- ],
- },
- });
-
- isa_ok ($track, 'DBICTest::Track', 'Main track object created');
- is ($track->title, 'Black', 'Correct track title');
- isa_ok ($track->lyrics, 'DBICTest::Lyrics', 'Lyrics created');
-
- # this test might look weird, but it was failing at one point, keep it there
- my $lyric_obj = $track->lyrics;
- ok ($lyric_obj->has_column_loaded ('lyric_id'), 'PK present on lyric object');
- ok ($lyric_obj->has_column_loaded ('track_id'), 'FK present on lyric object');
- is ($lyric_obj->lyric_versions->count, 2, 'Correct lyric versions count via the new object');
- is_deeply (
- [ sort $lyric_obj->lyric_versions->get_column ('text')->all ],
- [ 'The color black', 'The colour black' ],
- 'Lyrics text in objects matches',
- );
-
-
- my $lyric = $schema->resultset('Lyrics')->search (
- { 'track.title' => 'Black' },
- { join => 'track' },
- )->single;
-
- is ($lyric->lyric_versions->count, 2, 'Correct lyric versions count via a new search');
-
- is_deeply (
- [ sort $lyric->lyric_versions->get_column ('text')->all ],
- [ 'The color black', 'The colour black' ],
- 'Lyrics text via search matches',
- );
-}, 'Test might_have again but with just a PK and FK (neither specified) in the mid-table');
-
-lives_ok ( sub {
- my $newartist2 = $schema->resultset('Artist')->find_or_create({
- name => 'Fred 3',
- cds => [
- {
- title => 'Noah Act',
- year => 2007,
- },
- ],
- });
- is($newartist2->name, 'Fred 3', 'Created new artist with cds via find_or_create');
-}, 'Nested find_or_create');
-
-lives_ok ( sub {
- my $artist2 = $schema->resultset('Artist')->create({
- name => 'Fred 4',
- cds => [
- {
- title => 'Music to code by',
- year => 2007,
- },
- ],
- cds_unordered => [
- {
- title => 'Music to code by',
- year => 2007,
- },
- ]
- });
-
- is($artist2->in_storage, 1, 'artist with duplicate rels inserted okay');
-}, 'Multiple same level has_many create');
-
-lives_ok ( sub {
- my $artist = $schema->resultset('Artist')->first;
-
- my $cd_result = $artist->create_related('cds', {
-
- title => 'TestOneCD1',
- year => 2007,
- tracks => [
- { title => 'TrackOne' },
- { title => 'TrackTwo' },
- ],
-
- });
-
- isa_ok( $cd_result, 'DBICTest::CD', "Got Good CD Class");
- ok( $cd_result->title eq "TestOneCD1", "Got Expected Title");
-
- my $tracks = $cd_result->tracks;
-
- isa_ok( $tracks, 'DBIx::Class::ResultSet', 'Got Expected Tracks ResultSet');
-
- foreach my $track ($tracks->all)
- {
- isa_ok( $track, 'DBICTest::Track', 'Got Expected Track Class');
- }
-}, 'First create_related pass');
-
-lives_ok ( sub {
- my $artist = $schema->resultset('Artist')->first;
-
- my $cd_result = $artist->create_related('cds', {
-
- title => 'TestOneCD2',
- year => 2007,
- tracks => [
- { title => 'TrackOne' },
- { title => 'TrackTwo' },
- ],
-
- liner_notes => { notes => 'I can haz liner notes?' },
-
- });
-
- isa_ok( $cd_result, 'DBICTest::CD', "Got Good CD Class");
- ok( $cd_result->title eq "TestOneCD2", "Got Expected Title");
- ok( $cd_result->notes eq 'I can haz liner notes?', 'Liner notes');
-
- my $tracks = $cd_result->tracks;
-
- isa_ok( $tracks, 'DBIx::Class::ResultSet', "Got Expected Tracks ResultSet");
-
- foreach my $track ($tracks->all)
- {
- isa_ok( $track, 'DBICTest::Track', 'Got Expected Track Class');
- }
-}, 'second create_related with same arguments');
-
-lives_ok ( sub {
- my $cdp = $schema->resultset('CD_to_Producer')->create({
- cd => { artist => 1, title => 'foo', year => 2000 },
- producer => { name => 'jorge' }
- });
- ok($cdp, 'join table record created ok');
-}, 'create of parents of a record linker table');
-
-lives_ok ( sub {
- my $kurt_cobain = { name => 'Kurt Cobain' };
-
- my $in_utero = $schema->resultset('CD')->new({
- title => 'In Utero',
- year => 1993
- });
-
- $kurt_cobain->{cds} = [ $in_utero ];
-
-
- $schema->resultset('Artist')->populate([ $kurt_cobain ]); # %)
- $a = $schema->resultset('Artist')->find({name => 'Kurt Cobain'});
-
- is($a->name, 'Kurt Cobain', 'Artist insertion ok');
- is($a->cds && $a->cds->first && $a->cds->first->title,
- 'In Utero', 'CD insertion ok');
-}, 'populate');
-
-## Create foreign key col obj including PK
-## See test 20 in 66relationships.t
-lives_ok ( sub {
- my $new_cd_hashref = {
- cdid => 27,
- title => 'Boogie Woogie',
- year => '2007',
- artist => { artistid => 17, name => 'king luke' }
- };
-
- my $cd = $schema->resultset("CD")->find(1);
-
- is($cd->artist->id, 1, 'rel okay');
-
- my $new_cd = $schema->resultset("CD")->create($new_cd_hashref);
- is($new_cd->artist->id, 17, 'new id retained okay');
-}, 'Create foreign key col obj including PK');
-
-lives_ok ( sub {
- $schema->resultset("CD")->create({
- cdid => 28,
- title => 'Boogie Wiggle',
- year => '2007',
- artist => { artistid => 18, name => 'larry' }
- });
-}, 'new cd created without clash on related artist');
-
-throws_ok ( sub {
- my $t = $schema->resultset("Track")->new({ cd => { artist => undef } });
- #$t->cd($t->new_related('cd', { artist => undef } ) );
- #$t->{_rel_in_storage} = 0;
- $t->insert;
-}, qr/cd.artist may not be NULL/, "Exception propogated properly");
-
-lives_ok ( sub {
- $schema->resultset('CD')->create ({
- artist => {
- name => 'larry', # should already exist
- },
- title => 'Warble Marble',
- year => '2009',
- cd_to_producer => [
- { producer => { name => 'Cowboy Neal' } },
- ],
- });
-
- my $m2m_cd = $schema->resultset('CD')->search ({ title => 'Warble Marble'});
- is ($m2m_cd->count, 1, 'One CD row created via M2M create');
- is ($m2m_cd->first->producers->count, 1, 'CD row created with one producer');
- is ($m2m_cd->first->producers->first->name, 'Cowboy Neal', 'Correct producer row created');
-}, 'Test multi create over many_to_many');
-
-1;
Deleted: DBIx-Class/0.08/branches/prefetch/t/96multi_create_new.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/96multi_create_new.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/96multi_create_new.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,74 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use Test::Exception;
-use lib qw(t/lib);
-use DBICTest;
-
-plan tests => 12;
-
-my $schema = DBICTest->init_schema();
-
-# Test various new() invocations - this is all about backcompat, making
-# sure that insert() still works as expected by legacy code.
-#
-# What we essentially do is multi-instantiate objects, making sure nothing
-# gets inserted. Then we add some more objects to the mix either via
-# new_related() or by setting an accessor directly (or both) - again
-# expecting no inserts. Then after calling insert() on the starter object
-# we expect everything supplied to new() to get inserted, as well as any
-# relations whose PK's are necessary to complete the objects supplied
-# to new(). All other objects should be insert()able afterwards too.
-
-
-{
- my $new_artist = $schema->resultset("Artist")->new_result({ 'name' => 'Depeche Mode' });
- my $new_related_cd = $new_artist->new_related('cds', { 'title' => 'Leave in Silence', 'year' => 1982});
- eval {
- $new_artist->insert;
- $new_related_cd->insert;
- };
- is ($@, '', 'Staged insertion successful');
- ok($new_artist->in_storage, 'artist inserted');
- ok($new_related_cd->in_storage, 'new_related_cd inserted');
-}
-
-{
- my $new_artist = $schema->resultset("Artist")->new_result({ 'name' => 'Depeche Mode' });
- my $new_related_cd = $new_artist->new_related('cds', { 'title' => 'Leave Slightly Noisily', 'year' => 1982});
- eval {
- $new_related_cd->insert;
- };
- is ($@, '', 'CD insertion survives by finding artist');
- ok($new_artist->in_storage, 'artist inserted');
- ok($new_related_cd->in_storage, 'new_related_cd inserted');
-}
-
-{
- my $new_artist = $schema->resultset("Artist")->new_result({ 'name' => 'Depeche Mode 2: Insertion Boogaloo' });
- my $new_related_cd = $new_artist->new_related('cds', { 'title' => 'Leave Loudly While Singing Off Key', 'year' => 1982});
- eval {
- $new_related_cd->insert;
- };
- is ($@, '', 'CD insertion survives by inserting artist');
- ok($new_artist->in_storage, 'artist inserted');
- ok($new_related_cd->in_storage, 'new_related_cd inserted');
-}
-
-{
- my $new_cd = $schema->resultset("CD")->new_result({});
- my $new_related_artist = $new_cd->new_related('artist', { 'name' => 'Marillion',});
- lives_ok (
- sub {
- $new_related_artist->insert;
- $new_cd->title( 'Misplaced Childhood' );
- $new_cd->year ( 1985 );
- $new_cd->artist( $new_related_artist ); # For exact backward compatibility
- $new_cd->insert;
- },
- 'Reversed staged insertion successful'
- );
- ok($new_related_artist->in_storage, 'related artist inserted');
- ok($new_cd->in_storage, 'cd inserted');
-}
Deleted: DBIx-Class/0.08/branches/prefetch/t/96multi_create_torture.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/96multi_create_torture.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/96multi_create_torture.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,228 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use Test::Exception;
-use lib qw(t/lib);
-use DBICTest;
-
-plan tests => 23;
-
-# an insane multicreate
-# (should work, despite the fact that no one will probably use it this way)
-
-my $schema = DBICTest->init_schema();
-
-# first count how many rows do we initially have
-my $counts;
-$counts->{$_} = $schema->resultset($_)->count for qw/Artist CD Genre Producer Tag/;
-
-# do the crazy create
-eval {
- $schema->resultset('CD')->create ({
- artist => {
- name => 'james',
- },
- title => 'Greatest hits 1',
- year => '2012',
- genre => {
- name => '"Greatest" collections',
- },
- tags => [
- { tag => 'A' },
- { tag => 'B' },
- ],
- cd_to_producer => [
- {
- producer => {
- name => 'bob',
- producer_to_cd => [
- {
- cd => {
- artist => {
- name => 'lars',
- cds => [
- {
- title => 'Greatest hits 2',
- year => 2012,
- genre => {
- name => '"Greatest" collections',
- },
- tags => [
- { tag => 'A' },
- { tag => 'B' },
- ],
- # This cd is created via artist so it doesn't know about producers
- cd_to_producer => [
- { producer => { name => 'bob' } },
- { producer => { name => 'paul' } },
- { producer => {
- name => 'flemming',
- producer_to_cd => [
- { cd => {
- artist => {
- name => 'kirk',
- cds => [
- {
- title => 'Greatest hits 3',
- year => 2012,
- genre => {
- name => '"Greatest" collections',
- },
- tags => [
- { tag => 'A' },
- { tag => 'B' },
- ],
- },
- {
- title => 'Greatest hits 4',
- year => 2012,
- genre => {
- name => '"Greatest" collections2',
- },
- tags => [
- { tag => 'A' },
- { tag => 'B' },
- ],
- },
- ],
- },
- title => 'Greatest hits 5',
- year => 2013,
- genre => {
- name => '"Greatest" collections2',
- },
- }},
- ],
- }},
- ],
- },
- ],
- },
- title => 'Greatest hits 6',
- year => 2012,
- genre => {
- name => '"Greatest" collections',
- },
- tags => [
- { tag => 'A' },
- { tag => 'B' },
- ],
- },
- },
- {
- cd => {
- artist => {
- name => 'lars', # should already exist
- # even though the artist 'name' is not uniquely constrained
- # find_or_create will arguably DWIM
- },
- title => 'Greatest hits 7',
- year => 2013,
- },
- },
- ],
- },
- },
- ],
- });
-
- is ($schema->resultset ('Artist')->count, $counts->{Artist} + 3, '3 new artists created');
- is ($schema->resultset ('Genre')->count, $counts->{Genre} + 2, '2 additional genres created');
- is ($schema->resultset ('Producer')->count, $counts->{Producer} + 3, '3 new producer');
- is ($schema->resultset ('CD')->count, $counts->{CD} + 7, '7 new CDs');
- is ($schema->resultset ('Tag')->count, $counts->{Tag} + 10, '10 new Tags');
-
- my $cd_rs = $schema->resultset ('CD')
- ->search ({ title => { -like => 'Greatest hits %' }}, { order_by => 'title'} );
- is ($cd_rs->count, 7, '7 greatest hits created');
-
- my $cds_2012 = $cd_rs->search ({ year => 2012});
- is ($cds_2012->count, 5, '5 CDs created in 2012');
-
- is (
- $cds_2012->search(
- { 'tags.tag' => { -in => [qw/A B/] } },
- {
- join => 'tags',
- group_by => 'me.cdid',
- having => 'count(me.cdid) = 2',
- }
- ),
- 5,
- 'All 10 tags were pairwise distributed between 5 year-2012 CDs'
- );
-
- my $paul_prod = $cd_rs->search (
- { 'producer.name' => 'paul'},
- { join => { cd_to_producer => 'producer' } }
- );
- is ($paul_prod->count, 1, 'Paul had 1 production');
- my $pauls_cd = $paul_prod->single;
- is ($pauls_cd->cd_to_producer->count, 3, 'Paul had two co-producers');
- is (
- $pauls_cd->search_related ('cd_to_producer',
- { 'producer.name' => 'flemming'},
- { join => 'producer' }
- )->count,
- 1,
- 'The second producer is flemming',
- );
-
- my $kirk_cds = $cd_rs->search ({ 'artist.name' => 'kirk' }, { join => 'artist' });
- is ($kirk_cds, 3, 'Kirk had 3 CDs');
- is (
- $kirk_cds->search (
- { 'cd_to_producer.cd' => { '!=', undef } },
- { join => 'cd_to_producer' },
- ),
- 1,
- 'Kirk had a producer only on one cd',
- );
-
- my $lars_cds = $cd_rs->search ({ 'artist.name' => 'lars' }, { join => 'artist' });
- is ($lars_cds->count, 3, 'Lars had 3 CDs');
- is (
- $lars_cds->search (
- { 'cd_to_producer.cd' => undef },
- { join => 'cd_to_producer' },
- ),
- 0,
- 'Lars always had a producer',
- );
- is (
- $lars_cds->search_related ('cd_to_producer',
- { 'producer.name' => 'flemming'},
- { join => 'producer' }
- )->count,
- 1,
- 'Lars produced 1 CD with flemming',
- );
- is (
- $lars_cds->search_related ('cd_to_producer',
- { 'producer.name' => 'bob'},
- { join => 'producer' }
- )->count,
- 3,
- 'Lars produced 3 CDs with bob',
- );
-
- my $bob_prod = $cd_rs->search (
- { 'producer.name' => 'bob'},
- { join => { cd_to_producer => 'producer' } }
- );
- is ($bob_prod->count, 4, 'Bob produced a total of 4 CDs');
- ok ($bob_prod->find ({ title => 'Greatest hits 1'}), '1st Bob production name correct');
- ok ($bob_prod->find ({ title => 'Greatest hits 6'}), '2nd Bob production name correct');
- ok ($bob_prod->find ({ title => 'Greatest hits 2'}), '3rd Bob production name correct');
- ok ($bob_prod->find ({ title => 'Greatest hits 7'}), '4th Bob production name correct');
-
- is (
- $bob_prod->search ({ 'artist.name' => 'james' }, { join => 'artist' })->count,
- 1,
- "Bob produced james' only CD",
- );
-};
-diag $@ if $@;
-
-1;
Modified: DBIx-Class/0.08/branches/prefetch/t/99dbic_sqlt_parser.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/99dbic_sqlt_parser.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/99dbic_sqlt_parser.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -15,9 +15,13 @@
my $schema = DBICTest->init_schema();
# Dummy was yanked out by the sqlt hook test
+# CustomSql tests the horrific/deprecated ->name(\$sql) hack
# YearXXXXCDs are views
-my @sources = grep { $_ ne 'Dummy' && $_ !~ /^Year\d{4}CDs$/ }
- $schema->sources;
+#
+my @sources = grep
+ { $_ !~ /^ (?: Dummy | CustomSql | Year\d{4}CDs ) $/x }
+ $schema->sources
+;
plan tests => ( @sources * 3);
@@ -25,7 +29,7 @@
my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { } } });
foreach my $source (@sources) {
- my $table = $sqlt_schema->get_table($schema->source($source)->from);
+ my $table = get_table($sqlt_schema, $schema, $source);
my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints);
my @indices = $table->get_indices;
@@ -39,7 +43,7 @@
my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 1 } } });
foreach my $source (@sources) {
- my $table = $sqlt_schema->get_table($schema->source($source)->from);
+ my $table = get_table($sqlt_schema, $schema, $source);
my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints);
my @indices = $table->get_indices;
@@ -53,7 +57,7 @@
my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 0 } } });
foreach my $source (@sources) {
- my $table = $sqlt_schema->get_table($schema->source($source)->from);
+ my $table = get_table($sqlt_schema, $schema, $source);
my @indices = $table->get_indices;
my $index_count = scalar(@indices);
@@ -79,3 +83,12 @@
$sqlt->parser('SQL::Translator::Parser::DBIx::Class');
return $sqlt->translate({ data => $schema }) or die $sqlt->error;
}
+
+sub get_table {
+ my ($sqlt_schema, $schema, $source) = @_;
+
+ my $table_name = $schema->source($source)->from;
+ $table_name = $$table_name if ref $table_name;
+
+ return $sqlt_schema->get_table($table_name);
+}
Modified: DBIx-Class/0.08/branches/prefetch/t/bind/attribute.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/bind/attribute.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/bind/attribute.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -13,7 +13,7 @@
eval "use DBD::SQLite";
plan $@
? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 9 );
+ : ( tests => 13 );
}
my $where_bind = {
@@ -45,34 +45,34 @@
is ( $rs->count, 1, 'where/bind last' );
}
-# More complex cases, based primarily on the Cookbook
-# "Arbitrary SQL through a custom ResultSource" technique,
-# which seems to be the only place the bind attribute is
-# documented. Breaking this technique probably breaks existing
-# application code.
-my $source = DBICTest::Artist->result_source_instance;
-my $new_source = $source->new($source);
-$new_source->source_name('Complex');
+{
+ # More complex cases, based primarily on the Cookbook
+ # "Arbitrary SQL through a custom ResultSource" technique,
+ # which seems to be the only place the bind attribute is
+ # documented. Breaking this technique probably breaks existing
+ # application code.
+ my $source = DBICTest::Artist->result_source_instance;
+ my $new_source = $source->new($source);
+ $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 = ?)
+ $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 = ?)
-$schema->register_extra_source('Complex' => $new_source);
+ $schema->register_extra_source('Complex' => $new_source);
-$rs = $schema->resultset('Complex')->search({}, { bind => [ 1999 ] });
-is ( $rs->count, 1, 'cookbook arbitrary sql example' );
+ $rs = $schema->resultset('Complex')->search({}, { bind => [ 1999 ] });
+ is ( $rs->count, 1, 'cookbook arbitrary sql example' );
-$rs = $schema->resultset('Complex')->search({ 'artistid' => 1 }, { bind => [ 1999 ] });
-is ( $rs->count, 1, '...coobook + search condition' );
+ $rs = $schema->resultset('Complex')->search({ 'artistid' => 1 }, { bind => [ 1999 ] });
+ is ( $rs->count, 1, '...cookbook + search condition' );
-$rs = $schema->resultset('Complex')->search({}, { bind => [ 1999 ] })
- ->search({ 'artistid' => 1 });
-is ( $rs->count, 1, '...cookbook (bind first) + chained search' );
+ $rs = $schema->resultset('Complex')->search({}, { bind => [ 1999 ] })
+ ->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%' ] });
is_same_sql_bind(
$rs->as_query,
@@ -82,8 +82,36 @@
[ '!!dummy' => 'Spoon%' ]
],
'got correct SQL'
-);
+ );
+}
+{
+ # More complex cases, based primarily on the Cookbook
+ # "Arbitrary SQL through a custom ResultSource" technique,
+ # which seems to be the only place the bind attribute is
+ # documented. Breaking this technique probably breaks existing
+ # application code.
+
+ $rs = $schema->resultset('CustomSql')->search({}, { bind => [ 1999 ] });
+ is ( $rs->count, 1, 'cookbook arbitrary sql example (in separate file)' );
+
+ $rs = $schema->resultset('CustomSql')->search({ 'artistid' => 1 }, { bind => [ 1999 ] });
+ is ( $rs->count, 1, '...cookbook (in separate file) + search condition' );
+
+ $rs = $schema->resultset('CustomSql')->search({}, { bind => [ 1999 ] })
+ ->search({ 'artistid' => 1 });
+ is ( $rs->count, 1, '...cookbook (bind first, in separate file) + chained search' );
+
+ $rs = $schema->resultset('CustomSql')->search({}, { bind => [ 1999 ] })->search({}, { where => \"title LIKE ?", bind => [ 'Spoon%' ] });
+ is_same_sql_bind(
+ $rs->as_query,
+ "(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 (cookbook arbitrary SQL, in separate file)'
+ );
}
TODO: {
Modified: DBIx-Class/0.08/branches/prefetch/t/cdbi/02-Film.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/cdbi/02-Film.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/cdbi/02-Film.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -8,8 +8,7 @@
plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
next;
}
- eval "use DBD::SQLite";
- plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 98);
+ plan tests => 98;
}
INIT {
@@ -187,17 +186,14 @@
ok(!Film->retrieve('Ishtar'), 'Ishtar no longer there');
{
my $deprecated = 0;
- #local $SIG{__WARN__} = sub { $deprecated++ if $_[0] =~ /deprecated/ };
+ local $SIG{__WARN__} = sub { $deprecated++ if $_[0] =~ /deprecated/ };
ok(
Film->delete(Director => 'Elaine May'),
"In fact, delete all films by Elaine May"
);
cmp_ok(Film->search(Director => 'Elaine May'), '==',
0, "0 Films by Elaine May");
- SKIP: {
- skip "No deprecated warnings from compat layer", 1;
- is $deprecated, 1, "Got a deprecated warning";
- }
+ is $deprecated, 0, "No deprecated warnings from compat layer";
}
};
is $@, '', "No problems with deletes";
Property changes on: DBIx-Class/0.08/branches/prefetch/t/cdbi/testlib/DBIC/Test/SQLite.pm
___________________________________________________________________
Name: svn:eol-style
- native
Modified: DBIx-Class/0.08/branches/prefetch/t/count/count_rs.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/count/count_rs.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/count/count_rs.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -33,7 +33,7 @@
\@bind,
'SELECT COUNT( * )
FROM cd me
- LEFT JOIN track tracks ON tracks.cd = me.cdid
+ JOIN track tracks ON tracks.cd = me.cdid
JOIN cd disc ON disc.cdid = tracks.cd
LEFT JOIN lyrics lyrics ON lyrics.track_id = tracks.trackid
WHERE ( ( position = ? OR position = ? ) )
@@ -51,7 +51,7 @@
FROM (
SELECT tracks.trackid
FROM cd me
- LEFT JOIN track tracks ON tracks.cd = me.cdid
+ JOIN track tracks ON tracks.cd = me.cdid
JOIN cd disc ON disc.cdid = tracks.cd
LEFT JOIN lyrics lyrics ON lyrics.track_id = tracks.trackid
WHERE ( ( position = ? OR position = ? ) )
@@ -85,7 +85,7 @@
FROM (
SELECT cds.cdid
FROM artist me
- LEFT JOIN cd cds ON cds.artist = me.artistid
+ JOIN cd cds ON cds.artist = me.artistid
LEFT JOIN track tracks ON tracks.cd = cds.cdid
JOIN artist artist ON artist.artistid = cds.artist
WHERE tracks.position = ? OR tracks.position = ?
@@ -105,7 +105,7 @@
FROM (
SELECT cds.cdid
FROM artist me
- LEFT JOIN cd cds ON cds.artist = me.artistid
+ JOIN cd cds ON cds.artist = me.artistid
LEFT JOIN track tracks ON tracks.cd = cds.cdid
JOIN artist artist ON artist.artistid = cds.artist
WHERE tracks.position = ? OR tracks.position = ?
Modified: DBIx-Class/0.08/branches/prefetch/t/count/distinct.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/count/distinct.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/count/distinct.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -11,8 +11,6 @@
my $schema = DBICTest->init_schema();
-plan tests => 58;
-
# The tag Blue is assigned to cds 1 2 3 and 5
# The tag Cheesy is assigned to cds 2 4 and 5
#
@@ -80,23 +78,40 @@
is($get_count->($rs), 3, 'Count by distinct function result as select literal');
}
-eval {
- my @warnings;
- local $SIG{__WARN__} = sub { $_[0] =~ /The select => { distinct => ... } syntax will be deprecated/
- ? push @warnings, @_
- : warn @_
- };
- my $row = $schema->resultset('Tag')->search({}, { select => { distinct => 'tag' } })->first;
- is (@warnings, 1, 'Warned about deprecated distinct') if $DBIx::Class::VERSION < 0.09;
-};
-ok ($@, 'Exception on deprecated distinct usage thrown') if $DBIx::Class::VERSION >= 0.09;
-
throws_ok(
sub { my $row = $schema->resultset('Tag')->search({}, { select => { distinct => [qw/tag cd/] } })->first },
qr/select => { distinct => \.\.\. } syntax is not supported for multiple columns/,
'throw on unsupported syntax'
);
+# make sure distinct+func works
+{
+ my $rs = $schema->resultset('Artist')->search(
+ {},
+ {
+ join => 'cds',
+ distinct => 1,
+ '+select' => [ { count => 'cds.cdid', -as => 'amount_of_cds' } ],
+ '+as' => [qw/num_cds/],
+ order_by => { -desc => 'amount_of_cds' },
+ }
+ );
+
+ is_same_sql_bind (
+ $rs->as_query,
+ '(
+ SELECT me.artistid, me.name, me.rank, me.charfield, COUNT( cds.cdid ) AS amount_of_cds
+ FROM artist me LEFT JOIN cd cds ON cds.artist = me.artistid
+ GROUP BY me.artistid, me.name, me.rank, me.charfield
+ ORDER BY amount_of_cds DESC
+ )',
+ [],
+ );
+
+ is ($rs->next->get_column ('num_cds'), 3, 'Function aliased correctly');
+}
+
# These two rely on the database to throw an exception. This might not be the case one day. Please revise.
dies_ok(sub { my $count = $schema->resultset('Tag')->search({}, { '+select' => \'tagid AS tag_id', distinct => 1 })->count }, 'expecting to die');
-dies_ok(sub { my $count = $schema->resultset('Tag')->search({}, { select => { length => 'tag' }, distinct => 1 })->count }, 'expecting to die');
+
+done_testing;
Modified: DBIx-Class/0.08/branches/prefetch/t/count/joined.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/count/joined.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/count/joined.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -7,7 +7,7 @@
use DBICTest;
-plan tests => 3;
+plan tests => 7;
my $schema = DBICTest->init_schema();
@@ -26,6 +26,12 @@
"Count correct with requested distinct collapse of main table"
);
+# JOIN and LEFT JOIN issues mean that we've seen problems where counted rows and fetched rows are sometimes 1 higher than they should
+# be in the related resultset.
+my $artist=$schema->resultset('Artist')->create({name => 'xxx'});
+is($artist->related_resultset('cds')->count(), 0, "No CDs found for a shiny new artist");
+is(scalar($artist->related_resultset('cds')->all()), 0, "No CDs fetched for a shiny new artist");
-
-
+my $artist_rs = $schema->resultset('Artist')->search({artistid => $artist->id});
+is($artist_rs->related_resultset('cds')->count(), 0, "No CDs counted for a shiny new artist using a resultset search");
+is(scalar($artist_rs->related_resultset('cds')->all), 0, "No CDs fetched for a shiny new artist using a resultset search");
Modified: DBIx-Class/0.08/branches/prefetch/t/count/prefetch.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/count/prefetch.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/count/prefetch.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -6,10 +6,7 @@
use Test::More;
use DBICTest;
use DBIC::SqlMakerTest;
-use DBIC::DebugObj;
-plan tests => 6;
-
my $schema = DBICTest->init_schema();
# collapsing prefetch
@@ -20,20 +17,58 @@
{ prefetch => [qw/tracks artist/] },
);
is ($rs->all, 5, 'Correct number of objects');
+ is ($rs->count, 5, 'Correct count');
+ is_same_sql_bind (
+ $rs->count_rs->as_query,
+ '(
+ SELECT COUNT( * )
+ FROM (
+ SELECT cds.cdid
+ FROM artist me
+ JOIN cd cds ON cds.artist = me.artistid
+ LEFT JOIN track tracks ON tracks.cd = cds.cdid
+ JOIN artist artist ON artist.artistid = cds.artist
+ WHERE tracks.position = ? OR tracks.position = ?
+ GROUP BY cds.cdid
+ ) count_subq
+ )',
+ [ map { [ 'tracks.position' => $_ ] } (1, 2) ],
+ );
+}
- my ($sql, @bind);
- $schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind));
- $schema->storage->debug(1);
+# collapsing prefetch with distinct
+{
+ my $first_cd = $schema->resultset('Artist')->first->cds->first;
+ $first_cd->update ({
+ genreid => $first_cd->create_related (
+ genre => ({ name => 'vague genre' })
+ )->id
+ });
+ my $rs = $schema->resultset("Artist")->search(undef, {distinct => 1})
+ ->search_related('cds')->search_related('genre',
+ { 'genre.name' => { '!=', 'foo' } },
+ { prefetch => q(cds) },
+ );
+ is ($rs->all, 1, 'Correct number of objects');
+ is ($rs->count, 1, 'Correct count');
- is ($rs->count, 5, 'Correct count');
-
is_same_sql_bind (
- $sql,
- \@bind,
- 'SELECT COUNT( * ) FROM (SELECT cds.cdid FROM artist me LEFT JOIN cd cds ON cds.artist = me.artistid LEFT JOIN track tracks ON tracks.cd = cds.cdid JOIN artist artist ON artist.artistid = cds.artist WHERE tracks.position = ? OR tracks.position = ? GROUP BY cds.cdid) count_subq',
- [ qw/'1' '2'/ ],
+ $rs->count_rs->as_query,
+ '(
+ SELECT COUNT( * )
+ FROM (
+ SELECT genre.genreid
+ FROM artist me
+ JOIN cd cds ON cds.artist = me.artistid
+ JOIN genre genre ON genre.genreid = cds.genreid
+ LEFT JOIN cd cds_2 ON cds_2.genreid = genre.genreid
+ WHERE ( genre.name != ? )
+ GROUP BY genre.genreid
+ ) count_subq
+ )',
+ [ [ 'genre.name' => 'foo' ] ],
);
}
@@ -47,17 +82,20 @@
is ($rs->all, 10, 'Correct number of objects');
- my ($sql, @bind);
- $schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind));
- $schema->storage->debug(1);
-
-
is ($rs->count, 10, 'Correct count');
is_same_sql_bind (
- $sql,
- \@bind,
- 'SELECT COUNT( * ) FROM cd me LEFT JOIN track tracks ON tracks.cd = me.cdid JOIN cd disc ON disc.cdid = tracks.cd LEFT JOIN lyrics lyrics ON lyrics.track_id = tracks.trackid WHERE ( ( position = ? OR position = ? ) )',
- [ qw/'1' '2'/ ],
+ $rs->count_rs->as_query,
+ '(
+ SELECT COUNT( * )
+ FROM cd me
+ JOIN track tracks ON tracks.cd = me.cdid
+ JOIN cd disc ON disc.cdid = tracks.cd
+ LEFT JOIN lyrics lyrics ON lyrics.track_id = tracks.trackid
+ WHERE position = ? OR position = ?
+ )',
+ [ map { [ position => $_ ] } (1, 2) ],
);
}
+
+done_testing;
Modified: DBIx-Class/0.08/branches/prefetch/t/from_subquery.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/from_subquery.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/from_subquery.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -3,17 +3,12 @@
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;
+plan tests => 8;
+
my $schema = DBICTest->init_schema();
my $art_rs = $schema->resultset('Artist');
my $cdrs = $schema->resultset('CD');
Modified: DBIx-Class/0.08/branches/prefetch/t/inflate/core.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/inflate/core.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/inflate/core.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,7 +1,8 @@
use strict;
-use warnings;
+use warnings;
use Test::More;
+use Test::Exception;
use lib qw(t/lib);
use DBICTest;
@@ -10,8 +11,6 @@
eval { require DateTime };
plan skip_all => "Need DateTime for inflation tests" if $@;
-plan tests => 22;
-
$schema->class('CD') ->inflate_column( 'year',
{ inflate => sub { DateTime->new( year => shift ) },
deflate => sub { shift->year } }
@@ -54,10 +53,10 @@
ok(!$@, 'set_inflated_column with DateTime object');
$cd->update;
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
is( $cd->year->year, $now->year, 'deflate ok' );
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
my $before_year = $cd->year->year;
eval { $cd->set_inflated_column('year', \'year + 1') };
ok(!$@, 'set_inflated_column to "year + 1"');
@@ -66,18 +65,17 @@
TODO: {
local $TODO = 'this was left in without a TODO - should it work?';
- eval {
+ lives_ok (sub {
$cd->store_inflated_column('year', \'year + 1');
is_deeply( $cd->year, \'year + 1', 'deflate ok' );
- };
- ok(!$@, 'store_inflated_column to "year + 1"');
+ }, 'store_inflated_column to "year + 1"');
}
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
is( $cd->year->year, $before_year+1, 'deflate ok' );
# store_inflated_column test
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
eval { $cd->store_inflated_column('year', $now) };
ok(!$@, 'store_inflated_column with DateTime object');
$cd->update;
@@ -85,21 +83,21 @@
is( $cd->year->year, $now->year, 'deflate ok' );
# update tests
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
eval { $cd->update({'year' => $now}) };
ok(!$@, 'update using DateTime object ok');
is($cd->year->year, $now->year, 'deflate ok');
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
$before_year = $cd->year->year;
eval { $cd->update({'year' => \'year + 1'}) };
ok(!$@, 'update using scalarref ok');
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
is($cd->year->year, $before_year + 1, 'deflate ok');
# discard_changes test
-$cd = $schema->resultset("CD")->find(3);
+$cd = $schema->resultset("CD")->find(3);
# inflate the year
$before_year = $cd->year->year;
$cd->update({ year => \'year + 1'});
@@ -110,4 +108,5 @@
my $copy = $cd->copy({ year => $now, title => "zemoose" });
isnt( $copy->year->year, $before_year, "copy" );
-
+
+done_testing;
Added: DBIx-Class/0.08/branches/prefetch/t/inflate/datetime_mssql.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/inflate/datetime_mssql.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/inflate/datetime_mssql.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,85 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/};
+
+if (not ($dsn && $user)) {
+ plan skip_all =>
+ 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test' .
+ "\nWarning: This test drops and creates a table called 'track'";
+} else {
+ eval "use DateTime; use DateTime::Format::Strptime;";
+ if ($@) {
+ plan skip_all => 'needs DateTime and DateTime::Format::Strptime for testing';
+ }
+ else {
+ plan tests => 4 * 2; # (tests * dt_types)
+ }
+}
+
+my $schema = DBICTest::Schema->clone;
+
+$schema->connection($dsn, $user, $pass);
+$schema->storage->ensure_connected;
+
+# coltype, column, datehash
+my @dt_types = (
+ ['DATETIME',
+ 'last_updated_at',
+ {
+ year => 2004,
+ month => 8,
+ day => 21,
+ hour => 14,
+ minute => 36,
+ second => 48,
+ nanosecond => 500000000,
+ }],
+ ['SMALLDATETIME', # minute precision
+ 'small_dt',
+ {
+ year => 2004,
+ month => 8,
+ day => 21,
+ hour => 14,
+ minute => 36,
+ }],
+);
+
+for my $dt_type (@dt_types) {
+ my ($type, $col, $sample_dt) = @$dt_type;
+
+ eval { $schema->storage->dbh->do("DROP TABLE track") };
+ $schema->storage->dbh->do(<<"SQL");
+CREATE TABLE track (
+ trackid INT IDENTITY PRIMARY KEY,
+ cd INT,
+ position INT,
+ $col $type,
+)
+SQL
+ ok(my $dt = DateTime->new($sample_dt));
+
+ my $row;
+ ok( $row = $schema->resultset('Track')->create({
+ $col => $dt,
+ cd => 1,
+ }));
+ ok( $row = $schema->resultset('Track')
+ ->search({ trackid => $row->trackid }, { select => [$col] })
+ ->first
+ );
+ is( $row->$col, $dt, 'DateTime roundtrip' );
+}
+
+# clean up our mess
+END {
+ if (my $dbh = eval { $schema->storage->_dbh }) {
+ $dbh->do('DROP TABLE track');
+ }
+}
Copied: DBIx-Class/0.08/branches/prefetch/t/inflate/datetime_oracle.t (from rev 6764, DBIx-Class/0.08/branches/prefetch/t/73oracle_inflate.t)
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/inflate/datetime_oracle.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/inflate/datetime_oracle.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,103 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_ORA_${_}" } qw/DSN USER PASS/};
+
+if (not ($dsn && $user && $pass)) {
+ plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test. ' .
+ 'Warning: This test drops and creates a table called \'track\'';
+}
+else {
+ eval "use DateTime; use DateTime::Format::Oracle;";
+ if ($@) {
+ plan skip_all => 'needs DateTime and DateTime::Format::Oracle for testing';
+ }
+ else {
+ plan tests => 10;
+ }
+}
+
+# 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);
+
+# Need to redefine the last_updated_on column
+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, last_updated_at TIMESTAMP, small_dt DATE)");
+
+# 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', last_updated_at => '2009-05-03 21:17:18.5' });
+is($new->trackid, 1, "insert sucessful");
+
+my $track = $schema->resultset('Track')->find( 1 );
+
+is( ref($track->last_updated_on), 'DateTime', "last_updated_on inflated ok");
+
+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");
+
+# test datetime_setup
+
+$schema->storage->disconnect;
+
+delete $ENV{NLS_DATE_FORMAT};
+delete $ENV{NLS_TIMESTAMP_FORMAT};
+
+$schema->connection($dsn, $user, $pass, {
+ on_connect_call => 'datetime_setup'
+});
+
+$dt = DateTime->now();
+
+my $timestamp = $dt->clone;
+$timestamp->set_nanosecond( int 500_000_000 );
+
+$track = $schema->resultset('Track')->find( 1 );
+$track->update({ last_updated_on => $dt, last_updated_at => $timestamp });
+
+$track = $schema->resultset('Track')->find(1);
+
+is( $track->last_updated_on, $dt, 'DateTime round-trip as DATE' );
+is( $track->last_updated_at, $timestamp, 'DateTime round-trip as TIMESTAMP' );
+
+is( int $track->last_updated_at->nanosecond, int 500_000_000,
+ 'TIMESTAMP nanoseconds survived' );
+
+# clean up our mess
+END {
+ if($schema && ($dbh = $schema->storage->dbh)) {
+ $dbh->do("DROP TABLE track");
+ }
+}
+
Modified: DBIx-Class/0.08/branches/prefetch/t/inflate/datetime_pg.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/inflate/datetime_pg.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/inflate/datetime_pg.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -13,7 +13,7 @@
eval { require DateTime::Format::Pg };
plan $@
? ( skip_all => 'Need DateTime::Format::Pg for timestamp inflation tests')
- : ( tests => 3 )
+ : ( tests => 6 )
;
@@ -27,4 +27,14 @@
is($event->created_on->time_zone->name, "America/Chicago", "Timezone changed");
# Time zone difference -> -6hours
is($event->created_on->iso8601, "2009-01-15T11:00:00", "Time with TZ correct");
+
+# test 'timestamp without time zone'
+ my $dt = DateTime->from_epoch(epoch => time);
+ $dt->set_nanosecond(int 500_000_000);
+ $event->update({ts_without_tz => $dt});
+ $event->discard_changes;
+ isa_ok($event->ts_without_tz, "DateTime") or diag $event->created_on;
+ is($event->ts_without_tz, $dt, 'timestamp without time zone inflation');
+ is($event->ts_without_tz->microsecond, $dt->microsecond,
+ 'timestamp without time zone microseconds survived');
}
Modified: DBIx-Class/0.08/branches/prefetch/t/inflate/serialize.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/inflate/serialize.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/inflate/serialize.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -10,13 +10,13 @@
use Data::Dumper;
my @serializers = (
- { module => 'YAML.pm',
- inflater => sub { YAML::Load (shift) },
- deflater => sub { die "Expecting a reference" unless (ref $_[0]); YAML::Dump (shift) },
+ { module => 'YAML.pm',
+ inflater => sub { YAML::Load (shift) },
+ deflater => sub { die "Expecting a reference" unless (ref $_[0]); YAML::Dump (shift) },
},
- { module => 'Storable.pm',
- inflater => sub { Storable::thaw (shift) },
- deflater => sub { die "Expecting a reference" unless (ref $_[0]); Storable::nfreeze (shift) },
+ { module => 'Storable.pm',
+ inflater => sub { Storable::thaw (shift) },
+ deflater => sub { die "Expecting a reference" unless (ref $_[0]); Storable::nfreeze (shift) },
},
);
@@ -25,14 +25,13 @@
foreach my $serializer (@serializers) {
eval { require $serializer->{module} };
unless ($@) {
- $selected = $serializer;
- last;
+ $selected = $serializer;
+ last;
}
}
plan (skip_all => "No suitable serializer found") unless $selected;
-plan (tests => 11);
DBICTest::Schema::Serialized->inflate_column( 'serialized',
{ inflate => $selected->{inflater},
deflate => $selected->{deflater},
@@ -42,17 +41,17 @@
my $struct_hash = {
a => 1,
- b => [
+ b => [
{ c => 2 },
],
d => 3,
};
my $struct_array = [
- 'a',
- {
- b => 1,
- c => 2
+ 'a',
+ {
+ b => 1,
+ c => 2,
},
'd',
];
@@ -63,7 +62,6 @@
#======= testing hashref serialization
my $object = $rs->create( {
- id => 1,
serialized => '',
} );
ok($object->update( { serialized => $struct_hash } ), 'hashref deflation');
@@ -71,13 +69,19 @@
is_deeply($inflated, $struct_hash, 'inflated hash matches original');
$object = $rs->create( {
- id => 2,
serialized => '',
} );
-eval { $object->set_inflated_column('serialized', $struct_hash) };
-ok(!$@, 'set_inflated_column to a hashref');
+$object->set_inflated_column('serialized', $struct_hash);
is_deeply($object->serialized, $struct_hash, 'inflated hash matches original');
+$object = $rs->new({});
+$object->serialized ($struct_hash);
+$object->insert;
+is_deeply (
+ $rs->find ({id => $object->id})->serialized,
+ $struct_hash,
+ 'new/insert works',
+);
#====== testing arrayref serialization
@@ -85,8 +89,16 @@
ok($inflated = $object->serialized, 'arrayref inflation');
is_deeply($inflated, $struct_array, 'inflated array matches original');
+$object = $rs->new({});
+$object->serialized ($struct_array);
+$object->insert;
+is_deeply (
+ $rs->find ({id => $object->id})->serialized,
+ $struct_array,
+ 'new/insert works',
+);
-#===== make sure make_column_dirty ineracts reasonably with inflation
+#===== make sure make_column_dirty interacts reasonably with inflation
$object = $rs->first;
$object->update ({serialized => { x => 'y'}});
@@ -98,3 +110,5 @@
$object->update;
is_deeply ($rs->first->serialized, { x => 'z' }, 'changes made it to the db' );
+
+done_testing;
Modified: DBIx-Class/0.08/branches/prefetch/t/lib/DBIC/SqlMakerTest.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBIC/SqlMakerTest.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBIC/SqlMakerTest.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -41,7 +41,8 @@
croak "Unexpected argument(s) supplied to is_same_sql_bind: " . join ('; ', @_)
if @_;
- SQL::Abstract::Test::is_same_sql_bind (@args);
+ @_ = @args;
+ goto &SQL::Abstract::Test::is_same_sql_bind;
}
*is_same_sql = \&SQL::Abstract::Test::is_same_sql;
Added: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/ArtistGUID.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/ArtistGUID.pm (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/ArtistGUID.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,35 @@
+package # hide from PAUSE
+ DBICTest::Schema::ArtistGUID;
+
+use base qw/DBICTest::BaseResult/;
+
+# test MSSQL uniqueidentifier type
+
+__PACKAGE__->table('artist');
+__PACKAGE__->add_columns(
+ 'artistid' => {
+ data_type => 'uniqueidentifier' # auto_nextval not necessary for PK
+ },
+ 'name' => {
+ data_type => 'varchar',
+ size => 100,
+ is_nullable => 1,
+ },
+ rank => {
+ data_type => 'integer',
+ default_value => 13,
+ },
+ charfield => {
+ data_type => 'char',
+ size => 10,
+ is_nullable => 1,
+ },
+ a_guid => {
+ data_type => 'uniqueidentifier',
+ auto_nextval => 1, # necessary here, because not a PK
+ is_nullable => 1,
+ }
+);
+__PACKAGE__->set_primary_key('artistid');
+
+1;
Modified: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/ArtistUndirectedMap.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/ArtistUndirectedMap.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/ArtistUndirectedMap.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -11,7 +11,7 @@
__PACKAGE__->set_primary_key(qw/id1 id2/);
__PACKAGE__->belongs_to( 'artist1', 'DBICTest::Schema::Artist', 'id1', { on_delete => 'RESTRICT', on_update => 'CASCADE'} );
-__PACKAGE__->belongs_to( 'artist2', 'DBICTest::Schema::Artist', 'id2', { on_delete => undef, on_update => 'CASCADE'} );
+__PACKAGE__->belongs_to( 'artist2', 'DBICTest::Schema::Artist', 'id2', { on_delete => undef, on_update => undef} );
__PACKAGE__->has_many(
'mapped_artists', 'DBICTest::Schema::Artist',
[ {'foreign.artistid' => 'self.id1'}, {'foreign.artistid' => 'self.id2'} ],
Modified: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Artwork.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Artwork.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Artwork.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -7,6 +7,7 @@
__PACKAGE__->add_columns(
'cd_id' => {
data_type => 'integer',
+ is_nullable => 0,
},
);
__PACKAGE__->set_primary_key('cd_id');
Modified: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Bookmark.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Bookmark.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Bookmark.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -15,6 +15,7 @@
},
'link' => {
data_type => 'integer',
+ is_nullable => 1,
},
);
Modified: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/CD.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/CD.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/CD.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -3,7 +3,10 @@
use base qw/DBICTest::BaseResult/;
-__PACKAGE__->table('cd');
+# this tests table name as scalar ref
+# DO NOT REMOVE THE \
+__PACKAGE__->table(\'cd');
+
__PACKAGE__->add_columns(
'cdid' => {
data_type => 'integer',
@@ -56,6 +59,7 @@
{ proxy => [ qw/notes/ ] },
);
__PACKAGE__->might_have(artwork => 'DBICTest::Schema::Artwork', 'cd_id');
+__PACKAGE__->has_one(mandatory_artwork => 'DBICTest::Schema::Artwork', 'cd_id');
__PACKAGE__->many_to_many( producers => cd_to_producer => 'producer' );
__PACKAGE__->many_to_many(
Added: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/CustomSql.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/CustomSql.pm (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/CustomSql.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,17 @@
+package # hide from PAUSE
+ DBICTest::Schema::CustomSql;
+
+use base qw/DBICTest::Schema::Artist/;
+
+__PACKAGE__->table('dummy');
+
+__PACKAGE__->result_source_instance->name(\<<SQL);
+ ( 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 = ?)
+SQL
+
+sub sqlt_deploy_hook { $_[1]->schema->drop_table($_[1]) }
+
+1;
Property changes on: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/CustomSql.pm
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Event.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Event.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Event.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -15,6 +15,7 @@
varchar_date => { data_type => 'varchar', inflate_date => 1, size => 20, is_nullable => 1 },
varchar_datetime => { data_type => 'varchar', inflate_datetime => 1, size => 20, is_nullable => 1 },
skip_inflation => { data_type => 'datetime', inflate_datetime => 0, is_nullable => 1 },
+ ts_without_tz => { data_type => 'datetime', is_nullable => 1 }, # used in EventTZPg
);
__PACKAGE__->set_primary_key('id');
Modified: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/EventTZPg.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/EventTZPg.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/EventTZPg.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -12,6 +12,7 @@
id => { data_type => 'integer', is_auto_increment => 1 },
starts_at => { data_type => 'datetime', timezone => "America/Chicago", locale => 'de_DE' },
created_on => { data_type => 'timestamp with time zone', timezone => "America/Chicago" },
+ ts_without_tz => { data_type => 'timestamp without time zone' },
);
__PACKAGE__->set_primary_key('id');
Modified: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Genre.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Genre.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Genre.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -20,4 +20,6 @@
__PACKAGE__->has_many (cds => 'DBICTest::Schema::CD', 'genreid');
+__PACKAGE__->has_one (model_cd => 'DBICTest::Schema::CD', 'genreid');
+
1;
Added: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Money.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Money.pm (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Money.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,21 @@
+package # hide from PAUSE
+ DBICTest::Schema::Money;
+
+use base qw/DBICTest::BaseResult/;
+
+__PACKAGE__->table('money_test');
+
+__PACKAGE__->add_columns(
+ 'id' => {
+ data_type => 'integer',
+ is_auto_increment => 1,
+ },
+ 'amount' => {
+ data_type => 'money',
+ is_nullable => 1,
+ },
+);
+
+__PACKAGE__->set_primary_key('id');
+
+1;
Modified: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Serialized.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Serialized.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Serialized.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -5,7 +5,7 @@
__PACKAGE__->table('serialized');
__PACKAGE__->add_columns(
- 'id' => { data_type => 'integer' },
+ 'id' => { data_type => 'integer', is_auto_increment => 1 },
'serialized' => { data_type => 'text' },
);
__PACKAGE__->set_primary_key('id');
Modified: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Track.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Track.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Track.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -30,6 +30,10 @@
data_type => 'datetime',
is_nullable => 1
},
+ small_dt => { # for mssql and sybase DT tests
+ data_type => 'smalldatetime',
+ is_nullable => 1
+ },
);
__PACKAGE__->set_primary_key('trackid');
Modified: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Year1999CDs.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Year1999CDs.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Year1999CDs.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -3,7 +3,6 @@
## Used in 104view.t
use base qw/DBICTest::BaseResult/;
-use DBIx::Class::ResultSource::View;
__PACKAGE__->table_class('DBIx::Class::ResultSource::View');
Modified: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Year2000CDs.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Year2000CDs.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema/Year2000CDs.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -3,7 +3,6 @@
## Used in 104view.t
use base qw/DBICTest::BaseResult/;
-use DBIx::Class::ResultSource::View;
__PACKAGE__->table_class('DBIx::Class::ResultSource::View');
Modified: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest/Schema.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -20,6 +20,8 @@
Tag
Year2000CDs
Year1999CDs
+ CustomSql
+ Money
/,
{ 'DBICTest::Schema' => [qw/
LinerNotes
Modified: DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest.pm
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest.pm 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/DBICTest.pm 2009-08-21 09:22:51 UTC (rev 7359)
@@ -135,7 +135,7 @@
close IN;
for my $chunk ( split (/;\s*\n+/, $sql) ) {
if ( $chunk =~ / ^ (?! --\s* ) \S /xm ) { # there is some real sql in the chunk - a non-space at the start of the string which is not a comment
- $schema->storage->dbh->do($chunk) or print "Error on SQL: $chunk\n";
+ $schema->storage->dbh_do(sub { $_[1]->do($chunk) }) or print "Error on SQL: $chunk\n";
}
}
}
Modified: DBIx-Class/0.08/branches/prefetch/t/lib/sqlite.sql
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/lib/sqlite.sql 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/lib/sqlite.sql 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,6 +1,6 @@
--
-- Created by SQL::Translator::Producer::SQLite
--- Created on Thu May 28 10:10:00 2009
+-- Created on Thu Aug 20 07:47:13 2009
--
@@ -16,42 +16,9 @@
charfield char(10)
);
---
--- Table: artist_undirected_map
---
-CREATE TABLE artist_undirected_map (
- id1 integer NOT NULL,
- id2 integer NOT NULL,
- PRIMARY KEY (id1, id2)
-);
+CREATE INDEX artist_name_hookidx ON artist (name);
-CREATE INDEX artist_undirected_map_idx_id1_ ON artist_undirected_map (id1);
-
-CREATE INDEX artist_undirected_map_idx_id2_ ON artist_undirected_map (id2);
-
--
--- Table: cd_artwork
---
-CREATE TABLE cd_artwork (
- cd_id INTEGER PRIMARY KEY NOT NULL
-);
-
-CREATE INDEX cd_artwork_idx_cd_id_cd_artwor ON cd_artwork (cd_id);
-
---
--- Table: artwork_to_artist
---
-CREATE TABLE artwork_to_artist (
- artwork_cd_id integer NOT NULL,
- artist_id integer NOT NULL,
- PRIMARY KEY (artwork_cd_id, artist_id)
-);
-
-CREATE INDEX artwork_to_artist_idx_artist_id_artwork_to_arti ON artwork_to_artist (artist_id);
-
-CREATE INDEX artwork_to_artist_idx_artwork_cd_id_artwork_to_ ON artwork_to_artist (artwork_cd_id);
-
---
-- Table: bindtype_test
--
CREATE TABLE bindtype_test (
@@ -62,63 +29,6 @@
);
--
--- Table: bookmark
---
-CREATE TABLE bookmark (
- id INTEGER PRIMARY KEY NOT NULL,
- link integer NOT NULL
-);
-
-CREATE INDEX bookmark_idx_link_bookmark ON bookmark (link);
-
---
--- Table: books
---
-CREATE TABLE books (
- id INTEGER PRIMARY KEY NOT NULL,
- source varchar(100) NOT NULL,
- owner integer NOT NULL,
- title varchar(100) NOT NULL,
- price integer
-);
-
-CREATE INDEX books_idx_owner_books ON books (owner);
-
---
--- Table: cd
---
-CREATE TABLE cd (
- cdid INTEGER PRIMARY KEY NOT NULL,
- artist integer NOT NULL,
- title varchar(100) NOT NULL,
- year varchar(100) NOT NULL,
- genreid integer,
- single_track integer
-);
-
-CREATE INDEX cd_idx_artist_cd ON cd (artist);
-
-CREATE INDEX cd_idx_genreid_cd ON cd (genreid);
-
-CREATE INDEX cd_idx_single_track_cd ON cd (single_track);
-
-CREATE UNIQUE INDEX cd_artist_title_cd ON cd (artist, title);
-
---
--- Table: cd_to_producer
---
-CREATE TABLE cd_to_producer (
- cd integer NOT NULL,
- producer integer NOT NULL,
- attribute integer,
- PRIMARY KEY (cd, producer)
-);
-
-CREATE INDEX cd_to_producer_idx_cd_cd_to_pr ON cd_to_producer (cd);
-
-CREATE INDEX cd_to_producer_idx_producer_cd ON cd_to_producer (producer);
-
---
-- Table: collection
--
CREATE TABLE collection (
@@ -127,19 +37,6 @@
);
--
--- Table: collection_object
---
-CREATE TABLE collection_object (
- collection integer NOT NULL,
- object integer NOT NULL,
- PRIMARY KEY (collection, object)
-);
-
-CREATE INDEX collection_object_idx_collection_collection_obj ON collection_object (collection);
-
-CREATE INDEX collection_object_idx_object_c ON collection_object (object);
-
---
-- Table: employee
--
CREATE TABLE employee (
@@ -168,7 +65,8 @@
created_on timestamp NOT NULL,
varchar_date varchar(20),
varchar_datetime varchar(20),
- skip_inflation datetime
+ skip_inflation datetime,
+ ts_without_tz datetime
);
--
@@ -180,16 +78,6 @@
);
--
--- Table: forceforeign
---
-CREATE TABLE forceforeign (
- artist INTEGER PRIMARY KEY NOT NULL,
- cd integer NOT NULL
-);
-
-CREATE INDEX forceforeign_idx_artist_forcef ON forceforeign (artist);
-
---
-- Table: fourkeys
--
CREATE TABLE fourkeys (
@@ -203,25 +91,6 @@
);
--
--- Table: fourkeys_to_twokeys
---
-CREATE TABLE fourkeys_to_twokeys (
- f_foo integer NOT NULL,
- f_bar integer NOT NULL,
- f_hello integer NOT NULL,
- f_goodbye integer NOT NULL,
- t_artist integer NOT NULL,
- t_cd integer NOT NULL,
- autopilot character NOT NULL,
- pilot_sequence integer,
- PRIMARY KEY (f_foo, f_bar, f_hello, f_goodbye, t_artist, t_cd)
-);
-
-CREATE INDEX fourkeys_to_twokeys_idx_f_foo_f_bar_f_hello_f_goodbye_ ON fourkeys_to_twokeys (f_foo, f_bar, f_hello, f_goodbye);
-
-CREATE INDEX fourkeys_to_twokeys_idx_t_artist_t_cd_fourkeys_to ON fourkeys_to_twokeys (t_artist, t_cd);
-
---
-- Table: genre
--
CREATE TABLE genre (
@@ -229,31 +98,9 @@
name varchar(100) NOT NULL
);
-CREATE UNIQUE INDEX genre_name_genre ON genre (name);
+CREATE UNIQUE INDEX genre_name ON genre (name);
--
--- Table: images
---
-CREATE TABLE images (
- id INTEGER PRIMARY KEY NOT NULL,
- artwork_id integer NOT NULL,
- name varchar(100) NOT NULL,
- data blob
-);
-
-CREATE INDEX images_idx_artwork_id_images ON images (artwork_id);
-
---
--- Table: liner_notes
---
-CREATE TABLE liner_notes (
- liner_id INTEGER PRIMARY KEY NOT NULL,
- notes varchar(100) NOT NULL
-);
-
-CREATE INDEX liner_notes_idx_liner_id_liner ON liner_notes (liner_id);
-
---
-- Table: link
--
CREATE TABLE link (
@@ -263,27 +110,14 @@
);
--
--- Table: lyric_versions
+-- Table: money_test
--
-CREATE TABLE lyric_versions (
+CREATE TABLE money_test (
id INTEGER PRIMARY KEY NOT NULL,
- lyric_id integer NOT NULL,
- text varchar(100) NOT NULL
+ amount money
);
-CREATE INDEX lyric_versions_idx_lyric_id_ly ON lyric_versions (lyric_id);
-
--
--- Table: lyrics
---
-CREATE TABLE lyrics (
- lyric_id INTEGER PRIMARY KEY NOT NULL,
- track_id integer NOT NULL
-);
-
-CREATE INDEX lyrics_idx_track_id_lyrics ON lyrics (track_id);
-
---
-- Table: noprimarykey
--
CREATE TABLE noprimarykey (
@@ -292,7 +126,7 @@
baz integer NOT NULL
);
-CREATE UNIQUE INDEX foo_bar_noprimarykey ON noprimarykey (foo, bar);
+CREATE UNIQUE INDEX foo_bar ON noprimarykey (foo, bar);
--
-- Table: onekey
@@ -319,7 +153,7 @@
name varchar(100) NOT NULL
);
-CREATE UNIQUE INDEX prod_name_producer ON producer (name);
+CREATE UNIQUE INDEX prod_name ON producer (name);
--
-- Table: self_ref
@@ -330,19 +164,6 @@
);
--
--- Table: self_ref_alias
---
-CREATE TABLE self_ref_alias (
- self_ref integer NOT NULL,
- alias integer NOT NULL,
- PRIMARY KEY (self_ref, alias)
-);
-
-CREATE INDEX self_ref_alias_idx_alias_self_ ON self_ref_alias (alias);
-
-CREATE INDEX self_ref_alias_idx_self_ref_se ON self_ref_alias (self_ref);
-
---
-- Table: sequence_test
--
CREATE TABLE sequence_test (
@@ -362,17 +183,101 @@
);
--
--- Table: tags
+-- Table: treelike
--
-CREATE TABLE tags (
- tagid INTEGER PRIMARY KEY NOT NULL,
- cd integer NOT NULL,
- tag varchar(100) NOT NULL
+CREATE TABLE treelike (
+ id INTEGER PRIMARY KEY NOT NULL,
+ parent integer,
+ name varchar(100) NOT NULL
);
-CREATE INDEX tags_idx_cd_tags ON tags (cd);
+CREATE INDEX treelike_idx_parent ON treelike (parent);
--
+-- Table: twokeytreelike
+--
+CREATE TABLE twokeytreelike (
+ id1 integer NOT NULL,
+ id2 integer NOT NULL,
+ parent1 integer NOT NULL,
+ parent2 integer NOT NULL,
+ name varchar(100) NOT NULL,
+ PRIMARY KEY (id1, id2)
+);
+
+CREATE INDEX twokeytreelike_idx_parent1_parent2 ON twokeytreelike (parent1, parent2);
+
+CREATE UNIQUE INDEX tktlnameunique ON twokeytreelike (name);
+
+--
+-- Table: typed_object
+--
+CREATE TABLE typed_object (
+ objectid INTEGER PRIMARY KEY NOT NULL,
+ type varchar(100) NOT NULL,
+ value varchar(100) NOT NULL
+);
+
+--
+-- Table: artist_undirected_map
+--
+CREATE TABLE artist_undirected_map (
+ id1 integer NOT NULL,
+ id2 integer NOT NULL,
+ PRIMARY KEY (id1, id2)
+);
+
+CREATE INDEX artist_undirected_map_idx_id1 ON artist_undirected_map (id1);
+
+CREATE INDEX artist_undirected_map_idx_id2 ON artist_undirected_map (id2);
+
+--
+-- Table: bookmark
+--
+CREATE TABLE bookmark (
+ id INTEGER PRIMARY KEY NOT NULL,
+ link integer
+);
+
+CREATE INDEX bookmark_idx_link ON bookmark (link);
+
+--
+-- Table: books
+--
+CREATE TABLE books (
+ id INTEGER PRIMARY KEY NOT NULL,
+ source varchar(100) NOT NULL,
+ owner integer NOT NULL,
+ title varchar(100) NOT NULL,
+ price integer
+);
+
+CREATE INDEX books_idx_owner ON books (owner);
+
+--
+-- Table: forceforeign
+--
+CREATE TABLE forceforeign (
+ artist INTEGER PRIMARY KEY NOT NULL,
+ cd integer NOT NULL
+);
+
+CREATE INDEX forceforeign_idx_artist ON forceforeign (artist);
+
+--
+-- Table: self_ref_alias
+--
+CREATE TABLE self_ref_alias (
+ self_ref integer NOT NULL,
+ alias integer NOT NULL,
+ PRIMARY KEY (self_ref, alias)
+);
+
+CREATE INDEX self_ref_alias_idx_alias ON self_ref_alias (alias);
+
+CREATE INDEX self_ref_alias_idx_self_ref ON self_ref_alias (self_ref);
+
+--
-- Table: track
--
CREATE TABLE track (
@@ -381,43 +286,127 @@
position integer NOT NULL,
title varchar(100) NOT NULL,
last_updated_on datetime,
- last_updated_at datetime
+ last_updated_at datetime,
+ small_dt smalldatetime
);
-CREATE INDEX track_idx_cd_track ON track (cd);
+CREATE INDEX track_idx_cd ON track (cd);
-CREATE UNIQUE INDEX track_cd_position_track ON track (cd, position);
+CREATE UNIQUE INDEX track_cd_position ON track (cd, position);
-CREATE UNIQUE INDEX track_cd_title_track ON track (cd, title);
+CREATE UNIQUE INDEX track_cd_title ON track (cd, title);
--
--- Table: treelike
+-- Table: cd
--
-CREATE TABLE treelike (
+CREATE TABLE cd (
+ cdid INTEGER PRIMARY KEY NOT NULL,
+ artist integer NOT NULL,
+ title varchar(100) NOT NULL,
+ year varchar(100) NOT NULL,
+ genreid integer,
+ single_track integer
+);
+
+CREATE INDEX cd_idx_artist ON cd (artist);
+
+CREATE INDEX cd_idx_genreid ON cd (genreid);
+
+CREATE INDEX cd_idx_single_track ON cd (single_track);
+
+CREATE UNIQUE INDEX cd_artist_title ON cd (artist, title);
+
+--
+-- Table: collection_object
+--
+CREATE TABLE collection_object (
+ collection integer NOT NULL,
+ object integer NOT NULL,
+ PRIMARY KEY (collection, object)
+);
+
+CREATE INDEX collection_object_idx_collection ON collection_object (collection);
+
+CREATE INDEX collection_object_idx_object ON collection_object (object);
+
+--
+-- Table: lyrics
+--
+CREATE TABLE lyrics (
+ lyric_id INTEGER PRIMARY KEY NOT NULL,
+ track_id integer NOT NULL
+);
+
+CREATE INDEX lyrics_idx_track_id ON lyrics (track_id);
+
+--
+-- Table: cd_artwork
+--
+CREATE TABLE cd_artwork (
+ cd_id INTEGER PRIMARY KEY NOT NULL
+);
+
+CREATE INDEX cd_artwork_idx_cd_id ON cd_artwork (cd_id);
+
+--
+-- Table: liner_notes
+--
+CREATE TABLE liner_notes (
+ liner_id INTEGER PRIMARY KEY NOT NULL,
+ notes varchar(100) NOT NULL
+);
+
+CREATE INDEX liner_notes_idx_liner_id ON liner_notes (liner_id);
+
+--
+-- Table: lyric_versions
+--
+CREATE TABLE lyric_versions (
id INTEGER PRIMARY KEY NOT NULL,
- parent integer,
- name varchar(100) NOT NULL
+ lyric_id integer NOT NULL,
+ text varchar(100) NOT NULL
);
-CREATE INDEX treelike_idx_parent_treelike ON treelike (parent);
+CREATE INDEX lyric_versions_idx_lyric_id ON lyric_versions (lyric_id);
--
--- Table: twokeytreelike
+-- Table: tags
--
-CREATE TABLE twokeytreelike (
- id1 integer NOT NULL,
- id2 integer NOT NULL,
- parent1 integer NOT NULL,
- parent2 integer NOT NULL,
- name varchar(100) NOT NULL,
- PRIMARY KEY (id1, id2)
+CREATE TABLE tags (
+ tagid INTEGER PRIMARY KEY NOT NULL,
+ cd integer NOT NULL,
+ tag varchar(100) NOT NULL
);
-CREATE INDEX twokeytreelike_idx_parent1_parent2_twokeytre ON twokeytreelike (parent1, parent2);
+CREATE INDEX tags_idx_cd ON tags (cd);
-CREATE UNIQUE INDEX tktlnameunique_twokeytreelike ON twokeytreelike (name);
+--
+-- Table: cd_to_producer
+--
+CREATE TABLE cd_to_producer (
+ cd integer NOT NULL,
+ producer integer NOT NULL,
+ attribute integer,
+ PRIMARY KEY (cd, producer)
+);
+CREATE INDEX cd_to_producer_idx_cd ON cd_to_producer (cd);
+
+CREATE INDEX cd_to_producer_idx_producer ON cd_to_producer (producer);
+
--
+-- Table: images
+--
+CREATE TABLE images (
+ id INTEGER PRIMARY KEY NOT NULL,
+ artwork_id integer NOT NULL,
+ name varchar(100) NOT NULL,
+ data blob
+);
+
+CREATE INDEX images_idx_artwork_id ON images (artwork_id);
+
+--
-- Table: twokeys
--
CREATE TABLE twokeys (
@@ -426,18 +415,41 @@
PRIMARY KEY (artist, cd)
);
-CREATE INDEX twokeys_idx_artist_twokeys ON twokeys (artist);
+CREATE INDEX twokeys_idx_artist ON twokeys (artist);
--
--- Table: typed_object
+-- Table: artwork_to_artist
--
-CREATE TABLE typed_object (
- objectid INTEGER PRIMARY KEY NOT NULL,
- type varchar(100) NOT NULL,
- value varchar(100) NOT NULL
+CREATE TABLE artwork_to_artist (
+ artwork_cd_id integer NOT NULL,
+ artist_id integer NOT NULL,
+ PRIMARY KEY (artwork_cd_id, artist_id)
);
+CREATE INDEX artwork_to_artist_idx_artist_id ON artwork_to_artist (artist_id);
+
+CREATE INDEX artwork_to_artist_idx_artwork_cd_id ON artwork_to_artist (artwork_cd_id);
+
--
+-- Table: fourkeys_to_twokeys
+--
+CREATE TABLE fourkeys_to_twokeys (
+ f_foo integer NOT NULL,
+ f_bar integer NOT NULL,
+ f_hello integer NOT NULL,
+ f_goodbye integer NOT NULL,
+ t_artist integer NOT NULL,
+ t_cd integer NOT NULL,
+ autopilot character NOT NULL,
+ pilot_sequence integer,
+ PRIMARY KEY (f_foo, f_bar, f_hello, f_goodbye, t_artist, t_cd)
+);
+
+CREATE INDEX fourkeys_to_twokeys_idx_f_foo_f_bar_f_hello_f_goodbye ON fourkeys_to_twokeys (f_foo, f_bar, f_hello, f_goodbye);
+
+CREATE INDEX fourkeys_to_twokeys_idx_t_artist_t_cd ON fourkeys_to_twokeys (t_artist, t_cd);
+
+--
-- View: year2000cds
--
CREATE VIEW year2000cds AS
Added: DBIx-Class/0.08/branches/prefetch/t/multi_create/diamond.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/multi_create/diamond.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/multi_create/diamond.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,52 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+sub mc_diag { diag (@_) if $ENV{DBIC_MULTICREATE_DEBUG} };
+
+my $schema = DBICTest->init_schema();
+
+mc_diag (<<'DG');
+* Try a diamond multicreate
+
+Artist -> has_many -> Artwork_to_Artist -> belongs_to
+ /
+ belongs_to <- CD <- belongs_to <- Artwork <-/
+ \
+ \-> Artist2
+
+DG
+
+lives_ok (sub {
+ $schema->resultset ('Artist')->create ({
+ name => 'The wooled wolf',
+ artwork_to_artist => [{
+ artwork => {
+ cd => {
+ title => 'Wool explosive',
+ year => 1999,
+ artist => { name => 'The black exploding sheep' },
+ }
+ }
+ }],
+ });
+
+ my $art2 = $schema->resultset ('Artist')->find ({ name => 'The black exploding sheep' });
+ ok ($art2, 'Second artist exists');
+
+ my $cd = $art2->cds->single;
+ is ($cd->title, 'Wool explosive', 'correctly created CD');
+
+ is_deeply (
+ [ $cd->artwork->artists->get_column ('name')->all ],
+ [ 'The wooled wolf' ],
+ 'Artist correctly attached to artwork',
+ );
+
+}, 'Diamond chain creation ok');
+
+done_testing;
Property changes on: DBIx-Class/0.08/branches/prefetch/t/multi_create/diamond.t
___________________________________________________________________
Name: svn:eol-style
+ native
Added: DBIx-Class/0.08/branches/prefetch/t/multi_create/existing_in_chain.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/multi_create/existing_in_chain.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/multi_create/existing_in_chain.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,105 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+# For fully intuitive multicreate any relationships in a chain
+# that do not exist for one reason or another should be created,
+# even if the preceeding relationship already exists.
+#
+# To get this to work a minor rewrite of find() is necessary, and
+# more importantly some sort of recursive_insert() call needs to
+# be available. The way things will work then is:
+# *) while traversing the hierarchy code calls find_or_create()
+# *) this in turn calls find(%\nested_dataset)
+# *) this should return not only the existing object, but must
+# also attach all non-existing (in fact maybe existing) related
+# bits of data to it, with in_storage => 0
+# *) then before returning the result of the succesful find(), we
+# simply call $obj->recursive_insert and all is dandy
+#
+# Since this will not be a very clean solution, todoifying for the
+# time being until an actual need arises
+#
+# ribasushi
+
+TODO: { my $f = __FILE__; local $TODO = "See comment at top of $f for discussion of the TODO";
+
+{
+ my $counts;
+ $counts->{$_} = $schema->resultset($_)->count for qw/Track CD Genre/;
+
+ lives_ok (sub {
+ my $existing_nogen_cd = $schema->resultset('CD')->search (
+ { 'genre.genreid' => undef },
+ { join => 'genre' },
+ )->first;
+
+ $schema->resultset('Track')->create ({
+ title => 'Sugar-coated',
+ cd => {
+ title => $existing_nogen_cd->title,
+ genre => {
+ name => 'sugar genre',
+ }
+ }
+ });
+
+ is ($schema->resultset('Track')->count, $counts->{Track} + 1, '1 new track');
+ is ($schema->resultset('CD')->count, $counts->{CD}, 'No new cds');
+ is ($schema->resultset('Genre')->count, $counts->{Genre} + 1, '1 new genre');
+
+ is ($existing_nogen_cd->genre->title, 'sugar genre', 'Correct genre assigned to CD');
+ }, 'create() did not throw');
+}
+{
+ my $counts;
+ $counts->{$_} = $schema->resultset($_)->count for qw/Artist CD Producer/;
+
+ lives_ok (sub {
+ my $artist = $schema->resultset('Artist')->first;
+ my $producer = $schema->resultset('Producer')->create ({ name => 'the queen of england' });
+
+ $schema->resultset('CD')->create ({
+ artist => $artist,
+ title => 'queen1',
+ year => 2007,
+ cd_to_producer => [
+ {
+ producer => {
+ name => $producer->name,
+ producer_to_cd => [
+ {
+ cd => {
+ title => 'queen2',
+ year => 2008,
+ artist => $artist,
+ },
+ },
+ ],
+ },
+ },
+ ],
+ });
+
+ is ($schema->resultset('Artist')->count, $counts->{Artist}, 'No new artists');
+ is ($schema->resultset('Producer')->count, $counts->{Producer} + 1, '1 new producers');
+ is ($schema->resultset('CD')->count, $counts->{CD} + 2, '2 new cds');
+
+ is ($producer->cds->count, 2, 'CDs assigned to correct producer');
+ is_deeply (
+ [ $producer->cds->search ({}, { order_by => 'title' })->get_column('title')->all],
+ [ qw/queen1 queen2/ ],
+ 'Correct cd names',
+ );
+ }, 'create() did not throw');
+}
+
+}
+
+done_testing;
Added: DBIx-Class/0.08/branches/prefetch/t/multi_create/has_many.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/multi_create/has_many.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/multi_create/has_many.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,33 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+plan tests => 2;
+
+my $schema = DBICTest->init_schema();
+
+my $track_no_lyrics = $schema->resultset ('Track')
+ ->search ({ 'lyrics.lyric_id' => undef }, { join => 'lyrics' })
+ ->first;
+
+my $lyric = $track_no_lyrics->create_related ('lyrics', {
+ lyric_versions => [
+ { text => 'english doubled' },
+ { text => 'english doubled' },
+ ],
+});
+is ($lyric->lyric_versions->count, 2, "Two identical has_many's created");
+
+
+my $link = $schema->resultset ('Link')->create ({
+ url => 'lolcats!',
+ bookmarks => [
+ {},
+ {},
+ ]
+});
+is ($link->bookmarks->count, 2, "Two identical default-insert has_many's created");
Copied: DBIx-Class/0.08/branches/prefetch/t/multi_create/in_memory.t (from rev 6764, DBIx-Class/0.08/branches/prefetch/t/96multi_create_new.t)
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/multi_create/in_memory.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/multi_create/in_memory.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,74 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+plan tests => 12;
+
+my $schema = DBICTest->init_schema();
+
+# Test various new() invocations - this is all about backcompat, making
+# sure that insert() still works as expected by legacy code.
+#
+# What we essentially do is multi-instantiate objects, making sure nothing
+# gets inserted. Then we add some more objects to the mix either via
+# new_related() or by setting an accessor directly (or both) - again
+# expecting no inserts. Then after calling insert() on the starter object
+# we expect everything supplied to new() to get inserted, as well as any
+# relations whose PK's are necessary to complete the objects supplied
+# to new(). All other objects should be insert()able afterwards too.
+
+
+{
+ my $new_artist = $schema->resultset("Artist")->new_result({ 'name' => 'Depeche Mode' });
+ my $new_related_cd = $new_artist->new_related('cds', { 'title' => 'Leave in Silence', 'year' => 1982});
+ eval {
+ $new_artist->insert;
+ $new_related_cd->insert;
+ };
+ is ($@, '', 'Staged insertion successful');
+ ok($new_artist->in_storage, 'artist inserted');
+ ok($new_related_cd->in_storage, 'new_related_cd inserted');
+}
+
+{
+ my $new_artist = $schema->resultset("Artist")->new_result({ 'name' => 'Depeche Mode' });
+ my $new_related_cd = $new_artist->new_related('cds', { 'title' => 'Leave Slightly Noisily', 'year' => 1982});
+ eval {
+ $new_related_cd->insert;
+ };
+ is ($@, '', 'CD insertion survives by finding artist');
+ ok($new_artist->in_storage, 'artist inserted');
+ ok($new_related_cd->in_storage, 'new_related_cd inserted');
+}
+
+{
+ my $new_artist = $schema->resultset("Artist")->new_result({ 'name' => 'Depeche Mode 2: Insertion Boogaloo' });
+ my $new_related_cd = $new_artist->new_related('cds', { 'title' => 'Leave Loudly While Singing Off Key', 'year' => 1982});
+ eval {
+ $new_related_cd->insert;
+ };
+ is ($@, '', 'CD insertion survives by inserting artist');
+ ok($new_artist->in_storage, 'artist inserted');
+ ok($new_related_cd->in_storage, 'new_related_cd inserted');
+}
+
+{
+ my $new_cd = $schema->resultset("CD")->new_result({});
+ my $new_related_artist = $new_cd->new_related('artist', { 'name' => 'Marillion',});
+ lives_ok (
+ sub {
+ $new_related_artist->insert;
+ $new_cd->title( 'Misplaced Childhood' );
+ $new_cd->year ( 1985 );
+ $new_cd->artist( $new_related_artist ); # For exact backward compatibility
+ $new_cd->insert;
+ },
+ 'Reversed staged insertion successful'
+ );
+ ok($new_related_artist->in_storage, 'related artist inserted');
+ ok($new_cd->in_storage, 'cd inserted');
+}
Modified: DBIx-Class/0.08/branches/prefetch/t/multi_create/m2m.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/multi_create/m2m.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/multi_create/m2m.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -23,7 +23,7 @@
my $cd2 = $schema->resultset('CD')->search ( { cdid => { '!=', $cd->cdid } }, {rows => 1} )->single; # retrieve a cd different from the first
$cd2->add_to_producers ({name => 'new m2m producer'}); # attach to an existing producer
- ok ($cd2->producers->find ({name => 'new m2m producer'}), 'Exsiting producer attached to existing cd');
+ ok ($cd2->producers->find ({name => 'new m2m producer'}), 'Existing producer attached to existing cd');
}, 'Test far-end find_or_create over many_to_many');
Deleted: DBIx-Class/0.08/branches/prefetch/t/multi_create/multilev_might_have_PKeqFK.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/multi_create/multilev_might_have_PKeqFK.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/multi_create/multilev_might_have_PKeqFK.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,65 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use Test::Exception;
-use lib qw(t/lib);
-use DBICTest;
-
-sub mc_diag { diag (@_) if $ENV{DBIC_MULTICREATE_DEBUG} };
-
-plan tests => 8;
-
-my $schema = DBICTest->init_schema();
-
-mc_diag (<<'DG');
-* Test a multilevel might-have with a PK == FK in the might_have/has_many table
-
-CD -> might have -> Artwork
- \
- \-> has_many \
- --> Artwork_to_Artist
- /-> has_many /
- /
- Artist
-DG
-
-lives_ok (sub {
- my $someartist = $schema->resultset('Artist')->first;
- my $cd = $schema->resultset('CD')->create ({
- artist => $someartist,
- title => 'Music to code by until the cows come home',
- year => 2008,
- artwork => {
- artwork_to_artist => [
- { artist => { name => 'cowboy joe' } },
- { artist => { name => 'billy the kid' } },
- ],
- },
- });
-
- isa_ok ($cd, 'DBICTest::CD', 'Main CD object created');
- is ($cd->title, 'Music to code by until the cows come home', 'Correct CD title');
-
- my $art_obj = $cd->artwork;
- ok ($art_obj->has_column_loaded ('cd_id'), 'PK/FK present on artwork object');
- is ($art_obj->artists->count, 2, 'Correct artwork creator count via the new object');
- is_deeply (
- [ sort $art_obj->artists->get_column ('name')->all ],
- [ 'billy the kid', 'cowboy joe' ],
- 'Artists named correctly when queried via object',
- );
-
- my $artwork = $schema->resultset('Artwork')->search (
- { 'cd.title' => 'Music to code by until the cows come home' },
- { join => 'cd' },
- )->single;
- is ($artwork->artists->count, 2, 'Correct artwork creator count via a new search');
- is_deeply (
- [ sort $artwork->artists->get_column ('name')->all ],
- [ 'billy the kid', 'cowboy joe' ],
- 'Artists named correctly queried via a new search',
- );
-}, 'multilevel might-have with a PK == FK in the might_have/has_many table ok');
-
-1;
Copied: DBIx-Class/0.08/branches/prefetch/t/multi_create/multilev_single_PKeqFK.t (from rev 6764, DBIx-Class/0.08/branches/prefetch/t/multi_create/multilev_might_have_PKeqFK.t)
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/multi_create/multilev_single_PKeqFK.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/multi_create/multilev_single_PKeqFK.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,103 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+sub mc_diag { diag (@_) if $ENV{DBIC_MULTICREATE_DEBUG} };
+
+my $schema = DBICTest->init_schema();
+
+mc_diag (<<'DG');
+* Test a multilevel might-have/has_one with a PK == FK in the mid-table
+
+CD -> might have -> Artwork
+ \- has_one -/ \
+ \
+ \-> has_many \
+ --> Artwork_to_Artist
+ /-> has_many /
+ /
+ Artist
+DG
+
+my $rels = {
+ has_one => 'mandatory_artwork',
+ might_have => 'artwork',
+};
+
+for my $type (qw/has_one might_have/) {
+
+ lives_ok (sub {
+
+ my $rel = $rels->{$type};
+ my $cd_title = "Simple test $type cd";
+
+ my $cd = $schema->resultset('CD')->create ({
+ artist => 1,
+ title => $cd_title,
+ year => 2008,
+ $rel => {},
+ });
+
+ isa_ok ($cd, 'DBICTest::CD', 'Main CD object created');
+ is ($cd->title, $cd_title, 'Correct CD title');
+
+ isa_ok ($cd->$rel, 'DBICTest::Artwork', 'Related artwork present');
+ ok ($cd->$rel->in_storage, 'And in storage');
+
+ }, "Simple $type creation");
+}
+
+my $artist_rs = $schema->resultset('Artist');
+for my $type (qw/has_one might_have/) {
+
+ my $rel = $rels->{$type};
+
+ my $cd_title = "Test $type cd";
+ my $artist_names = [ map { "Artist via $type $_" } (1, 2) ];
+
+ my $someartist = $artist_rs->next;
+
+ lives_ok (sub {
+ my $cd = $schema->resultset('CD')->create ({
+ artist => $someartist,
+ title => $cd_title,
+ year => 2008,
+ $rel => {
+ artwork_to_artist => [ map {
+ { artist => { name => $_ } }
+ } (@$artist_names)
+ ]
+ },
+ });
+
+
+ isa_ok ($cd, 'DBICTest::CD', 'Main CD object created');
+ is ($cd->title, $cd_title, 'Correct CD title');
+
+ my $art_obj = $cd->$rel;
+ ok ($art_obj->has_column_loaded ('cd_id'), 'PK/FK present on artwork object');
+ is ($art_obj->artists->count, 2, 'Correct artwork creator count via the new object');
+ is_deeply (
+ [ sort $art_obj->artists->get_column ('name')->all ],
+ $artist_names,
+ 'Artists named correctly when queried via object',
+ );
+
+ my $artwork = $schema->resultset('Artwork')->search (
+ { 'cd.title' => $cd_title },
+ { join => 'cd' },
+ )->single;
+ is ($artwork->artists->count, 2, 'Correct artwork creator count via a new search');
+ is_deeply (
+ [ sort $artwork->artists->get_column ('name')->all ],
+ $artist_names,
+ 'Artists named correctly queried via a new search',
+ );
+ }, "multilevel $type with a PK == FK in the $type/has_many table ok");
+}
+
+done_testing;
Copied: DBIx-Class/0.08/branches/prefetch/t/multi_create/standard.t (from rev 6764, DBIx-Class/0.08/branches/prefetch/t/96multi_create.t)
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/multi_create/standard.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/multi_create/standard.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,467 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+plan tests => 91;
+
+my $schema = DBICTest->init_schema();
+
+lives_ok ( sub {
+ my $cd = $schema->resultset('CD')->create({
+ artist => {
+ name => 'Fred Bloggs'
+ },
+ title => 'Some CD',
+ year => 1996
+ });
+
+ isa_ok($cd, 'DBICTest::CD', 'Created CD object');
+ isa_ok($cd->artist, 'DBICTest::Artist', 'Created related Artist');
+ is($cd->artist->name, 'Fred Bloggs', 'Artist created correctly');
+}, 'simple create + parent (the stuff $rs belongs_to) ok');
+
+lives_ok ( sub {
+ my $bm_rs = $schema->resultset('Bookmark');
+ my $bookmark = $bm_rs->create({
+ link => {
+ id => 66,
+ },
+ });
+
+ isa_ok($bookmark, 'DBICTest::Bookmark', 'Created Bookrmark object');
+ isa_ok($bookmark->link, 'DBICTest::Link', 'Created related Link');
+ is (
+ $bm_rs->search (
+ { 'link.title' => $bookmark->link->title },
+ { join => 'link' },
+ )->count,
+ 1,
+ 'Bookmark and link made it to the DB',
+ );
+}, 'simple create where the child and parent have no values, except for an explicit parent pk ok');
+
+lives_ok ( sub {
+ my $artist = $schema->resultset('Artist')->first;
+ my $cd = $artist->create_related (cds => {
+ title => 'Music to code by',
+ year => 2007,
+ tags => [
+ { 'tag' => 'rock' },
+ ],
+ });
+
+ isa_ok($cd, 'DBICTest::CD', 'Created CD');
+ is($cd->title, 'Music to code by', 'CD created correctly');
+ is($cd->tags->count, 1, 'One tag created for CD');
+ is($cd->tags->first->tag, 'rock', 'Tag created correctly');
+
+}, 'create over > 1 levels of has_many create (A => { has_many => { B => has_many => C } } )');
+
+throws_ok (
+ sub {
+ # Create via update - add a new CD <--- THIS SHOULD HAVE NEVER WORKED!
+ $schema->resultset('Artist')->first->update({
+ cds => [
+ { title => 'Yet another CD',
+ year => 2006,
+ },
+ ],
+ });
+ },
+ qr/Recursive update is not supported over relationships of type multi/,
+ 'create via update of multi relationships throws an exception'
+);
+
+lives_ok ( sub {
+ my $artist = $schema->resultset('Artist')->first;
+ my $c2p = $schema->resultset('CD_to_Producer')->create ({
+ cd => {
+ artist => $artist,
+ title => 'Bad investment',
+ year => 2008,
+ tracks => [
+ { title => 'Just buy' },
+ { title => 'Why did we do it' },
+ { title => 'Burn baby burn' },
+ ],
+ },
+ producer => {
+ name => 'Lehman Bros.',
+ },
+ });
+
+ isa_ok ($c2p, 'DBICTest::CD_to_Producer', 'Linker object created');
+ my $prod = $schema->resultset ('Producer')->find ({ name => 'Lehman Bros.' });
+ isa_ok ($prod, 'DBICTest::Producer', 'Producer row found');
+ is ($prod->cds->count, 1, 'Producer has one production');
+ my $cd = $prod->cds->first;
+ is ($cd->title, 'Bad investment', 'CD created correctly');
+ is ($cd->tracks->count, 3, 'CD has 3 tracks');
+}, 'Create m2m while originating in the linker table');
+
+
+#CD -> has_many -> Tracks -> might have -> Single -> has_many -> Tracks
+# \
+# \-> has_many \
+# --> CD2Producer
+# /-> has_many /
+# /
+# Producer
+lives_ok ( sub {
+ my $artist = $schema->resultset('Artist')->first;
+ my $cd = $schema->resultset('CD')->create ({
+ artist => $artist,
+ title => 'Music to code by at night',
+ year => 2008,
+ tracks => [
+ {
+ title => 'Off by one again',
+ },
+ {
+ title => 'The dereferencer',
+ cd_single => {
+ artist => $artist,
+ year => 2008,
+ title => 'Was that a null (Single)',
+ tracks => [
+ { title => 'The dereferencer' },
+ { title => 'The dereferencer II' },
+ ],
+ cd_to_producer => [
+ {
+ producer => {
+ name => 'K&R',
+ }
+ },
+ {
+ producer => {
+ name => 'Don Knuth',
+ }
+ },
+ ]
+ },
+ },
+ ],
+ });
+
+ isa_ok ($cd, 'DBICTest::CD', 'Main CD object created');
+ is ($cd->title, 'Music to code by at night', 'Correct CD title');
+ is ($cd->tracks->count, 2, 'Two tracks on main CD');
+
+ my ($t1, $t2) = $cd->tracks->all;
+ is ($t1->title, 'Off by one again', 'Correct 1st track name');
+ is ($t1->cd_single, undef, 'No single for 1st track');
+ is ($t2->title, 'The dereferencer', 'Correct 2nd track name');
+ isa_ok ($t2->cd_single, 'DBICTest::CD', 'Created a single for 2nd track');
+
+ my $single = $t2->cd_single;
+ is ($single->tracks->count, 2, 'Two tracks on single CD');
+ is ($single->tracks->find ({ position => 1})->title, 'The dereferencer', 'Correct 1st track title');
+ is ($single->tracks->find ({ position => 2})->title, 'The dereferencer II', 'Correct 2nd track title');
+
+ is ($single->cd_to_producer->count, 2, 'Two producers created for the single cd');
+ is_deeply (
+ [ sort map { $_->producer->name } ($single->cd_to_producer->all) ],
+ ['Don Knuth', 'K&R'],
+ 'Producers named correctly',
+ );
+}, 'Create over > 1 levels of might_have with multiple has_many and multiple m2m but starting at a has_many level');
+
+#Track -> might have -> Single -> has_many -> Tracks
+# \
+# \-> has_many \
+# --> CD2Producer
+# /-> has_many /
+# /
+# Producer
+lives_ok ( sub {
+ my $cd = $schema->resultset('CD')->first;
+ my $track = $schema->resultset('Track')->create ({
+ cd => $cd,
+ title => 'Multicreate rocks',
+ cd_single => {
+ artist => $cd->artist,
+ year => 2008,
+ title => 'Disemboweling MultiCreate',
+ tracks => [
+ { title => 'Why does mst write this way' },
+ { title => 'Chainsaw celebration' },
+ { title => 'Purl cleans up' },
+ ],
+ cd_to_producer => [
+ {
+ producer => {
+ name => 'mst',
+ }
+ },
+ {
+ producer => {
+ name => 'castaway',
+ }
+ },
+ {
+ producer => {
+ name => 'theorbtwo',
+ }
+ },
+ ]
+ },
+ });
+
+ isa_ok ($track, 'DBICTest::Track', 'Main Track object created');
+ is ($track->title, 'Multicreate rocks', 'Correct Track title');
+
+ my $single = $track->cd_single;
+ isa_ok ($single, 'DBICTest::CD', 'Created a single with the track');
+ is ($single->tracks->count, 3, '3 tracks on single CD');
+ is ($single->tracks->find ({ position => 1})->title, 'Why does mst write this way', 'Correct 1st track title');
+ is ($single->tracks->find ({ position => 2})->title, 'Chainsaw celebration', 'Correct 2nd track title');
+ is ($single->tracks->find ({ position => 3})->title, 'Purl cleans up', 'Correct 3rd track title');
+
+ is ($single->cd_to_producer->count, 3, '3 producers created for the single cd');
+ is_deeply (
+ [ sort map { $_->producer->name } ($single->cd_to_producer->all) ],
+ ['castaway', 'mst', 'theorbtwo'],
+ 'Producers named correctly',
+ );
+}, 'Create over > 1 levels of might_have with multiple has_many and multiple m2m but starting at the might_have directly');
+
+lives_ok ( sub {
+ my $artist = $schema->resultset('Artist')->first;
+ my $cd = $schema->resultset('CD')->create ({
+ artist => $artist,
+ title => 'Music to code by at twilight',
+ year => 2008,
+ artwork => {
+ images => [
+ { name => 'recursive descent' },
+ { name => 'tail packing' },
+ ],
+ },
+ });
+
+ isa_ok ($cd, 'DBICTest::CD', 'Main CD object created');
+ is ($cd->title, 'Music to code by at twilight', 'Correct CD title');
+ isa_ok ($cd->artwork, 'DBICTest::Artwork', 'Artwork created');
+
+ # this test might look weird, but it failed at one point, keep it there
+ my $art_obj = $cd->artwork;
+ ok ($art_obj->has_column_loaded ('cd_id'), 'PK/FK present on artwork object');
+ is ($art_obj->images->count, 2, 'Correct artwork image count via the new object');
+ is_deeply (
+ [ sort $art_obj->images->get_column ('name')->all ],
+ [ 'recursive descent', 'tail packing' ],
+ 'Images named correctly in objects',
+ );
+
+ my $artwork = $schema->resultset('Artwork')->search (
+ { 'cd.title' => 'Music to code by at twilight' },
+ { join => 'cd' },
+ )->single;
+
+ is ($artwork->images->count, 2, 'Correct artwork image count via a new search');
+
+ is_deeply (
+ [ sort $artwork->images->get_column ('name')->all ],
+ [ 'recursive descent', 'tail packing' ],
+ 'Images named correctly after search',
+ );
+}, 'Test might_have again but with a PK == FK in the middle (obviously not specified)');
+
+lives_ok ( sub {
+ my $cd = $schema->resultset('CD')->first;
+ my $track = $schema->resultset ('Track')->create ({
+ cd => $cd,
+ title => 'Black',
+ lyrics => {
+ lyric_versions => [
+ { text => 'The color black' },
+ { text => 'The colour black' },
+ ],
+ },
+ });
+
+ isa_ok ($track, 'DBICTest::Track', 'Main track object created');
+ is ($track->title, 'Black', 'Correct track title');
+ isa_ok ($track->lyrics, 'DBICTest::Lyrics', 'Lyrics created');
+
+ # this test might look weird, but it was failing at one point, keep it there
+ my $lyric_obj = $track->lyrics;
+ ok ($lyric_obj->has_column_loaded ('lyric_id'), 'PK present on lyric object');
+ ok ($lyric_obj->has_column_loaded ('track_id'), 'FK present on lyric object');
+ is ($lyric_obj->lyric_versions->count, 2, 'Correct lyric versions count via the new object');
+ is_deeply (
+ [ sort $lyric_obj->lyric_versions->get_column ('text')->all ],
+ [ 'The color black', 'The colour black' ],
+ 'Lyrics text in objects matches',
+ );
+
+
+ my $lyric = $schema->resultset('Lyrics')->search (
+ { 'track.title' => 'Black' },
+ { join => 'track' },
+ )->single;
+
+ is ($lyric->lyric_versions->count, 2, 'Correct lyric versions count via a new search');
+
+ is_deeply (
+ [ sort $lyric->lyric_versions->get_column ('text')->all ],
+ [ 'The color black', 'The colour black' ],
+ 'Lyrics text via search matches',
+ );
+}, 'Test might_have again but with just a PK and FK (neither specified) in the mid-table');
+
+lives_ok ( sub {
+ my $newartist2 = $schema->resultset('Artist')->find_or_create({
+ name => 'Fred 3',
+ cds => [
+ {
+ title => 'Noah Act',
+ year => 2007,
+ },
+ ],
+ });
+ is($newartist2->name, 'Fred 3', 'Created new artist with cds via find_or_create');
+}, 'Nested find_or_create');
+
+lives_ok ( sub {
+ my $artist = $schema->resultset('Artist')->first;
+
+ my $cd_result = $artist->create_related('cds', {
+
+ title => 'TestOneCD1',
+ year => 2007,
+ tracks => [
+ { title => 'TrackOne' },
+ { title => 'TrackTwo' },
+ ],
+
+ });
+
+ isa_ok( $cd_result, 'DBICTest::CD', "Got Good CD Class");
+ ok( $cd_result->title eq "TestOneCD1", "Got Expected Title");
+
+ my $tracks = $cd_result->tracks;
+
+ isa_ok( $tracks, 'DBIx::Class::ResultSet', 'Got Expected Tracks ResultSet');
+
+ foreach my $track ($tracks->all)
+ {
+ isa_ok( $track, 'DBICTest::Track', 'Got Expected Track Class');
+ }
+}, 'First create_related pass');
+
+lives_ok ( sub {
+ my $artist = $schema->resultset('Artist')->first;
+
+ my $cd_result = $artist->create_related('cds', {
+
+ title => 'TestOneCD2',
+ year => 2007,
+ tracks => [
+ { title => 'TrackOne' },
+ { title => 'TrackTwo' },
+ ],
+
+ liner_notes => { notes => 'I can haz liner notes?' },
+
+ });
+
+ isa_ok( $cd_result, 'DBICTest::CD', "Got Good CD Class");
+ ok( $cd_result->title eq "TestOneCD2", "Got Expected Title");
+ ok( $cd_result->notes eq 'I can haz liner notes?', 'Liner notes');
+
+ my $tracks = $cd_result->tracks;
+
+ isa_ok( $tracks, 'DBIx::Class::ResultSet', "Got Expected Tracks ResultSet");
+
+ foreach my $track ($tracks->all)
+ {
+ isa_ok( $track, 'DBICTest::Track', 'Got Expected Track Class');
+ }
+}, 'second create_related with same arguments');
+
+lives_ok ( sub {
+ my $cdp = $schema->resultset('CD_to_Producer')->create({
+ cd => { artist => 1, title => 'foo', year => 2000 },
+ producer => { name => 'jorge' }
+ });
+ ok($cdp, 'join table record created ok');
+}, 'create of parents of a record linker table');
+
+lives_ok ( sub {
+ my $kurt_cobain = { name => 'Kurt Cobain' };
+
+ my $in_utero = $schema->resultset('CD')->new({
+ title => 'In Utero',
+ year => 1993
+ });
+
+ $kurt_cobain->{cds} = [ $in_utero ];
+
+
+ $schema->resultset('Artist')->populate([ $kurt_cobain ]); # %)
+ $a = $schema->resultset('Artist')->find({name => 'Kurt Cobain'});
+
+ is($a->name, 'Kurt Cobain', 'Artist insertion ok');
+ is($a->cds && $a->cds->first && $a->cds->first->title,
+ 'In Utero', 'CD insertion ok');
+}, 'populate');
+
+## Create foreign key col obj including PK
+## See test 20 in 66relationships.t
+lives_ok ( sub {
+ my $new_cd_hashref = {
+ cdid => 27,
+ title => 'Boogie Woogie',
+ year => '2007',
+ artist => { artistid => 17, name => 'king luke' }
+ };
+
+ my $cd = $schema->resultset("CD")->find(1);
+
+ is($cd->artist->id, 1, 'rel okay');
+
+ my $new_cd = $schema->resultset("CD")->create($new_cd_hashref);
+ is($new_cd->artist->id, 17, 'new id retained okay');
+}, 'Create foreign key col obj including PK');
+
+lives_ok ( sub {
+ $schema->resultset("CD")->create({
+ cdid => 28,
+ title => 'Boogie Wiggle',
+ year => '2007',
+ artist => { artistid => 18, name => 'larry' }
+ });
+}, 'new cd created without clash on related artist');
+
+throws_ok ( sub {
+ my $t = $schema->resultset("Track")->new({ cd => { artist => undef } });
+ #$t->cd($t->new_related('cd', { artist => undef } ) );
+ #$t->{_rel_in_storage} = 0;
+ $t->insert;
+}, qr/cd.artist may not be NULL/, "Exception propogated properly");
+
+lives_ok ( sub {
+ $schema->resultset('CD')->create ({
+ artist => {
+ name => 'larry', # should already exist
+ },
+ title => 'Warble Marble',
+ year => '2009',
+ cd_to_producer => [
+ { producer => { name => 'Cowboy Neal' } },
+ ],
+ });
+
+ my $m2m_cd = $schema->resultset('CD')->search ({ title => 'Warble Marble'});
+ is ($m2m_cd->count, 1, 'One CD row created via M2M create');
+ is ($m2m_cd->first->producers->count, 1, 'CD row created with one producer');
+ is ($m2m_cd->first->producers->first->name, 'Cowboy Neal', 'Correct producer row created');
+}, 'Test multi create over many_to_many');
+
+1;
Copied: DBIx-Class/0.08/branches/prefetch/t/multi_create/torture.t (from rev 6764, DBIx-Class/0.08/branches/prefetch/t/96multi_create_torture.t)
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/multi_create/torture.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/multi_create/torture.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,228 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+plan tests => 23;
+
+# an insane multicreate
+# (should work, despite the fact that no one will probably use it this way)
+
+my $schema = DBICTest->init_schema();
+
+# first count how many rows do we initially have
+my $counts;
+$counts->{$_} = $schema->resultset($_)->count for qw/Artist CD Genre Producer Tag/;
+
+# do the crazy create
+eval {
+ $schema->resultset('CD')->create ({
+ artist => {
+ name => 'james',
+ },
+ title => 'Greatest hits 1',
+ year => '2012',
+ genre => {
+ name => '"Greatest" collections',
+ },
+ tags => [
+ { tag => 'A' },
+ { tag => 'B' },
+ ],
+ cd_to_producer => [
+ {
+ producer => {
+ name => 'bob',
+ producer_to_cd => [
+ {
+ cd => {
+ artist => {
+ name => 'lars',
+ cds => [
+ {
+ title => 'Greatest hits 2',
+ year => 2012,
+ genre => {
+ name => '"Greatest" collections',
+ },
+ tags => [
+ { tag => 'A' },
+ { tag => 'B' },
+ ],
+ # This cd is created via artist so it doesn't know about producers
+ cd_to_producer => [
+ { producer => { name => 'bob' } },
+ { producer => { name => 'paul' } },
+ { producer => {
+ name => 'flemming',
+ producer_to_cd => [
+ { cd => {
+ artist => {
+ name => 'kirk',
+ cds => [
+ {
+ title => 'Greatest hits 3',
+ year => 2012,
+ genre => {
+ name => '"Greatest" collections',
+ },
+ tags => [
+ { tag => 'A' },
+ { tag => 'B' },
+ ],
+ },
+ {
+ title => 'Greatest hits 4',
+ year => 2012,
+ genre => {
+ name => '"Greatest" collections2',
+ },
+ tags => [
+ { tag => 'A' },
+ { tag => 'B' },
+ ],
+ },
+ ],
+ },
+ title => 'Greatest hits 5',
+ year => 2013,
+ genre => {
+ name => '"Greatest" collections2',
+ },
+ }},
+ ],
+ }},
+ ],
+ },
+ ],
+ },
+ title => 'Greatest hits 6',
+ year => 2012,
+ genre => {
+ name => '"Greatest" collections',
+ },
+ tags => [
+ { tag => 'A' },
+ { tag => 'B' },
+ ],
+ },
+ },
+ {
+ cd => {
+ artist => {
+ name => 'lars', # should already exist
+ # even though the artist 'name' is not uniquely constrained
+ # find_or_create will arguably DWIM
+ },
+ title => 'Greatest hits 7',
+ year => 2013,
+ },
+ },
+ ],
+ },
+ },
+ ],
+ });
+
+ is ($schema->resultset ('Artist')->count, $counts->{Artist} + 3, '3 new artists created');
+ is ($schema->resultset ('Genre')->count, $counts->{Genre} + 2, '2 additional genres created');
+ is ($schema->resultset ('Producer')->count, $counts->{Producer} + 3, '3 new producer');
+ is ($schema->resultset ('CD')->count, $counts->{CD} + 7, '7 new CDs');
+ is ($schema->resultset ('Tag')->count, $counts->{Tag} + 10, '10 new Tags');
+
+ my $cd_rs = $schema->resultset ('CD')
+ ->search ({ title => { -like => 'Greatest hits %' }}, { order_by => 'title'} );
+ is ($cd_rs->count, 7, '7 greatest hits created');
+
+ my $cds_2012 = $cd_rs->search ({ year => 2012});
+ is ($cds_2012->count, 5, '5 CDs created in 2012');
+
+ is (
+ $cds_2012->search(
+ { 'tags.tag' => { -in => [qw/A B/] } },
+ {
+ join => 'tags',
+ group_by => 'me.cdid',
+ having => 'count(me.cdid) = 2',
+ }
+ ),
+ 5,
+ 'All 10 tags were pairwise distributed between 5 year-2012 CDs'
+ );
+
+ my $paul_prod = $cd_rs->search (
+ { 'producer.name' => 'paul'},
+ { join => { cd_to_producer => 'producer' } }
+ );
+ is ($paul_prod->count, 1, 'Paul had 1 production');
+ my $pauls_cd = $paul_prod->single;
+ is ($pauls_cd->cd_to_producer->count, 3, 'Paul had two co-producers');
+ is (
+ $pauls_cd->search_related ('cd_to_producer',
+ { 'producer.name' => 'flemming'},
+ { join => 'producer' }
+ )->count,
+ 1,
+ 'The second producer is flemming',
+ );
+
+ my $kirk_cds = $cd_rs->search ({ 'artist.name' => 'kirk' }, { join => 'artist' });
+ is ($kirk_cds, 3, 'Kirk had 3 CDs');
+ is (
+ $kirk_cds->search (
+ { 'cd_to_producer.cd' => { '!=', undef } },
+ { join => 'cd_to_producer' },
+ ),
+ 1,
+ 'Kirk had a producer only on one cd',
+ );
+
+ my $lars_cds = $cd_rs->search ({ 'artist.name' => 'lars' }, { join => 'artist' });
+ is ($lars_cds->count, 3, 'Lars had 3 CDs');
+ is (
+ $lars_cds->search (
+ { 'cd_to_producer.cd' => undef },
+ { join => 'cd_to_producer' },
+ ),
+ 0,
+ 'Lars always had a producer',
+ );
+ is (
+ $lars_cds->search_related ('cd_to_producer',
+ { 'producer.name' => 'flemming'},
+ { join => 'producer' }
+ )->count,
+ 1,
+ 'Lars produced 1 CD with flemming',
+ );
+ is (
+ $lars_cds->search_related ('cd_to_producer',
+ { 'producer.name' => 'bob'},
+ { join => 'producer' }
+ )->count,
+ 3,
+ 'Lars produced 3 CDs with bob',
+ );
+
+ my $bob_prod = $cd_rs->search (
+ { 'producer.name' => 'bob'},
+ { join => { cd_to_producer => 'producer' } }
+ );
+ is ($bob_prod->count, 4, 'Bob produced a total of 4 CDs');
+ ok ($bob_prod->find ({ title => 'Greatest hits 1'}), '1st Bob production name correct');
+ ok ($bob_prod->find ({ title => 'Greatest hits 6'}), '2nd Bob production name correct');
+ ok ($bob_prod->find ({ title => 'Greatest hits 2'}), '3rd Bob production name correct');
+ ok ($bob_prod->find ({ title => 'Greatest hits 7'}), '4th Bob production name correct');
+
+ is (
+ $bob_prod->search ({ 'artist.name' => 'james' }, { join => 'artist' })->count,
+ 1,
+ "Bob produced james' only CD",
+ );
+};
+diag $@ if $@;
+
+1;
Added: DBIx-Class/0.08/branches/prefetch/t/prefetch/count.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/prefetch/count.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/prefetch/count.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,101 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+plan tests => 23;
+
+my $schema = DBICTest->init_schema();
+
+my $cd_rs = $schema->resultset('CD')->search (
+ { 'tracks.cd' => { '!=', undef } },
+ { prefetch => ['tracks', 'artist'] },
+);
+
+
+is($cd_rs->count, 5, 'CDs with tracks count');
+is($cd_rs->search_related('tracks')->count, 15, 'Tracks associated with CDs count (before SELECT()ing)');
+
+is($cd_rs->all, 5, 'Amount of CD objects with tracks');
+is($cd_rs->search_related('tracks')->count, 15, 'Tracks associated with CDs count (after SELECT()ing)');
+
+is($cd_rs->search_related ('tracks')->all, 15, 'Track objects associated with CDs (after SELECT()ing)');
+
+my $artist = $schema->resultset('Artist')->create({name => 'xxx'});
+
+my $artist_rs = $schema->resultset('Artist')->search(
+ {artistid => $artist->id},
+ {prefetch=>'cds', join => 'twokeys' }
+);
+
+is($artist_rs->count, 1, "New artist found with prefetch turned on");
+is(scalar($artist_rs->all), 1, "New artist fetched with prefetch turned on");
+is($artist_rs->related_resultset('cds')->count, 0, "No CDs counted on a brand new artist");
+is(scalar($artist_rs->related_resultset('cds')->all), 0, "No CDs fetched on a brand new artist (count == fetch)");
+
+# create a cd, and make sure the non-existing join does not skew the count
+$artist->create_related ('cds', { title => 'yyy', year => '1999' });
+is($artist_rs->related_resultset('cds')->count, 1, "1 CDs counted on a brand new artist");
+is(scalar($artist_rs->related_resultset('cds')->all), 1, "1 CDs prefetched on a brand new artist (count == fetch)");
+
+# Really fuck shit up with one more cd and some insanity
+# this doesn't quite work as there are the prefetch gets lost
+# on search_related. This however is too esoteric to fix right
+# now
+
+my $cd2 = $artist->create_related ('cds', {
+ title => 'zzz',
+ year => '1999',
+ tracks => [{ title => 'ping' }, { title => 'pong' }],
+});
+
+my $cds = $cd2->search_related ('artist', {}, { join => 'twokeys' })
+ ->search_related ('cds');
+my $tracks = $cds->search_related ('tracks');
+
+is($tracks->count, 2, "2 Tracks counted on cd via artist via one of the cds");
+is(scalar($tracks->all), 2, "2 Track objects on cd via artist via one of the cds");
+
+is($cds->count, 2, "2 CDs counted on artist via one of the cds");
+is(scalar($cds->all), 2, "2 CD objectson artist via one of the cds");
+
+# make sure the join collapses all the way
+is_same_sql_bind (
+ $tracks->count_rs->as_query,
+ '(
+ SELECT COUNT( * )
+ FROM artist me
+ LEFT JOIN twokeys twokeys ON twokeys.artist = me.artistid
+ JOIN cd cds ON cds.artist = me.artistid
+ JOIN track tracks ON tracks.cd = cds.cdid
+ WHERE ( me.artistid = ? )
+ )',
+ [ [ 'me.artistid' => 4 ] ],
+);
+
+
+TODO: {
+ local $TODO = "Chaining with prefetch is fundamentally broken";
+
+ my $queries;
+ $schema->storage->debugcb ( sub { $queries++ } );
+ $schema->storage->debug (1);
+
+ my $cds = $cd2->search_related ('artist', {}, { prefetch => { cds => 'tracks' }, join => 'twokeys' })
+ ->search_related ('cds');
+
+ my $tracks = $cds->search_related ('tracks');
+
+ is($tracks->count, 2, "2 Tracks counted on cd via artist via one of the cds");
+ is(scalar($tracks->all), 2, "2 Tracks prefetched on cd via artist via one of the cds");
+ is($tracks->count, 2, "Cached 2 Tracks counted on cd via artist via one of the cds");
+
+ is($cds->count, 2, "2 CDs counted on artist via one of the cds");
+ is(scalar($cds->all), 2, "2 CDs prefetched on artist via one of the cds");
+ is($cds->count, 2, "Cached 2 CDs counted on artist via one of the cds");
+
+ is ($queries, 3, '2 counts + 1 prefetch?');
+}
Modified: DBIx-Class/0.08/branches/prefetch/t/prefetch/double_prefetch.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/prefetch/double_prefetch.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/prefetch/double_prefetch.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -23,8 +23,8 @@
'(
SELECT
cds.cdid, cds.artist, cds.title, cds.year, cds.genreid, cds.single_track,
- single_track.trackid, single_track.cd, single_track.position, single_track.title, single_track.last_updated_on, single_track.last_updated_at,
- single_track_2.trackid, single_track_2.cd, single_track_2.position, single_track_2.title, single_track_2.last_updated_on, single_track_2.last_updated_at,
+ single_track.trackid, single_track.cd, single_track.position, single_track.title, single_track.last_updated_on, single_track.last_updated_at, single_track.small_dt,
+ single_track_2.trackid, single_track_2.cd, single_track_2.position, single_track_2.title, single_track_2.last_updated_on, single_track_2.last_updated_at, single_track_2.small_dt,
cd.cdid, cd.artist, cd.title, cd.year, cd.genreid, cd.single_track
FROM artist me
LEFT JOIN cd cds ON cds.artist = me.artistid
Added: DBIx-Class/0.08/branches/prefetch/t/prefetch/grouped.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/prefetch/grouped.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/prefetch/grouped.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,274 @@
+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();
+my $sdebug = $schema->storage->debug;
+
+my $cd_rs = $schema->resultset('CD')->search (
+ { 'tracks.cd' => { '!=', undef } },
+ { prefetch => 'tracks' },
+);
+
+# Database sanity check
+is($cd_rs->count, 5, 'CDs with tracks count');
+for ($cd_rs->all) {
+ is ($_->tracks->count, 3, '3 tracks for CD' . $_->id );
+}
+
+# Test a belongs_to prefetch of a has_many
+{
+ my $track_rs = $schema->resultset ('Track')->search (
+ { 'me.cd' => { -in => [ $cd_rs->get_column ('cdid')->all ] } },
+ {
+ select => [
+ 'me.cd',
+ { count => 'me.trackid' },
+ ],
+ as => [qw/
+ cd
+ track_count
+ /],
+ group_by => [qw/me.cd/],
+ prefetch => 'cd',
+ },
+ );
+
+ # this used to fuck up ->all, do not remove!
+ ok ($track_rs->first, 'There is stuff in the rs');
+
+ is($track_rs->count, 5, 'Prefetched count with groupby');
+ is($track_rs->all, 5, 'Prefetched objects with groupby');
+
+ {
+ my $query_cnt = 0;
+ $schema->storage->debugcb ( sub { $query_cnt++ } );
+ $schema->storage->debug (1);
+
+ while (my $collapsed_track = $track_rs->next) {
+ my $cdid = $collapsed_track->get_column('cd');
+ is($collapsed_track->get_column('track_count'), 3, "Correct count of tracks for CD $cdid" );
+ ok($collapsed_track->cd->title, "Prefetched title for CD $cdid" );
+ }
+
+ is ($query_cnt, 1, 'Single query on prefetched titles');
+ $schema->storage->debugcb (undef);
+ $schema->storage->debug ($sdebug);
+ }
+
+ # Test sql by hand, as the sqlite db will simply paper over
+ # improper group/select combinations
+ #
+ is_same_sql_bind (
+ $track_rs->count_rs->as_query,
+ '(
+ SELECT COUNT( * )
+ FROM (
+ SELECT me.cd
+ FROM track me
+ JOIN cd cd ON cd.cdid = me.cd
+ WHERE ( me.cd IN ( ?, ?, ?, ?, ? ) )
+ GROUP BY me.cd
+ )
+ count_subq
+ )',
+ [ map { [ 'me.cd' => $_] } ($cd_rs->get_column ('cdid')->all) ],
+ 'count() query generated expected SQL',
+ );
+
+ is_same_sql_bind (
+ $track_rs->as_query,
+ '(
+ SELECT me.cd, me.track_count, cd.cdid, cd.artist, cd.title, cd.year, cd.genreid, cd.single_track
+ FROM (
+ SELECT me.cd, COUNT (me.trackid) AS track_count,
+ FROM track me
+ JOIN cd cd ON cd.cdid = me.cd
+ WHERE ( me.cd IN ( ?, ?, ?, ?, ? ) )
+ GROUP BY me.cd
+ ) as me
+ JOIN cd cd ON cd.cdid = me.cd
+ WHERE ( me.cd IN ( ?, ?, ?, ?, ? ) )
+ )',
+ [ map { [ 'me.cd' => $_] } ( ($cd_rs->get_column ('cdid')->all) x 2 ) ],
+ 'next() query generated expected SQL',
+ );
+
+
+ # add an extra track to one of the cds, and then make sure we can get it on top
+ # (check if limit works)
+ my $top_cd = $cd_rs->slice (1,1)->next;
+ $top_cd->create_related ('tracks', {
+ title => 'over the top',
+ });
+
+ my $top_cd_collapsed_track = $track_rs->search ({}, {
+ rows => 2,
+ order_by => [
+ { -desc => 'track_count' },
+ ],
+ });
+
+ is ($top_cd_collapsed_track->count, 2);
+
+ is (
+ $top_cd->title,
+ $top_cd_collapsed_track->first->cd->title,
+ 'Correct collapsed track with prefetched CD returned on top'
+ );
+}
+
+# test a has_many/might_have prefetch at the same level
+# Note that one of the CDs now has 4 tracks instead of 3
+{
+ my $most_tracks_rs = $schema->resultset ('CD')->search (
+ {
+ 'me.cdid' => { '!=' => undef }, # duh - this is just to test WHERE
+ },
+ {
+ prefetch => [qw/tracks liner_notes/],
+ select => ['me.cdid', { count => 'tracks.trackid' }, { max => 'tracks.trackid', -as => 'maxtr'} ],
+ as => [qw/cdid track_count max_track_id/],
+ group_by => 'me.cdid',
+ order_by => [ { -desc => 'track_count' }, { -asc => 'maxtr' } ],
+ rows => 2,
+ }
+ );
+
+ is_same_sql_bind (
+ $most_tracks_rs->count_rs->as_query,
+ '(
+ SELECT COUNT( * )
+ FROM (
+ SELECT me.cdid
+ FROM cd me
+ LEFT JOIN track tracks ON tracks.cd = me.cdid
+ LEFT JOIN liner_notes liner_notes ON liner_notes.liner_id = me.cdid
+ WHERE ( me.cdid IS NOT NULL )
+ GROUP BY me.cdid
+ LIMIT 2
+ ) count_subq
+ )',
+ [],
+ 'count() query generated expected SQL',
+ );
+
+ is_same_sql_bind (
+ $most_tracks_rs->as_query,
+ '(
+ SELECT me.cdid, me.track_count, me.maxtr,
+ tracks.trackid, tracks.cd, tracks.position, tracks.title, tracks.last_updated_on, tracks.last_updated_at, tracks.small_dt,
+ liner_notes.liner_id, liner_notes.notes
+ FROM (
+ SELECT me.cdid, COUNT( tracks.trackid ) AS track_count, MAX( tracks.trackid ) AS maxtr,
+ FROM cd me
+ LEFT JOIN track tracks ON tracks.cd = me.cdid
+ WHERE ( me.cdid IS NOT NULL )
+ GROUP BY me.cdid
+ ORDER BY track_count DESC, maxtr ASC
+ LIMIT 2
+ ) me
+ LEFT JOIN track tracks ON tracks.cd = me.cdid
+ LEFT JOIN liner_notes liner_notes ON liner_notes.liner_id = me.cdid
+ WHERE ( me.cdid IS NOT NULL )
+ ORDER BY track_count DESC, maxtr ASC, tracks.cd
+ )',
+ [],
+ 'next() query generated expected SQL',
+ );
+
+ is ($most_tracks_rs->count, 2, 'Limit works');
+ my $top_cd = $most_tracks_rs->first;
+ is ($top_cd->id, 2, 'Correct cd fetched on top'); # 2 because of the slice(1,1) earlier
+
+ my $query_cnt = 0;
+ $schema->storage->debugcb ( sub { $query_cnt++ } );
+ $schema->storage->debug (1);
+
+ is ($top_cd->get_column ('track_count'), 4, 'Track count fetched correctly');
+ is ($top_cd->tracks->count, 4, 'Count of prefetched tracks rs still correct');
+ is ($top_cd->tracks->all, 4, 'Number of prefetched track objects still correct');
+ is (
+ $top_cd->liner_notes->notes,
+ 'Buy Whiskey!',
+ 'Correct liner pre-fetched with top cd',
+ );
+
+ is ($query_cnt, 0, 'No queries executed during prefetched data access');
+ $schema->storage->debugcb (undef);
+ $schema->storage->debug ($sdebug);
+}
+
+# make sure that distinct still works
+{
+ my $rs = $schema->resultset("CD")->search({}, {
+ prefetch => 'tags',
+ order_by => 'cdid',
+ distinct => 1,
+ });
+
+ is_same_sql_bind (
+ $rs->as_query,
+ '(
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
+ tags.tagid, tags.cd, tags.tag
+ FROM (
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+ FROM cd me
+ GROUP BY me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+ ORDER BY cdid
+ ) me
+ LEFT JOIN tags tags ON tags.cd = me.cdid
+ ORDER BY cdid, tags.cd, tags.tag
+ )',
+ [],
+ 'Prefetch + distinct resulted in correct group_by',
+ );
+
+ is ($rs->all, 5, 'Correct number of CD objects');
+ is ($rs->count, 5, 'Correct count of CDs');
+}
+
+# RT 47779, test group_by as a scalar ref
+{
+ my $track_rs = $schema->resultset ('Track')->search (
+ { 'me.cd' => { -in => [ $cd_rs->get_column ('cdid')->all ] } },
+ {
+ select => [
+ 'me.cd',
+ { count => 'me.trackid' },
+ ],
+ as => [qw/
+ cd
+ track_count
+ /],
+ group_by => \'SUBSTR(me.cd, 1, 1)',
+ prefetch => 'cd',
+ },
+ );
+
+ is_same_sql_bind (
+ $track_rs->count_rs->as_query,
+ '(
+ SELECT COUNT( * )
+ FROM (
+ SELECT SUBSTR(me.cd, 1, 1)
+ FROM track me
+ JOIN cd cd ON cd.cdid = me.cd
+ WHERE ( me.cd IN ( ?, ?, ?, ?, ? ) )
+ GROUP BY SUBSTR(me.cd, 1, 1)
+ )
+ count_subq
+ )',
+ [ map { [ 'me.cd' => $_] } ($cd_rs->get_column ('cdid')->all) ],
+ 'count() query generated expected SQL',
+ );
+}
+
+done_testing;
Added: DBIx-Class/0.08/branches/prefetch/t/prefetch/incomplete.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/prefetch/incomplete.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/prefetch/incomplete.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,53 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+plan tests => 9;
+
+my $schema = DBICTest->init_schema();
+
+lives_ok(sub {
+ # while cds.* will be selected anyway (prefetch currently forces the result of _resolve_prefetch)
+ # only the requested me.name column will be fetched.
+
+ # reference sql with select => [...]
+ # SELECT me.name, cds.title, cds.cdid, cds.artist, cds.title, cds.year, cds.genreid, cds.single_track FROM ...
+
+ my $rs = $schema->resultset('Artist')->search(
+ { 'cds.title' => { '!=', 'Generic Manufactured Singles' } },
+ {
+ prefetch => [ qw/ cds / ],
+ order_by => [ { -desc => 'me.name' }, 'cds.title' ],
+ select => [qw/ me.name cds.title / ],
+ }
+ );
+
+ is ($rs->count, 2, 'Correct number of collapsed artists');
+ my $we_are_goth = $rs->first;
+ is ($we_are_goth->name, 'We Are Goth', 'Correct first artist');
+ is ($we_are_goth->cds->count, 1, 'Correct number of CDs for first artist');
+ is ($we_are_goth->cds->first->title, 'Come Be Depressed With Us', 'Correct cd for artist');
+}, 'explicit prefetch on a keyless object works');
+
+
+lives_ok(sub {
+ # test implicit prefetch as well
+
+ my $rs = $schema->resultset('CD')->search(
+ { title => 'Generic Manufactured Singles' },
+ {
+ join=> 'artist',
+ select => [qw/ me.title artist.name / ],
+ }
+ );
+
+ my $cd = $rs->next;
+ is ($cd->title, 'Generic Manufactured Singles', 'CD title prefetched correctly');
+ isa_ok ($cd->artist, 'DBICTest::Artist');
+ is ($cd->artist->name, 'Random Boy Band', 'Artist object has correct name');
+
+}, 'implicit keyless prefetch works');
Modified: DBIx-Class/0.08/branches/prefetch/t/prefetch/multiple_hasmany.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/prefetch/multiple_hasmany.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/prefetch/multiple_hasmany.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -5,13 +5,13 @@
use Test::Exception;
use lib qw(t/lib);
use DBICTest;
-use Data::Dumper;
+use IO::File;
plan tests => 10;
my $schema = DBICTest->init_schema();
+my $sdebug = $schema->storage->debug;
-use IO::File;
# once the following TODO is complete, remove the 2 warning tests immediately
# after the TODO block
@@ -44,19 +44,17 @@
ok(! $o_mm_warn, 'no warning on attempt to prefetch several same level has_many\'s (1 -> M + M)');
is($queries, 1, 'prefetch one->(has_many,has_many) ran exactly 1 query');
+ $schema->storage->debugcb (undef);
+ $schema->storage->debug ($sdebug);
+
is($pr_tracks_count, $tracks_count, 'equal count of prefetched relations over several same level has_many\'s (1 -> M + M)');
+ is ($pr_tracks_rs->all, $tracks_rs->all, 'equal amount of objects returned with and without prefetch over several same level has_many\'s (1 -> M + M)');
- for ($pr_tracks_rs, $tracks_rs) {
- $_->result_class ('DBIx::Class::ResultClass::HashRefInflator');
- }
-
- is_deeply ([$pr_tracks_rs->all], [$tracks_rs->all], 'same structure returned with and without prefetch over several same level has_many\'s (1 -> M + M)');
-
#( M -> 1 -> M + M )
my $note_rs = $schema->resultset('LinerNotes')->search ({ notes => 'Buy Whiskey!' });
my $pr_note_rs = $note_rs->search ({}, {
prefetch => {
- cd => [qw/tags tracks/]
+ cd => [qw/tracks tags/]
},
});
@@ -79,14 +77,11 @@
ok(! $m_o_mm_warn, 'no warning on attempt to prefetch several same level has_many\'s (M -> 1 -> M + M)');
is($queries, 1, 'prefetch one->(has_many,has_many) ran exactly 1 query');
+ $schema->storage->debugcb (undef);
+ $schema->storage->debug ($sdebug);
is($pr_tags_count, $tags_count, 'equal count of prefetched relations over several same level has_many\'s (M -> 1 -> M + M)');
-
- for ($pr_tags_rs, $tags_rs) {
- $_->result_class ('DBIx::Class::ResultClass::HashRefInflator');
- }
-
- is_deeply ([$pr_tags_rs->all], [$tags_rs->all], 'same structure returned with and without prefetch over several same level has_many\'s (M -> 1 -> M + M)');
+ is($pr_tags_rs->all, $tags_rs->all, 'equal amount of objects with and without prefetch over several same level has_many\'s (M -> 1 -> M + M)');
}
# remove this closure once the TODO above is working
Modified: DBIx-Class/0.08/branches/prefetch/t/prefetch/standard.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/prefetch/standard.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/prefetch/standard.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -1,25 +1,18 @@
use strict;
-use warnings;
+use warnings;
use Test::More;
use Test::Exception;
use lib qw(t/lib);
use DBICTest;
use Data::Dumper;
+use IO::File;
my $schema = DBICTest->init_schema();
-
my $orig_debug = $schema->storage->debug;
-use IO::File;
+plan tests => 44;
-BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 45 );
-}
-
my $queries = 0;
$schema->storage->debugcb(sub { $queries++; });
$schema->storage->debug(1);
@@ -227,29 +220,11 @@
$tree_like = eval { $schema->resultset('TreeLike')->search(
{ 'children.id' => 3, 'children_2.id' => 6 },
- { join => [qw/children children/] }
+ { join => [qw/children children children/] }
)->search_related('children', { 'children_4.id' => 7 }, { prefetch => 'children' }
)->first->children->first; };
is(eval { $tree_like->name }, 'fong', 'Tree with multiple has_many joins ok');
-# test that collapsed joins don't get a _2 appended to the alias
-
-my $sql = '';
-$schema->storage->debugcb(sub { $sql = $_[1] });
-$schema->storage->debug(1);
-
-eval {
- my $row = $schema->resultset('Artist')->search_related('cds', undef, {
- join => 'tracks',
- prefetch => 'tracks',
- })->search_related('tracks')->first;
-};
-
-like( $sql, qr/^SELECT tracks_2\.trackid/, "join not collapsed for search_related" );
-
-$schema->storage->debug($orig_debug);
-$schema->storage->debugobj->callback(undef);
-
$rs = $schema->resultset('Artist');
$rs->create({ artistid => 4, name => 'Unknown singer-songwriter' });
$rs->create({ artistid => 5, name => 'Emo 4ever' });
@@ -313,3 +288,6 @@
);
is($queries, 0, 'chained search_related after has_many->has_many prefetch ran no queries');
+
+$schema->storage->debug($orig_debug);
+$schema->storage->debugobj->callback(undef);
Added: DBIx-Class/0.08/branches/prefetch/t/prefetch/via_search_related.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/prefetch/via_search_related.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/prefetch/via_search_related.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,93 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+lives_ok ( sub {
+ my $no_prefetch = $schema->resultset('Track')->search_related(cd =>
+ {
+ 'cd.year' => "2000",
+ },
+ {
+ join => 'tags',
+ order_by => 'me.trackid',
+ rows => 1,
+ }
+ );
+
+ my $use_prefetch = $no_prefetch->search(
+ {},
+ {
+ prefetch => 'tags',
+ }
+ );
+
+ is($use_prefetch->count, $no_prefetch->count, 'counts with and without prefetch match');
+ is(
+ scalar ($use_prefetch->all),
+ scalar ($no_prefetch->all),
+ "Amount of returned rows is right"
+ );
+
+}, 'search_related prefetch with order_by works');
+
+
+lives_ok (sub {
+ my $rs = $schema->resultset("Artwork")->search(undef, {distinct => 1})
+ ->search_related('artwork_to_artist')->search_related('artist',
+ undef,
+ { prefetch => 'cds' },
+ );
+ is($rs->all, 0, 'prefetch without WHERE (objects)');
+ is($rs->count, 0, 'prefetch without WHERE (count)');
+
+ $rs = $schema->resultset("Artwork")->search(undef, {distinct => 1})
+ ->search_related('artwork_to_artist')->search_related('artist',
+ { 'cds.title' => 'foo' },
+ { prefetch => 'cds' },
+ );
+ is($rs->all, 0, 'prefetch with WHERE (objects)');
+ is($rs->count, 0, 'prefetch with WHERE (count)');
+
+
+# test where conditions at the root of the related chain
+ my $artist_rs = $schema->resultset("Artist")->search({artistid => 11});
+
+
+ $rs = $artist_rs->search_related('cds')->search_related('genre',
+ { 'genre.name' => 'foo' },
+ { prefetch => 'cds' },
+ );
+ is($rs->all, 0, 'prefetch without distinct (objects)');
+ is($rs->count, 0, 'prefetch without distinct (count)');
+
+
+
+ $rs = $artist_rs->search(undef, {distinct => 1})
+ ->search_related('cds')->search_related('genre',
+ { 'genre.name' => 'foo' },
+ );
+ is($rs->all, 0, 'distinct without prefetch (objects)');
+ is($rs->count, 0, 'distinct without prefetch (count)');
+
+
+
+ $rs = $artist_rs->search({}, {distinct => 1})
+ ->search_related('cds')->search_related('genre',
+ { 'genre.name' => 'foo' },
+ { prefetch => 'cds' },
+ );
+ is($rs->all, 0, 'distinct with prefetch (objects)');
+ is($rs->count, 0, 'distinct with prefetch (count)');
+
+
+
+}, 'distinct generally works with prefetch on deep search_related chains');
+
+done_testing;
Modified: DBIx-Class/0.08/branches/prefetch/t/relationship/core.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/relationship/core.t 2009-08-21 09:18:43 UTC (rev 7358)
+++ DBIx-Class/0.08/branches/prefetch/t/relationship/core.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -7,8 +7,9 @@
use DBICTest;
my $schema = DBICTest->init_schema();
+my $sdebug = $schema->storage->debug;
-plan tests => 78;
+plan tests => 79;
# has_a test
my $cd = $schema->resultset("CD")->find(4);
@@ -57,7 +58,7 @@
is($queries, 0, 'No SELECT made for belongs_to if key IS NULL');
$big_flop_cd->genre_inefficient; #should trigger a select query
is($queries, 1, 'SELECT made for belongs_to if key IS NULL when undef_on_null_fk disabled');
- $schema->storage->debug(0);
+ $schema->storage->debug($sdebug);
$schema->storage->debugcb(undef);
}
@@ -275,11 +276,11 @@
cmp_ok($searched->count, '==', 2, "Both artist returned from map after adding another condition");
-# check join through cascaded has_many relationships
+# check join through cascaded has_many relationships (also empty has_many rels)
$artist = $schema->resultset("Artist")->find(1);
my $trackset = $artist->cds->search_related('tracks');
-# LEFT join means we also see the trackless additional album...
-cmp_ok($trackset->count, '==', 11, "Correct number of tracks for artist");
+is($trackset->count, 10, "Correct number of tracks for artist");
+is($trackset->all, 10, "Correct number of track objects for artist");
# now see about updating eveything that belongs to artist 2 to artist 3
$artist = $schema->resultset("Artist")->find(2);
Added: DBIx-Class/0.08/branches/prefetch/t/relationship/update_or_create_multi.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/relationship/update_or_create_multi.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/relationship/update_or_create_multi.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,89 @@
+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();
+my $sdebug = $schema->storage->debug;
+
+plan tests => 6;
+
+my $artist = $schema->resultset ('Artist')->first;
+
+my $genre = $schema->resultset ('Genre')
+ ->create ({ name => 'par excellence' });
+
+is ($genre->search_related( 'cds' )->count, 0, 'No cds yet');
+
+# expect a create
+$genre->update_or_create_related ('cds', {
+ artist => $artist,
+ year => 2009,
+ title => 'the best thing since sliced bread',
+});
+
+# verify cd was inserted ok
+is ($genre->search_related( 'cds' )->count, 1, 'One cd');
+my $cd = $genre->find_related ('cds', {});
+is_deeply (
+ { map { $_, $cd->get_column ($_) } qw/artist year title/ },
+ {
+ artist => $artist->id,
+ year => 2009,
+ title => 'the best thing since sliced bread',
+ },
+ 'CD created correctly',
+);
+
+# expect a year update on the only related row
+# (non-qunique column + unique column as disambiguator)
+$genre->update_or_create_related ('cds', {
+ year => 2010,
+ title => 'the best thing since sliced bread',
+});
+
+# re-fetch the cd, verify update
+is ($genre->search_related( 'cds' )->count, 1, 'Still one cd');
+$cd = $genre->find_related ('cds', {});
+is_deeply (
+ { map { $_, $cd->get_column ($_) } qw/artist year title/ },
+ {
+ artist => $artist->id,
+ year => 2010,
+ title => 'the best thing since sliced bread',
+ },
+ 'CD year column updated correctly',
+);
+
+
+# expect a create, after a failed search using *only* the
+# *current* relationship and the unique column constraints
+# (so no year)
+my @sql;
+$schema->storage->debugcb(sub { push @sql, $_[1] });
+$schema->storage->debug (1);
+
+$genre->update_or_create_related ('cds', {
+ title => 'the best thing since vertical toasters',
+ artist => $artist,
+ year => 2012,
+});
+
+$schema->storage->debugcb(undef);
+$schema->storage->debug ($sdebug);
+
+is_same_sql (
+ $sql[0],
+ 'SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+ FROM cd me
+ WHERE ( me.artist = ? AND me.title = ? AND me.genreid = ? )
+ ',
+ 'expected select issued',
+);
+
+# a has_many search without a unique constraint makes no sense
+# but I am not sure what to test for - leaving open
Added: DBIx-Class/0.08/branches/prefetch/t/relationship/update_or_create_single.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/relationship/update_or_create_single.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/relationship/update_or_create_single.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,99 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+plan tests => 9;
+
+my $artist = $schema->resultset ('Artist')->first;
+
+my $genre = $schema->resultset ('Genre')
+ ->create ({ name => 'par excellence' });
+
+is ($genre->search_related( 'model_cd' )->count, 0, 'No cds yet');
+
+# expect a create
+$genre->update_or_create_related ('model_cd', {
+ artist => $artist,
+ year => 2009,
+ title => 'the best thing since sliced bread',
+});
+
+# verify cd was inserted ok
+is ($genre->search_related( 'model_cd' )->count, 1, 'One cd');
+my $cd = $genre->find_related ('model_cd', {});
+is_deeply (
+ { map { $_, $cd->get_column ($_) } qw/artist year title/ },
+ {
+ artist => $artist->id,
+ year => 2009,
+ title => 'the best thing since sliced bread',
+ },
+ 'CD created correctly',
+);
+
+# expect a year update on the only related row
+# (non-qunique column + unique column as disambiguator)
+$genre->update_or_create_related ('model_cd', {
+ year => 2010,
+ title => 'the best thing since sliced bread',
+});
+
+# re-fetch the cd, verify update
+is ($genre->search_related( 'model_cd' )->count, 1, 'Still one cd');
+$cd = $genre->find_related ('model_cd', {});
+is_deeply (
+ { map { $_, $cd->get_column ($_) } qw/artist year title/ },
+ {
+ artist => $artist->id,
+ year => 2010,
+ title => 'the best thing since sliced bread',
+ },
+ 'CD year column updated correctly',
+);
+
+
+# expect an update of the only related row
+# (update a unique column)
+$genre->update_or_create_related ('model_cd', {
+ title => 'the best thing since vertical toasters',
+});
+
+# re-fetch the cd, verify update
+is ($genre->search_related( 'model_cd' )->count, 1, 'Still one cd');
+$cd = $genre->find_related ('model_cd', {});
+is_deeply (
+ { map { $_, $cd->get_column ($_) } qw/artist year title/ },
+ {
+ artist => $artist->id,
+ year => 2010,
+ title => 'the best thing since vertical toasters',
+ },
+ 'CD title column updated correctly',
+);
+
+
+# expect a year update on the only related row
+# (non-qunique column only)
+$genre->update_or_create_related ('model_cd', {
+ year => 2011,
+});
+
+# re-fetch the cd, verify update
+is ($genre->search_related( 'model_cd' )->count, 1, 'Still one cd');
+$cd = $genre->find_related ('model_cd', {});
+is_deeply (
+ { map { $_, $cd->get_column ($_) } qw/artist year title/ },
+ {
+ artist => $artist->id,
+ year => 2011,
+ title => 'the best thing since vertical toasters',
+ },
+ 'CD year column updated correctly without a disambiguator',
+);
+
+
Added: DBIx-Class/0.08/branches/prefetch/t/zzzzzzz_sqlite_deadlock.t
===================================================================
--- DBIx-Class/0.08/branches/prefetch/t/zzzzzzz_sqlite_deadlock.t (rev 0)
+++ DBIx-Class/0.08/branches/prefetch/t/zzzzzzz_sqlite_deadlock.t 2009-08-21 09:22:51 UTC (rev 7359)
@@ -0,0 +1,41 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib 't/lib';
+
+use File::Temp ();
+use DBICTest;
+use DBICTest::Schema;
+
+plan tests => 2;
+my $wait_for = 10; # how many seconds to wait
+
+for my $close (0,1) {
+
+ my $tmp = File::Temp->new(
+ UNLINK => 1,
+ TMPDIR => 1,
+ SUFFIX => '.sqlite',
+ EXLOCK => 0, # important for BSD and derivatives
+ );
+
+ my $tmp_fn = $tmp->filename;
+ close $tmp if $close;
+
+ local $SIG{ALRM} = sub { die sprintf (
+ "Timeout of %d seconds reached (tempfile still open: %s)",
+ $wait_for, $close ? 'No' : 'Yes'
+ )};
+
+ alarm $wait_for;
+
+ lives_ok (sub {
+ my $schema = DBICTest::Schema->connect ("DBI:SQLite:$tmp_fn");
+ DBICTest->deploy_schema ($schema);
+ #DBICTest->populate_schema ($schema);
+ });
+
+ alarm 0;
+}
More information about the Bast-commits
mailing list