[Bast-commits] r5529 - in DBIx-Class/0.08/branches/multi_stuff: .
examples lib/DBIx lib/DBIx/Class lib/DBIx/Class/InflateColumn
lib/DBIx/Class/Manual lib/DBIx/Class/Relationship
lib/DBIx/Class/Schema lib/DBIx/Class/Storage
lib/DBIx/Class/Storage/DBI lib/DBIx/Class/Storage/DBI/Oracle
lib/DBIx/Class/Storage/DBI/Replicated
lib/SQL/Translator/Parser/DBIx t t/cdbi
t/cdbi/DeepAbstractSearch t/cdbi/abstract t/cdbi/sweet
t/cdbi/testlib t/lib t/lib/DBIC t/lib/DBICTest
t/lib/DBICTest/Schema t/resultset t/search
robkinyon at dev.catalyst.perl.org
robkinyon at dev.catalyst.perl.org
Thu Feb 19 03:04:54 GMT 2009
Author: robkinyon
Date: 2009-02-19 03:04:53 +0000 (Thu, 19 Feb 2009)
New Revision: 5529
Added:
DBIx-Class/0.08/branches/multi_stuff/Features_09
DBIx-Class/0.08/branches/multi_stuff/examples/
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/01-columns.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/02-Film.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/03-subclassing.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/04-lazy.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/06-hasa.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/08-inheritcols.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/09-has_many.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/11-triggers.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/12-filter.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/13-constraint.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/14-might_have.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/15-accessor.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/16-reserved.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/18-has_a.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/19-set_sql.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/21-iterator.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/22-deflate_order.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/22-self_referential.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/23-cascade.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/24-meta_info.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/26-mutator.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/30-pager.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/68-inflate_has_a.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/98-failure.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/DeepAbstractSearch/
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/abstract/
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/columns_as_hashes.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/columns_dont_override_custom_accessors.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/construct.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/copy.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/early_column_heisenbug.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/has_many_loads_foreign_class.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/hasa_without_loading.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/max_min_value_of.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/mk_group_accessors.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/multi_column_set.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/object_cache.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/retrieve_from_sql_with_limit.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/set_to_undef.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/set_vs_DateTime.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/sweet/
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/
DBIx-Class/0.08/branches/multi_stuff/t/resultset/
DBIx-Class/0.08/branches/multi_stuff/t/resultset/as_query.t
DBIx-Class/0.08/branches/multi_stuff/t/search/
DBIx-Class/0.08/branches/multi_stuff/t/search/subquery.t
Removed:
DBIx-Class/0.08/branches/multi_stuff/t/cdbi-DeepAbstractSearch/
DBIx-Class/0.08/branches/multi_stuff/t/cdbi-abstract/
DBIx-Class/0.08/branches/multi_stuff/t/cdbi-sweet-t/
DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/
DBIx-Class/0.08/branches/multi_stuff/t/examples/
DBIx-Class/0.08/branches/multi_stuff/t/testlib/
Modified:
DBIx-Class/0.08/branches/multi_stuff/
DBIx-Class/0.08/branches/multi_stuff/Changes
DBIx-Class/0.08/branches/multi_stuff/MANIFEST.SKIP
DBIx-Class/0.08/branches/multi_stuff/Makefile.PL
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class.pm
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Componentised.pm
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/InflateColumn/DateTime.pm
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Manual/Cookbook.pod
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Manual/FAQ.pod
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Relationship/Accessor.pm
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSet.pm
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSetColumn.pm
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSource.pm
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Schema.pm
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Schema/Versioned.pm
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI/Cursor.pm
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
DBIx-Class/0.08/branches/multi_stuff/lib/SQL/Translator/Parser/DBIx/Class.pm
DBIx-Class/0.08/branches/multi_stuff/t/103many_to_many_warning.t
DBIx-Class/0.08/branches/multi_stuff/t/66relationship.t
DBIx-Class/0.08/branches/multi_stuff/t/72pg.t
DBIx-Class/0.08/branches/multi_stuff/t/73oracle.t
DBIx-Class/0.08/branches/multi_stuff/t/745db2.t
DBIx-Class/0.08/branches/multi_stuff/t/746db2_400.t
DBIx-Class/0.08/branches/multi_stuff/t/746mssql.t
DBIx-Class/0.08/branches/multi_stuff/t/76joins.t
DBIx-Class/0.08/branches/multi_stuff/t/77prefetch.t
DBIx-Class/0.08/branches/multi_stuff/t/81transactions.t
DBIx-Class/0.08/branches/multi_stuff/t/86sqlt.t
DBIx-Class/0.08/branches/multi_stuff/t/89dbicadmin.t
DBIx-Class/0.08/branches/multi_stuff/t/89inflate_datetime.t
DBIx-Class/0.08/branches/multi_stuff/t/90ensure_class_loaded.t
DBIx-Class/0.08/branches/multi_stuff/t/94versioning.t
DBIx-Class/0.08/branches/multi_stuff/t/99dbic_sqlt_parser.t
DBIx-Class/0.08/branches/multi_stuff/t/99rh_perl_perf_bug.t
DBIx-Class/0.08/branches/multi_stuff/t/bindtype_columns.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/DeepAbstractSearch/01_search.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/abstract/search_where.t
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Actor.pm
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/ActorAlias.pm
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Binary.pm
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Blurb.pm
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Director.pm
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Film.pm
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Lazy.pm
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Log.pm
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/MyFilm.pm
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/MyFoo.pm
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/MyStar.pm
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/MyStarLink.pm
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/MyStarLinkMCPK.pm
DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Order.pm
DBIx-Class/0.08/branches/multi_stuff/t/lib/DBIC/DebugObj.pm
DBIx-Class/0.08/branches/multi_stuff/t/lib/DBIC/SqlMakerTest.pm
DBIx-Class/0.08/branches/multi_stuff/t/lib/DBICTest/Schema.pm
DBIx-Class/0.08/branches/multi_stuff/t/lib/DBICTest/Schema/Artist.pm
DBIx-Class/0.08/branches/multi_stuff/t/lib/DBICTest/Schema/EventTZ.pm
DBIx-Class/0.08/branches/multi_stuff/t/lib/sqlite.sql
Log:
r5338 at rkinyon-lt-osx (orig r5337): castaway | 2009-01-21 17:55:19 -0500
Docs fixed, tests not fail..
r5339 at rkinyon-lt-osx (orig r5338): ribasushi | 2009-01-23 02:37:10 -0500
Dev-Release 0.08099_06
r5340 at rkinyon-lt-osx (orig r5339): ribasushi | 2009-01-23 06:14:29 -0500
Some doc fixes by dandv
r5341 at rkinyon-lt-osx (orig r5340): ribasushi | 2009-01-23 07:45:43 -0500
more typo patches by dandv
r5346 at rkinyon-lt-osx (orig r5345): ribasushi | 2009-01-24 15:20:58 -0500
Add feature-list from nixed 09 branch
r5348 at rkinyon-lt-osx (orig r5347): ribasushi | 2009-01-25 04:54:03 -0500
Adjust MANIFEST
r5349 at rkinyon-lt-osx (orig r5348): ribasushi | 2009-01-25 05:09:41 -0500
First stab at restructuring with tests_recursive() - no functional changes
r5350 at rkinyon-lt-osx (orig r5349): ribasushi | 2009-01-25 05:46:50 -0500
ignore MANIFEST
r5352 at rkinyon-lt-osx (orig r5351): ribasushi | 2009-01-27 04:14:29 -0500
Test all available JSON:: implementations in 89dbicadmin.t
r5355 at rkinyon-lt-osx (orig r5354): ribasushi | 2009-01-28 02:45:46 -0500
Special treatment of windows users - you can not segfault in a fork as there is no proper fork()
r5356 at rkinyon-lt-osx (orig r5355): ribasushi | 2009-01-28 04:45:25 -0500
make load_optional_class smarter when confronted with a PAR environment
r5357 at rkinyon-lt-osx (orig r5356): ribasushi | 2009-01-28 05:07:01 -0500
Older versions behave erratically in the new reentrant test
r5358 at rkinyon-lt-osx (orig r5357): ribasushi | 2009-01-28 05:08:03 -0500
wording
r5359 at rkinyon-lt-osx (orig r5358): dhoss | 2009-01-28 06:06:08 -0500
Fixed spelling error
r5360 at rkinyon-lt-osx (orig r5359): dhoss | 2009-01-28 06:11:45 -0500
testing dhoss's permissions
r5361 at rkinyon-lt-osx (orig r5360): dhoss | 2009-01-28 06:13:25 -0500
removed test variable
r5365 at rkinyon-lt-osx (orig r5364): ribasushi | 2009-01-29 03:44:25 -0500
Backporting uncovered an incomplete test
r5369 at rkinyon-lt-osx (orig r5368): ribasushi | 2009-01-29 04:14:31 -0500
Sanify 746mssql.t
r5371 at rkinyon-lt-osx (orig r5370): ribasushi | 2009-01-29 04:41:53 -0500
A pass is not strictly necessary for a test connection
r5372 at rkinyon-lt-osx (orig r5371): ribasushi | 2009-01-29 09:29:22 -0500
More verbosity as tomboh suggested
r5374 at rkinyon-lt-osx (orig r5373): ribasushi | 2009-01-29 13:45:46 -0500
Add the sqla test harness to the stopgap branch
r5380 at rkinyon-lt-osx (orig r5379): jmmills | 2009-01-29 20:37:01 -0500
Added a more verbose non column accessor example.
r5381 at rkinyon-lt-osx (orig r5380): jmmills | 2009-01-29 20:42:02 -0500
editorial typo in my previous commit.
r5383 at rkinyon-lt-osx (orig r5382): semifor | 2009-01-30 08:54:42 -0500
Bring test current with DBICTest schema.
r5384 at rkinyon-lt-osx (orig r5383): castaway | 2009-01-30 09:27:38 -0500
DB2 compatibility fix, update test to add new artist column (ick)
remove code that calls now removed sub _RowNumberOver
r5385 at rkinyon-lt-osx (orig r5384): ribasushi | 2009-01-30 09:32:42 -0500
Add the _find_syntax caching back
r5386 at rkinyon-lt-osx (orig r5385): castaway | 2009-01-30 09:33:24 -0500
DB2 compat: add new artist rank field to col_info_for test
r5393 at rkinyon-lt-osx (orig r5392): ribasushi | 2009-01-31 15:40:50 -0500
pod align by dandv
r5394 at rkinyon-lt-osx (orig r5393): ribasushi | 2009-02-01 16:33:32 -0500
Fix the dbicadmin test for good
r5395 at rkinyon-lt-osx (orig r5394): ribasushi | 2009-02-01 17:44:39 -0500
Fix the dbicadmin test for good (take 2)
r5400 at rkinyon-lt-osx (orig r5399): ribasushi | 2009-02-02 12:38:16 -0500
Bring back _RowNumberOver deleted in the sqla commotion (revs: 5096,5322,5383)
r5401 at rkinyon-lt-osx (orig r5400): ribasushi | 2009-02-02 12:52:20 -0500
part 2
r5414 at rkinyon-lt-osx (orig r5413): ribasushi | 2009-02-05 04:09:39 -0500
Commit some debugging code
r5420 at rkinyon-lt-osx (orig r5419): plu | 2009-02-07 08:40:41 -0500
Possible to set locale in IC::DateTime extra => {} config
r5427 at rkinyon-lt-osx (orig r5426): ribasushi | 2009-02-07 12:57:53 -0500
Up trunk dependency versions
r5428 at rkinyon-lt-osx (orig r5427): ribasushi | 2009-02-07 12:59:04 -0500
Up dependency on SQLT (releasing now)
r5432 at rkinyon-lt-osx (orig r5431): groditi | 2009-02-09 15:27:27 -0500
backporting the set_column/store_column fix
r5433 at rkinyon-lt-osx (orig r5432): groditi | 2009-02-09 15:29:03 -0500
ahhhh my bad. svk patch ne patch. oops adding missing file
r5439 at rkinyon-lt-osx (orig r5438): ribasushi | 2009-02-10 05:18:09 -0500
Finally make the indexer happy wrt SQL::Translator::Parser::DBIx::Class
Hide DBIx::Class::CDBICompat::ColumnGroups::GrouperShim (was never indexed to begin with)
r5441 at rkinyon-lt-osx (orig r5440): ribasushi | 2009-02-10 06:19:20 -0500
More rh-bug related stuff:
- Improve message emmitted when confronted with a buggy system
- Port forgotten pieces from trunk to stopgap
r5442 at rkinyon-lt-osx (orig r5441): castaway | 2009-02-10 08:57:34 -0500
More docs, pointing at using deploy/create_ddl_dir
r5445 at rkinyon-lt-osx (orig r5444): castaway | 2009-02-10 16:41:58 -0500
1) Add docs to ATTRIBUTES to better explain where to use them
2) Make all() die if passed arguments.
r5447 at rkinyon-lt-osx (orig r5446): ribasushi | 2009-02-11 03:24:58 -0500
Test for resultset corruption by search()
r5448 at rkinyon-lt-osx (orig r5447): ribasushi | 2009-02-11 04:02:42 -0500
Add a weird extra test, that should work nevertheless
r5449 at rkinyon-lt-osx (orig r5448): ribasushi | 2009-02-11 04:17:55 -0500
Add missing shallow copy of seen_join
r5450 at rkinyon-lt-osx (orig r5449): ribasushi | 2009-02-11 05:37:36 -0500
make single() die if passed attributes
r5455 at rkinyon-lt-osx (orig r5454): nigel | 2009-02-11 10:07:28 -0500
r10743 at hex: nigel | 2009-02-11 15:07:05 +0000
Documentation update on startup speed
r5459 at rkinyon-lt-osx (orig r5458): groditi | 2009-02-11 20:49:26 -0500
fixed bug for undef_on_null_fk edge case
r5464 at rkinyon-lt-osx (orig r5463): nigel | 2009-02-12 09:27:38 -0500
r10772 at hex: nigel | 2009-02-12 14:27:22 +0000
Made update() on a rs that includes joins complain in the same way that delete() does. Added tests for both update and delete checks.
r5465 at rkinyon-lt-osx (orig r5464): plu | 2009-02-13 05:27:36 -0500
Refactored and re-added r5041: Split sql statements for deploy only if SQLT::Producer returned a scalar containing all statements to be executed
r5466 at rkinyon-lt-osx (orig r5465): caelum | 2009-02-13 05:40:55 -0500
Some fixes for Oracle edge cases
r5467 at rkinyon-lt-osx (orig r5466): ribasushi | 2009-02-13 05:45:46 -0500
Some forgotten tests
r5468 at rkinyon-lt-osx (orig r5467): caelum | 2009-02-13 06:29:37 -0500
Throw exception on invalidated session if in a transaction.
r5472 at rkinyon-lt-osx (orig r5471): ribasushi | 2009-02-14 19:44:02 -0500
Make 81transactions.t DBIC_TRACE friendly
r5473 at rkinyon-lt-osx (orig r5472): ribasushi | 2009-02-14 19:45:44 -0500
A dbh_do statement executed with bind values will confuse the hell out of DBIC running in DBIC_TRACE=1 mode - stop sending TMI to _query_[start|end] from within dbh_do/_do_query
r5475 at rkinyon-lt-osx (orig r5474): plu | 2009-02-15 09:20:25 -0500
RT#38251: DBIx::Class::Storage::DBI::Oracle::Generic does not handle fully-qualified table names
r5480 at rkinyon-lt-osx (orig r5479): caelum | 2009-02-15 18:30:00 -0500
Improved connected logic for Oracle storage
r5481 at rkinyon-lt-osx (orig r5480): caelum | 2009-02-15 19:20:27 -0500
sorry, I fucked up the indentation...
r5482 at rkinyon-lt-osx (orig r5481): ribasushi | 2009-02-16 03:48:49 -0500
Some cleanups of oracle patch
r5490 at rkinyon-lt-osx (orig r5489): robkinyon | 2009-02-16 16:27:49 -0500
Added a bit of explanation to resultsets to cut down on the repeated questions in #dbix-class
r5492 at rkinyon-lt-osx (orig r5491): robkinyon | 2009-02-16 17:09:12 -0500
r5378 at rkinyon-lt-osx (orig r5377): robkinyon | 2009-01-29 15:58:53 -0500
Branch for subquery support
r5443 at rkinyon-lt-osx (orig r5442): robkinyon | 2009-02-10 15:10:10 -0500
Added as_query to ResultSet with a couple tests
r5444 at rkinyon-lt-osx (orig r5443): robkinyon | 2009-02-10 15:23:27 -0500
Added as_query() support to ResultSetColumn
r5446 at rkinyon-lt-osx (orig r5445): robkinyon | 2009-02-10 17:53:48 -0500
Switched to use is_same_sql_bind() per ribasushi's suggestion
r5453 at rkinyon-lt-osx (orig r5452): robkinyon | 2009-02-11 09:45:23 -0500
check in bombing test for subquery-with-as_query
r5458 at rkinyon-lt-osx (orig r5457): robkinyon | 2009-02-11 11:24:11 -0500
Checking in failing test
r5470 at rkinyon-lt-osx (orig r5469): robkinyon | 2009-02-13 14:43:12 -0500
Added as_sql and as_subselect as wrappers around as_query
r5471 at rkinyon-lt-osx (orig r5470): robkinyon | 2009-02-13 14:56:40 -0500
Added a passing test for initial simple subqueries
r5479 at rkinyon-lt-osx (orig r5478): robkinyon | 2009-02-15 11:23:46 -0500
Subqueries are done
r5500 at rkinyon-lt-osx (orig r5499): norbi | 2009-02-17 15:09:40 -0500
r5616 at vger: mendel | 2009-02-17 20:39:09 +0100
* Fixed to make it work with [colname => value] bind value format of SQLA.
r5501 at rkinyon-lt-osx (orig r5500): norbi | 2009-02-17 15:09:47 -0500
r5621 at vger: mendel | 2009-02-17 21:09:08 +0100
* Updated POD for using PostgreSQL arrays because of the \[$sql, @bind] bind value format change of SQLA.
r5502 at rkinyon-lt-osx (orig r5501): norbi | 2009-02-17 15:44:19 -0500
r5624 at vger: mendel | 2009-02-17 21:11:58 +0100
* Fixed the initial DROP TABLE statement (used to drop the wrong table).
r5503 at rkinyon-lt-osx (orig r5502): norbi | 2009-02-17 15:44:26 -0500
r5625 at vger: mendel | 2009-02-17 21:43:54 +0100
* Fixed the bug with omitting 'FOR UPDATE'/'FOR SHARED' (introduced from the 'subquery' branch, made 72pg.t fail).
r5504 at rkinyon-lt-osx (orig r5503): norbi | 2009-02-17 15:56:09 -0500
r5628 at vger: mendel | 2009-02-17 21:55:54 +0100
* Added the missing POD of a sub.
r5505 at rkinyon-lt-osx (orig r5504): norbi | 2009-02-17 16:08:05 -0500
r5630 at vger: mendel | 2009-02-17 22:07:56 +0100
* Fixed the bug in the test that made it fail in the END block even if all tests were SKIPped.
r5506 at rkinyon-lt-osx (orig r5505): castaway | 2009-02-17 16:22:05 -0500
Add multiple database/schema FAQs
r5507 at rkinyon-lt-osx (orig r5506): norbi | 2009-02-17 16:22:57 -0500
r5632 at vger: mendel | 2009-02-17 22:22:50 +0100
* Added new test subs (is_same_sql, is_same_bind) and new predicate sub (eq_sql_bind) to DBIC::SqlMakerTest (SQL::Abstract::Test has these, so made them available here, too).
r5508 at rkinyon-lt-osx (orig r5507): caelum | 2009-02-17 16:58:34 -0500
minor Oracle changes
r5509 at rkinyon-lt-osx (orig r5508): caelum | 2009-02-17 17:39:59 -0500
changed WriteAll; to WriteAll(); in Makefile.PL because of some sort of installation weirdness in some places
r5510 at rkinyon-lt-osx (orig r5509): caelum | 2009-02-17 17:52:28 -0500
changed DBD::SQLite from a test_requires to a configure_requires
r5511 at rkinyon-lt-osx (orig r5510): norbi | 2009-02-17 18:09:49 -0500
r5635 at vger: mendel | 2009-02-18 00:09:36 +0100
* Added new TODO tests for bind attributes (for ->select, ->update, ->delete).
r5522 at rkinyon-lt-osx (orig r5521): jnapiorkowski | 2009-02-18 14:35:19 -0500
I guess ensure_connected does not have a return value... so I cannot use it. Fix for replication issue where replicants always get marked as unavailable even when there is no problem with them
r5526 at rkinyon-lt-osx (orig r5525): robkinyon | 2009-02-18 14:59:26 -0500
r5515 at rkinyon-lt-osx (orig r5514): robkinyon | 2009-02-17 21:37:09 -0500
Moved the actual subquery test to a new subquery testfile
r5516 at rkinyon-lt-osx (orig r5515): robkinyon | 2009-02-17 21:50:16 -0500
Added TODO tests for +select and from with as_query
r5517 at rkinyon-lt-osx (orig r5516): robkinyon | 2009-02-17 22:06:02 -0500
The tests are truly failing tests
r5518 at rkinyon-lt-osx (orig r5517): robkinyon | 2009-02-18 11:52:42 -0500
as_query now provides its own parens
r5519 at rkinyon-lt-osx (orig r5518): robkinyon | 2009-02-18 14:10:51 -0500
Alias properly checks ->{attrs}{alias}
r5520 at rkinyon-lt-osx (orig r5519): robkinyon | 2009-02-18 14:13:27 -0500
Fixed a test expectation so the right failure is reported
r5521 at rkinyon-lt-osx (orig r5520): robkinyon | 2009-02-18 14:19:28 -0500
Marked tests as TODO for later
r5523 at rkinyon-lt-osx (orig r5522): robkinyon | 2009-02-18 14:54:31 -0500
Added my name
r5524 at rkinyon-lt-osx (orig r5523): robkinyon | 2009-02-18 14:58:21 -0500
Added some more POD in the Cookbook for correlated subqueries
r5527 at rkinyon-lt-osx (orig r5526): castaway | 2009-02-18 16:52:02 -0500
Improved docs/description lots
Property changes on: DBIx-Class/0.08/branches/multi_stuff
___________________________________________________________________
Name: svn:ignore
- _build
blib
pm_to_blib
Build
Build.bat
Makefile
Makefile.old
inc
README
META.yml
+ _build
blib
pm_to_blib
Build
Build.bat
Makefile
Makefile.old
inc
README
META.yml
MANIFEST
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:5420
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
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/complex_join_rels:4589
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/file_column:3920
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle_sequence:4173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/parser_fk_index:4485
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/replication_dedux:4600
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/versioned_enhancements:4125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioning:4578
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:5635
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_trunk:10772
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/complex_join_rels:4589
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/file_column:3920
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle_sequence:4173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/parser_fk_index:4485
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/replication_dedux:4600
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/subquery:5524
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/trunk:5526
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:3606
fe160bb6-dc1c-0410-9f2b-d64a711b54a5:/local/DBIC-trunk-0.08:10510
Modified: DBIx-Class/0.08/branches/multi_stuff/Changes
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/Changes 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/Changes 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,4 +1,11 @@
Revision history for DBIx::Class
+ - Possible to set locale in IC::DateTime extra => {} config
+ - Calling the accessor of a belongs_to when the foreign_key
+ was NULL and the row was not stored would unexpectedly fail (groditi)
+ - Split sql statements for deploy only if SQLT::Producer returned a scalar
+ containing all statements to be executed
+
+0.08099_06 2009-01-23 07:30:00 (UTC)
- Allow a scalarref to be supplied to the 'from' resultset attribute
- Classes submitted as result_class for a resultsource are now
automatically loaded via ensure_loaded()
@@ -16,7 +23,6 @@
- PG array datatype supported with SQLA >= 1.50
- insert should use store_column, not set_column to avoid marking
clean just-stored values as dirty. New test for this (groditi)
- - regression test for source_name (groditi)
0.08099_05 2008-10-30 21:30:00 (UTC)
- Rewritte of Storage::DBI::connect_info(), extended with an
Added: DBIx-Class/0.08/branches/multi_stuff/Features_09
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/Features_09 (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/Features_09 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,66 @@
+(Potential) Features for 0.09
+=============================
+
+Subselects - everyone wants these
+ - Will require new/improved SQL::Abstract
+ - The API will involve passing ResultSets to searches as conditions/values/whatever.
+
+Row/find caching - would be pretty useful
+ - Need to have good definitions of when the cache should be queried and when invalidated
+ - Be able to supply own expiry?
+ - Be able to invalidate manually? Single item / entire cache / single table
+
+Deprecate compose_connection / DB.pm
+ - Everyone has probably forgotten what this is anyway..
+
+Syntax improvements?
+ - "as" to "alias" ?
+ - "belongs_to" to "contains/refers/something"
+ - order_by to take a arrayref/hashref so it also just works with quoting
+ - ??
+
+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!
+ - function calls on the LHS of conditions..
+
+Moosification - ouch
+
+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
+ - better cross-db code .. eg LIKE/ILIKE
+
+Relationships
+ - single vs filter, discrepancies.. remove one of them and make behave the same?
+
+SQL::Abstract et al
+ - be able to extract/view/dump what the SQL is *going to* be before running it
+ - bind params sanity? (order of bind params broken when using a resultsource based on a select statement)
+ - etc
+
+Joining/searching weird attribute tables?
+ - Support legacy/badly designed junk better..
+
+Documentation - improvements
+ - better indexing for finding of stuff in general
+ - more cross-referencing of docs
+
Property changes on: DBIx-Class/0.08/branches/multi_stuff/Features_09
___________________________________________________________________
Name: svn:mergeinfo
+
Modified: DBIx-Class/0.08/branches/multi_stuff/MANIFEST.SKIP
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/MANIFEST.SKIP 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/MANIFEST.SKIP 2009-02-19 03:04:53 UTC (rev 5529)
@@ -14,6 +14,7 @@
# for developers only :)
^TODO$
+^Features_09$
# Avoid Module::Build generated and utility files.
\bBuild$
@@ -40,8 +41,9 @@
# Skip maint stuff
^maint/
-# Avoid copies to .orig
+# Avoid patch remnants
\.orig$
+\.rej$
# Dont use Module::Build anymore
^Build.PL$
Modified: DBIx-Class/0.08/branches/multi_stuff/Makefile.PL
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/Makefile.PL 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/Makefile.PL 2009-02-19 03:04:53 UTC (rev 5529)
@@ -10,17 +10,17 @@
requires 'Data::Page' => 2.00;
requires 'Scalar::Util' => 0;
-requires 'SQL::Abstract' => 1.20;
-requires 'SQL::Abstract::Limit' => 0.101;
-requires 'Class::C3' => 0.13;
+requires 'SQL::Abstract' => 1.24;
+requires 'SQL::Abstract::Limit' => 0.13;
+requires 'Class::C3' => 0.20;
requires 'Class::C3::Componentised' => 0;
requires 'Storable' => 0;
requires 'Carp::Clan' => 0;
requires 'DBI' => 1.40;
requires 'Module::Find' => 0;
requires 'Class::Inspector' => 0;
-requires 'Class::Accessor::Grouped' => 0.05002;
-requires 'JSON::Any' => 1.00;
+requires 'Class::Accessor::Grouped' => 0.08002;
+requires 'JSON::Any' => 1.17;
requires 'Scope::Guard' => 0.03;
requires 'Path::Class' => 0;
requires 'List::Util' => 1.19;
@@ -29,7 +29,8 @@
# Perl 5.8.0 doesn't have utf8::is_utf8()
requires 'Encode' => 0 if ($] <= 5.008000);
-test_requires 'DBD::SQLite' => 1.14;
+configure_requires 'DBD::SQLite' => 1.14;
+
test_requires 'Test::Builder' => 0.33;
test_requires 'Test::Warn' => 0.11;
test_requires 'Test::Exception' => 0;
@@ -37,7 +38,7 @@
install_script 'script/dbicadmin';
-tests "t/*.t t/*/*.t";
+tests_recursive 't';
# re-build README and require CDBI modules for testing if we're in a checkout
@@ -64,14 +65,44 @@
auto_install;
# Have all prerequisites, check DBD::SQLite sanity
-{
+if (! $ENV{DBICTEST_NO_SQLITE_CHECK} ) {
+
my $pid = fork();
if (not defined $pid) {
die "Unable to fork(): $!";
}
elsif (! $pid) {
+
+ # Win32 does not have real fork()s so a segfault will bring
+ # everything down. Warn about it.
+ if ($^O eq 'MSWin32') {
+ print <<'EOW';
+
+######################################################################
+# #
+# A short stress-testing of DBD::SQLite will follow. If you have a #
+# buggy library this might very well be the last text you will see #
+# before the installation silently terminates. If this happens it #
+# would mean that you are running a buggy version of DBD::SQLite #
+# known to randomly segfault on errors. Even if you have the latest #
+# CPAN module version, the system sqlite3 dynamic library might have #
+# been compiled against an older buggy sqlite3 dev library (oddly #
+# DBD::SQLite will prefer the system library against the one bundled #
+# with it). You are strongly advised to resolve this issue before #
+# proceeding. #
+# #
+# If this happens to you (this text is the last thing you see), and #
+# you just want to install this module without worrying about the #
+# tests (which will almost certainly fail) - set the environment #
+# variable DBICTEST_NO_SQLITE_CHECK to a true value and try again. #
+# #
+######################################################################
+
+EOW
+ }
+
require DBI;
- for (1 .. 10) {
+ for (1 .. 100) {
my $dbh;
$dbh = DBI->connect ('dbi:SQLite::memory:', undef, undef, {
AutoCommit => 1,
@@ -92,14 +123,16 @@
if ($sig == 11) {
warn (<<EOE);
-############################### WARNING ###################################
-# #
-# You are running a buggy version of DBD::SQLite known to randomly #
-# segfault on errors. Even if you have the latest CPAN module version, #
-# the actual sqlite3.so might have been compiled against an older buggy #
-# sqlite3 dev library. You are strongly advised to update DBD::SQLite. #
-# #
-###########################################################################
+############################### WARNING #################################
+# #
+# You are running a buggy version of DBD::SQLite known to randomly #
+# segfault on errors. Even if you have the latest CPAN module version, #
+# the sqlite3 dynamic library on this system might have been compiled #
+# against an older buggy sqlite3 dev library (oddly DBD::SQLite will #
+# prefer the system library against the one bundled with it). You are #
+# strongly advised to resolve this issue before proceeding. #
+# #
+#########################################################################
EOE
my $ans = prompt (
@@ -113,7 +146,7 @@
}
-WriteAll;
+WriteAll();
if ($Module::Install::AUTHOR) {
@@ -145,6 +178,3 @@
];
Meta->write;
}
-
-
-
Copied: DBIx-Class/0.08/branches/multi_stuff/examples (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/examples)
Property changes on: DBIx-Class/0.08/branches/multi_stuff/examples
___________________________________________________________________
Name: svn:mergeinfo
+
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Componentised.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Componentised.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Componentised.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -36,12 +36,20 @@
# successfully, and false if the class is not installed
sub load_optional_class {
my ($class, $f_class) = @_;
- if ($class->ensure_class_found($f_class)) {
- $class->ensure_class_loaded($f_class);
+ eval { $class->ensure_class_loaded($f_class) };
+ my $err = $@; # so we don't lose it
+ if (! $err) {
return 1;
- } else {
- return 0;
}
+ else {
+ my $fn = (join ('/', split ('::', $f_class) ) ) . '.pm';
+ if ($err =~ /Can't locate ${fn} in \@INC/ ) {
+ return 0;
+ }
+ else {
+ die $err;
+ }
+ }
}
1;
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/InflateColumn/DateTime.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/InflateColumn/DateTime.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/InflateColumn/DateTime.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -27,10 +27,10 @@
print "This event starts the month of ".
$event->starts_when->month_name();
-If you want to set a specific timezone for that field, use:
+If you want to set a specific timezone and locale for that field, use:
__PACKAGE__->add_columns(
- starts_when => { data_type => 'datetime', extra => { timezone => "America/Chicago" } }
+ starts_when => { data_type => 'datetime', extra => { timezone => "America/Chicago", locale => "de_DE" } }
);
If you want to inflate no matter what data_type your column is,
@@ -110,10 +110,15 @@
}
my $timezone;
- if ( exists $info->{extra} and exists $info->{extra}{timezone} and defined $info->{extra}{timezone} ) {
+ if ( defined $info->{extra}{timezone} ) {
$timezone = $info->{extra}{timezone};
}
+ my $locale;
+ if ( defined $info->{extra}{locale} ) {
+ $locale = $info->{extra}{locale};
+ }
+
my $undef_if_invalid = $info->{datetime_undef_if_invalid};
if ($type eq 'datetime' || $type eq 'date') {
@@ -143,6 +148,7 @@
die "Error while inflating ${value} for ${column} on ${self}: $@"
if $@ and not $undef_if_invalid;
$dt->set_time_zone($timezone) if $timezone;
+ $dt->set_locale($locale) if $locale;
return $dt;
},
deflate => sub {
@@ -154,6 +160,7 @@
and not $floating_tz_ok
and not $ENV{DBIC_FLOATING_TZ_OK};
$value->set_time_zone($timezone);
+ $value->set_locale($locale) if $locale;
}
$obj->_datetime_parser->$format($value);
},
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Manual/Cookbook.pod
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Manual/Cookbook.pod 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Manual/Cookbook.pod 2009-02-19 03:04:53 UTC (rev 5529)
@@ -295,6 +295,49 @@
are in any way unsure about the use of the attributes above (C< join
>, C< select >, C< as > and C< group_by >).
+=head2 Subqueries
+
+You can write subqueries relatively easily in DBIC.
+
+ my $inside_rs = $schema->resultset('Artist')->search({
+ name => [ 'Billy Joel', 'Brittany Spears' ],
+ });
+
+ my $rs = $schema->resultset('CD')->search({
+ artist_id => { 'IN' => $inside_rs->get_column('id')->as_query },
+ });
+
+The usual operators ( =, !=, IN, NOT IN, etc) are supported.
+
+B<NOTE>: You have to explicitly use '=' when doing an equality comparison.
+The following will B<not> work:
+
+ my $rs = $schema->resultset('CD')->search({
+ artist_id => $inside_rs->get_column('id')->as_query,
+ });
+
+=head3 Correlated subqueries
+
+ my $cdrs = $schema->resultset('CD');
+ my $rs = $cdrs->search({
+ year => {
+ '=' => $cdrs->search(
+ { artistid => { '=' => \'me.artistid' } },
+ { alias => 'inner' }
+ )->get_column('year')->max_rs->as_query,
+ },
+ });
+
+That creates the following SQL:
+
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+ FROM cd me
+ WHERE year = (
+ SELECT MAX(inner.year)
+ FROM cd inner
+ WHERE artistid = me.artistid
+ )
+
=head2 Predefined searches
You can write your own L<DBIx::Class::ResultSet> class by inheriting from it
@@ -812,7 +855,7 @@
my $hash_ref = $rs->find(1);
Wasn't that easy?
-
+
=head2 Get raw data for blindingly fast results
If the L<HashRefInflator|DBIx::Class::ResultClass::HashRefInflator> solution
@@ -1358,12 +1401,16 @@
$resultset->search(
{
- numbers => \[ '= ?', [1, 2, 3] ]
+ numbers => \[ '= ?', [numbers => [1, 2, 3]] ]
}
);
See L<SQL::Abstract/array_datatypes> and L<SQL::Abstract/Literal SQL with
-placeholders and bind values (subqueries)> for more explanation.
+placeholders and bind values (subqueries)> for more explanation. Note that
+L<DBIx::Class> sets L<SQL::Abstract/bindtype> to C<columns>, so you must pass
+the bind values (the C<[1, 2, 3]> arrayref in the above example) wrapped in
+arrayrefs together with the column name, like this: C<< [column_name => value]
+>>.
=head1 BOOTSTRAPPING/MIGRATING
@@ -1618,5 +1665,67 @@
statement and dig down to see if certain parameters cause aberrant behavior.
You might want to check out L<DBIx::Class::QueryLog> as well.
+=head1 STARTUP SPEED
+L<DBIx::Class|DBIx::Class> programs can have a significant startup delay
+as the ORM loads all the relevant classes. This section examines
+techniques for reducing the startup delay.
+
+These tips are are listed in order of decreasing effectiveness - so the
+first tip, if applicable, should have the greatest effect on your
+application.
+
+=head2 Statically Define Your Schema
+
+If you are using
+L<DBIx::Class::Schema::Loader|DBIx::Class::Schema::Loader> to build the
+classes dynamically based on the database schema then there will be a
+significant startup delay.
+
+For production use a statically defined schema (which can be generated
+using L<DBIx::Class::Schema::Loader|DBIx::Class::Schema::Loader> to dump
+the database schema once - see
+L<make_schema_at|DBIx::Class::Schema::Loader/make_schema_at> and
+L<dump_directory|DBIx::Class::Schema::Loader/dump_directory> for more
+details on creating static schemas from a database).
+
+=head2 Move Common Startup into a Base Class
+
+Typically L<DBIx::Class> result classes start off with
+
+ use base qw/DBIx::Class/;
+ __PACKAGE__->load_components(qw/InflateColumn::DateTime Core/);
+
+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;
+
+and each result class then uses this as a base:-
+
+ use base qw/MyDBICbase/;
+
+then the load_components is only performed once, which can result in a
+considerable startup speedup for schemas with many classes.
+
+=head2 Explicitly List Schema Result Classes
+
+The schema class will normally contain
+
+ __PACKAGE__->load_classes();
+
+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:-
+
+ __PACKAGE__->load_classes(qw/ CD Artist Track /);
+
+If you are instead using the L<load_namespaces|DBIx::Class::Schema/load_namespaces>
+syntax to load the appropriate classes there is not a direct alternative
+avoiding L<Module::Find|Module::Find>.
+
=cut
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Manual/FAQ.pod
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Manual/FAQ.pod 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Manual/FAQ.pod 2009-02-19 03:04:53 UTC (rev 5529)
@@ -68,7 +68,25 @@
be alarmed if the error from incorrect connection details happens a
lot later.
+=item .. use DBIx::Class across multiple databases?
+If your database server allows you to run querys across multiple
+databases at once, then so can DBIx::Class. All you need to do is make
+sure you write the database name as part of the
+L<DBIx::Class::ResultSource/table> call. Eg:
+
+ __PACKAGE__->table('mydb.mytablename');
+
+And load all the Result classes for both / all databases using one
+L<DBIx::Class::Schema/load_namespaces> call.
+
+=item .. use DBIx::Class across PostgreSQL/DB2/Oracle schemas?
+
+Add the name of the schema to the L<DBIx::Class::ResultSource/table>
+as part of the name, and make sure you give the one user you are going
+to connect with rights to read/write all the schemas/tables as
+necessary.
+
=back
=head2 Relationships
@@ -428,6 +446,41 @@
You can add your own data accessors to your classes.
+One method is to use the built in mk_group_accessors (via L<Class::Accessor::Grouped>)
+
+ package MyTable;
+
+ use parent 'DBIx::Class';
+
+ __PACKAGE__->table('foo'); #etc
+ __PACKAGE__->mk_group_accessors('simple' => qw/non_column_data/); # must use simple group
+
+An another method is to use L<Moose> with your L<DBIx::Class> package.
+
+ package MyTable;
+
+ use Moose; # import Moose
+ use Moose::Util::TypeConstraint; # import Moose accessor type constraints
+
+ extends 'DBIx::Class'; # Moose changes the way we define our parent (base) package
+
+ has 'non_column_data' => ( is => 'rw', isa => 'Str' ); # define a simple attribute
+
+ __PACKAGE__->table('foo'); # etc
+
+With either of these methods the resulting use of the accesssor would be
+
+ my $row;
+
+ # assume that some where in here $row will get assigned to a MyTable row
+
+ $row->non_column_data('some string'); # would set the non_column_data accessor
+
+ # some other stuff happens here
+
+ $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
@@ -462,6 +515,16 @@
$resultset->set_primary_key(@column);
+=item How do I make my program start faster?
+
+Look at the tips in L<DBIx::Class::Manual::Cookbook/"STARTUP SPEED">
+
+=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">
+and L<DBIx::Class::Manual::Cookbook/"Get raw data for blindingly fast results">
+
=back
=head2 Notes for CDBI users
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Relationship/Accessor.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Relationship/Accessor.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Relationship/Accessor.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -31,6 +31,7 @@
$rel_info->{cond}, $rel, $self
);
if ($rel_info->{attrs}->{undef_on_null_fk}){
+ return unless ref($cond) eq 'HASH';
return if grep { not defined } values %$cond;
}
my $val = $self->find_related($rel, {}, {});
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSet.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSet.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -19,39 +19,123 @@
=head1 NAME
-DBIx::Class::ResultSet - Responsible for fetching and creating resultset.
+DBIx::Class::ResultSet - Represents a query used for fetching a set of results.
=head1 SYNOPSIS
- my $rs = $schema->resultset('User')->search({ registered => 1 });
- my @rows = $schema->resultset('CD')->search({ year => 2005 })->all();
+ my $users_rs = $schema->resultset('User');
+ my $registered_users_rs = $schema->resultset('User')->search({ registered => 1 });
+ my @cds_in_2005 = $schema->resultset('CD')->search({ year => 2005 })->all();
=head1 DESCRIPTION
-The resultset is also known as an iterator. It is responsible for handling
-queries that may return an arbitrary number of rows, e.g. via L</search>
-or a C<has_many> relationship.
+A ResultSet is an object which stores a set of conditions representing
+a query. It is the backbone of DBIx::Class (i.e. the really
+important/useful bit).
-In the examples below, the following table classes are used:
+No SQL is executed on the database when a ResultSet is created, it
+just stores all the conditions needed to create the query.
- package MyApp::Schema::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 => 'MyApp::Schema::CD');
- 1;
+A basic ResultSet representing the data of an entire table is returned
+by calling C<resultset> on a L<DBIx::Class::Schema> and passing in a
+L<Source|DBIx::Class::Manual::Glossary/Source> name.
- package MyApp::Schema::CD;
- use base qw/DBIx::Class/;
- __PACKAGE__->load_components(qw/Core/);
- __PACKAGE__->table('cd');
- __PACKAGE__->add_columns(qw/cdid artist title year/);
- __PACKAGE__->set_primary_key('cdid');
- __PACKAGE__->belongs_to(artist => 'MyApp::Schema::Artist');
- 1;
+ my $users_rs = $schema->resultset('User');
+A new ResultSet is returned from calling L</search> on an existing
+ResultSet. The new one will contain all the conditions of the
+original, plus any new conditions added in the C<search> call.
+
+A ResultSet is also an iterator. L</next> is used to return all the
+L<DBIx::Class::Row>s the ResultSet represents.
+
+The query that the ResultSet represents is B<only> executed against
+the database when these methods are called:
+
+=over
+
+=item L</find>
+
+=item L</next>
+
+=item L</all>
+
+=item L</count>
+
+=item L</single>
+
+=item L</first>
+
+=back
+
+=head1 EXAMPLES
+
+=head2 Chaining resultsets
+
+Let's say you've got a query that needs to be run to return some data
+to the user. But, you have an authorization system in place that
+prevents certain users from seeing certain information. So, you want
+to construct the basic query in one method, but add constraints to it in
+another.
+
+ sub get_data {
+ my $self = shift;
+ my $request = $self->get_request; # Get a request object somehow.
+ my $schema = $self->get_schema; # Get the DBIC schema object somehow.
+
+ my $cd_rs = $schema->resultset('CD')->search({
+ title => $request->param('title'),
+ year => $request->param('year'),
+ });
+
+ $self->apply_security_policy( $cd_rs );
+
+ return $cd_rs->all();
+ }
+
+ sub apply_security_policy {
+ my $self = shift;
+ my ($rs) = @_;
+
+ return $rs->search({
+ subversive => 0,
+ });
+ }
+
+=head2 Multiple queries
+
+Since a resultset just defines a query, you can do all sorts of
+things with it with the same object.
+
+ # Don't hit the DB yet.
+ my $cd_rs = $schema->resultset('CD')->search({
+ title => 'something',
+ year => 2009,
+ });
+
+ # Each of these hits the DB individually.
+ my $count = $cd_rs->count;
+ my $most_recent = $cd_rs->get_column('date_released')->max();
+ my @records = $cd_rs->all;
+
+And it's not just limited to SELECT statements.
+
+ $cd_rs->delete();
+
+This is even cooler:
+
+ $cd_rs->create({ artist => 'Fred' });
+
+Which is the same as:
+
+ $schema->resultset('CD')->create({
+ title => 'something',
+ year => 2009,
+ artist => 'Fred'
+ });
+
+See: L</search>, L</count>, L</get_column>, L</all>, L</create>.
+
=head1 OVERLOADING
If a resultset is used in a numeric context it returns the L</count>.
@@ -607,6 +691,10 @@
sub single {
my ($self, $where) = @_;
+ if(@_ > 2) {
+ $self->throw_exception('single() only takes search conditions, no attributes. You want ->search( $cond, $attrs )->single()');
+ }
+
my $attrs = { %{$self->_resolved_attrs} };
if ($where) {
if (defined $attrs->{where}) {
@@ -1109,7 +1197,11 @@
=cut
sub all {
- my ($self) = @_;
+ my $self = shift;
+ if(@_) {
+ $self->throw_exception("all() doesn't take any arguments, you probably wanted ->search(...)->all()");
+ }
+
return @{ $self->get_cache } if $self->get_cache;
my @obj;
@@ -1261,6 +1353,11 @@
$self->throw_exception("Values for update must be a hash")
unless ref $values eq 'HASH';
+ carp( 'WARNING! Currently $rs->update() does not generate proper SQL'
+ . ' on joined resultsets, and may affect rows well outside of the'
+ . ' contents of $rs. Use at your own risk' )
+ if ( $self->{attrs}{seen_join} );
+
my $cond = $self->_cond_for_update_delete;
return $self->result_source->storage->update(
@@ -1506,7 +1603,7 @@
=head2 _normalize_populate_args ($args)
-Private method used by L</populate> to normalize it's incoming arguments. Factored
+Private method used by L</populate> to normalize its incoming arguments. Factored
out in case you want to subclass and accept new argument structures to the
L</populate> method.
@@ -1709,6 +1806,24 @@
return \%unaliased;
}
+=head2 as_query
+
+=over 4
+
+=item Arguments: none
+
+=item Return Value: \[ $sql, @bind ]
+
+=back
+
+Returns the SQL query and bind vars associated with the invocant.
+
+This is generally used as the RHS for a subquery.
+
+=cut
+
+sub as_query { return shift->cursor->as_query(@_) }
+
=head2 find_or_new
=over 4
@@ -1725,7 +1840,7 @@
$cd->cd_to_producer->find_or_new({ producer => $producer },
{ key => 'primary });
-Find an existing record from this resultset, based on it's primary
+Find an existing record from this resultset, based on its primary
key, or a unique constraint. If none exists, instantiate a new result
object and return it. The object will not be saved into your storage
until you call L<DBIx::Class::Row/insert> on it.
@@ -1771,7 +1886,7 @@
pairs representing the columns of the table and the values you wish to
store. If the appropriate relationships are set up, foreign key fields
can also be passed an object representing the foreign row, and the
-value will be set to it's primary key.
+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>),
@@ -1790,7 +1905,7 @@
$person_rs->create({
name=>"Some Person",
- email=>"somebody at someplace.com"
+ email=>"somebody at someplace.com"
});
Example of creating a new row and also creating rows in a related C<has_many>
@@ -1809,10 +1924,10 @@
$cd_rs->create({
title=>"Music for Silly Walks",
- year=>2000,
- artist => {
- name=>"Silly Musician",
- }
+ year=>2000,
+ artist => {
+ name=>"Silly Musician",
+ }
});
=cut
@@ -2209,7 +2324,7 @@
push(@{$attrs->{as}}, @$adds);
}
- $attrs->{from} ||= [ { 'me' => $source->from } ];
+ $attrs->{from} ||= [ { $self->{attrs}{alias} => $source->from } ];
if (exists $attrs->{join} || exists $attrs->{prefetch}) {
my $join = delete $attrs->{join} || {};
@@ -2242,7 +2357,7 @@
if (my $prefetch = delete $attrs->{prefetch}) {
$prefetch = $self->_merge_attr({}, $prefetch);
my @pre_order;
- my $seen = $attrs->{seen_join} || {};
+ my $seen = { %{ $attrs->{seen_join} || {} } };
foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) {
# bring joins back to level of current class
my @prefetch = $source->resolve_prefetch(
@@ -2398,9 +2513,13 @@
=head1 ATTRIBUTES
-The resultset takes various attributes that modify its behavior. Here's an
-overview of them:
+Attributes are used to refine a ResultSet in various ways when
+searching for data. They can be passed to any method which takes an
+C<\%attrs> argument. See L</search>, L</search_rs>, L</find>,
+L</count>.
+These are in no particular order:
+
=head2 order_by
=over 4
@@ -2492,7 +2611,7 @@
=over 4
-Indicates additional column names for those added via L</+select>.
+Indicates additional column names for those added via L</+select>. See L</as>.
=back
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSetColumn.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSetColumn.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSetColumn.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -54,6 +54,24 @@
return $new;
}
+=head2 as_query
+
+=over 4
+
+=item Arguments: none
+
+=item Return Value: \[ $sql, @bind ]
+
+=back
+
+Returns the SQL query and bind vars associated with the invocant.
+
+This is generally used as the RHS for a subquery.
+
+=cut
+
+sub as_query { return shift->_resultset->as_query }
+
=head2 next
=over 4
@@ -168,6 +186,24 @@
return shift->func('MIN');
}
+=head2 min_rs
+
+=over 4
+
+=item Arguments: none
+
+=item Return Value: $resultset
+
+=back
+
+ my $rs = $year_col->min_rs();
+
+Wrapper for ->func_rs for function MIN().
+
+=cut
+
+sub min_rs { return shift->func_rs('MIN') }
+
=head2 max
=over 4
@@ -189,6 +225,24 @@
return shift->func('MAX');
}
+=head2 max_rs
+
+=over 4
+
+=item Arguments: none
+
+=item Return Value: $resultset
+
+=back
+
+ my $rs = $year_col->max_rs();
+
+Wrapper for ->func_rs for function MAX().
+
+=cut
+
+sub max_rs { return shift->func_rs('MAX') }
+
=head2 sum
=over 4
@@ -210,6 +264,24 @@
return shift->func('SUM');
}
+=head2 sum_rs
+
+=over 4
+
+=item Arguments: none
+
+=item Return Value: $resultset
+
+=back
+
+ my $rs = $year_col->sum_rs();
+
+Wrapper for ->func_rs for function SUM().
+
+=cut
+
+sub sum_rs { return shift->func_rs('SUM') }
+
=head2 func
=over 4
@@ -232,7 +304,7 @@
sub func {
my ($self,$function) = @_;
- my $cursor = $self->{_parent_resultset}->search(undef, {select => {$function => $self->{_select}}, as => [$self->{_as}]})->cursor;
+ my $cursor = $self->func_rs($function)->cursor;
if( wantarray ) {
return map { $_->[ 0 ] } $cursor->all;
@@ -241,6 +313,30 @@
return ( $cursor->next )[ 0 ];
}
+=head2 func_rs
+
+=over 4
+
+=item Arguments: $function
+
+=item Return Value: $resultset
+
+=back
+
+Creates the resultset that C<func()> uses to run its query.
+
+=cut
+
+sub func_rs {
+ my ($self,$function) = @_;
+ return $self->{_parent_resultset}->search(
+ undef, {
+ select => {$function => $self->{_select}},
+ as => [$self->{_as}],
+ },
+ );
+}
+
=head2 throw_exception
See L<DBIx::Class::Schema/throw_exception> for details.
@@ -278,7 +374,6 @@
);
}
-
1;
=head1 AUTHORS
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSource.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSource.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/ResultSource.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -72,7 +72,7 @@
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
+L<DBIx::Class::Row> objects. You can change the name of the accessor
by supplying an L</accessor> in the column_info hash.
The contents of the column_info are not set in stone. The following
@@ -136,7 +136,7 @@
=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
+automatically from an oracle sequence. If you do not use an Oracle
trigger to get the nextval, you have to set sequence as well.
=item extra
@@ -544,6 +544,76 @@
return @{ $unique_constraints{$constraint_name} };
}
+=head2 sqlt_deploy_callback
+
+=over
+
+=item Arguments: $callback
+
+=back
+
+ __PACKAGE__->sqlt_deploy_callback('mycallbackmethod');
+
+An accessor to set a callback to be called during deployment of
+the schema via L<DBIx::Class::Schema/create_ddl_dir> or
+L<DBIx::Class::Schema/deploy>.
+
+The callback can be set as either a code reference or the name of a
+method in the current result class.
+
+If not set, the L</default_sqlt_deploy_hook> is called.
+
+Your callback will be passed the $source object representing the
+ResultSource instance being deployed, and the
+L<SQL::Translator::Schema::Table> object being created from it. The
+callback can be used to manipulate the table object or add your own
+customised indexes. If you need to manipulate a non-table object, use
+the L<DBIx::Class::Schema/sqlt_deploy_hook>.
+
+See L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To
+Your SQL> for examples.
+
+This sqlt deployment callback can only be used to manipulate
+SQL::Translator objects as they get turned into SQL. To execute
+post-deploy statements which SQL::Translator does not currently
+handle, override L<DBIx::Class::Schema/deploy> in your Schema class
+and call L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
+
+=head2 default_sqlt_deploy_hook
+
+=over
+
+=item Arguments: $source, $sqlt_table
+
+=item Return value: undefined
+
+=back
+
+This is the sensible default for L</sqlt_deploy_callback>.
+
+If a method named C<sqlt_deploy_hook> exists in your Result class, it
+will be called and passed the current C<$source> and the
+C<$sqlt_table> being deployed.
+
+=cut
+
+sub default_sqlt_deploy_hook {
+ my $self = shift;
+
+ my $class = $self->result_class;
+
+ if ($class and $class->can('sqlt_deploy_hook')) {
+ $class->sqlt_deploy_hook(@_);
+ }
+}
+
+sub _invoke_sqlt_deploy_hook {
+ my $self = shift;
+ if ( my $hook = $self->sqlt_deploy_callback) {
+ $self->$hook(@_);
+ }
+}
+
=head2 resultset
=over 4
@@ -577,7 +647,7 @@
$source->resultset_class('My::ResultSet::Class');
-Set the class of the resultset, this is useful if you want to create your
+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,
this method returns the name of the existing resultset class, if one
@@ -1367,8 +1437,6 @@
Creates a new ResultSource object. Not normally called directly by end users.
-=cut
-
=head2 column_info_from_storage
=over
@@ -1379,82 +1447,13 @@
=back
+ __PACKAGE__->column_info_from_storage(1);
+
Enables the on-demand automatic loading of the above column
metadata from storage as neccesary. This is *deprecated*, and
should not be used. It will be removed before 1.0.
- __PACKAGE__->column_info_from_storage(1);
-=head2 sqlt_deploy_callback
-
-An attribute which contains the callback to trigger on L</sqlt_deploy_hook>.
-Defaults to L</default_sqlt_deploy_hook>. Can be a code reference or the name
-of a method in the current result class. You would change the default value
-in case you want to share a hook between several result sources, or if you
-want to use a result source without a declared result class.
-
-=head2 default_sqlt_deploy_hook
-
-=over
-
-=item Arguments: $source, $sqlt_table
-
-=item Return value: undefined
-
-=back
-
-Proxies its arguments to a C<sqlt_deploy_hook> method on the C<result_class>
-if such a method exists. This is useful to make L<SQL::Translator> create
-non-unique indexes, or set table options such as C<Engine=INNODB>. For
-examples of what you can do with this, see
-L<DBIx::Class::Manual::Cookbook/Adding Indexes And Functions To Your SQL>.
-
-=cut
-
-sub default_sqlt_deploy_hook {
- my $self = shift;
-
- my $class = $self->result_class;
-
- if ($class and $class->can('sqlt_deploy_hook')) {
- $class->sqlt_deploy_hook(@_);
- }
-}
-
-
-=head2 sqlt_deploy_hook
-
-=over 4
-
-=item Arguments: $source, $sqlt_table
-
-=item Return value: undefined
-
-=back
-
-This is the entry point invoked by L<SQL::Translator::Parser::DBIx::Class>
-during the execution of L<DBIx::Class::Storage::DBI/deployment_statements>.
-Delegates to the method name or code reference specified in
-L</sqlt_deploy_callback>.
-
-Note that the code is called by
-L<DBIx::Class::Storage::DBI/deployment_statements>, which in turn is called
-before L<DBIx::Class::Schema/deploy>. Therefore the hook can be used only
-to manipulate the L<SQL::Translator::Table> object before it is turned into
-SQL fed to the database. If you want to execute post-deploy statements which
-currently can can not be generated by L<SQL::Translator>, the suggested
-method is to overload L<DBIx::Class::Storage/deploy> and use
-L<dbh_do|DBIx::Class::Storage::DBI/dbh_do>.
-
-=cut
-
-sub sqlt_deploy_hook {
- my $self = shift;
- if ( my $hook = $self->sqlt_deploy_callback) {
- $self->$hook(@_);
- }
-}
-
=head1 AUTHORS
Matt S. Trout <mst at shadowcatsystems.co.uk>
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Schema/Versioned.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Schema/Versioned.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Schema/Versioned.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -519,9 +519,9 @@
return;
}
- eval 'require SQL::Translator "0.09"';
+ eval 'require SQL::Translator "0.09003"';
if ($@) {
- $self->throw_exception("SQL::Translator 0.09 required");
+ $self->throw_exception("SQL::Translator 0.09003 required");
}
my $db_tr = SQL::Translator->new({
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Schema.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Schema.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Schema.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -89,7 +89,7 @@
matching is done by assuming the package name of the ResultSet class
is the same as that of the Result class.
-You will be warned if ResulSet classes are discovered for which there
+You will be warned if ResultSet classes are discovered for which there
are no matching Result classes like this:
load_namespaces found ResultSet class $classname with no corresponding Result class
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI/Cursor.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI/Cursor.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI/Cursor.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -49,6 +49,32 @@
return bless ($new, $class);
}
+=head2 as_query
+
+=over 4
+
+=item Arguments: none
+
+=item Return Value: \[ $sql, @bind ]
+
+=back
+
+Returns the SQL statement and bind vars associated with the invocant.
+
+=cut
+
+sub as_query {
+ my $self = shift;
+
+ my $storage = $self->{storage};
+ my $sql_maker = $storage->sql_maker;
+ local $sql_maker->{for};
+
+ my @args = $storage->_select_args(@{$self->{args}});
+ my ($sql, $bind) = $storage->_prep_for_execute(@args[0 .. 2], [@args[4 .. $#args]]);
+ return \[ "($sql)", @$bind ];
+}
+
=head2 next
=over 4
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -55,8 +55,23 @@
# trigger_body is a LONG
$dbh->{LongReadLen} = 64 * 1024 if ($dbh->{LongReadLen} < 64 * 1024);
- my $sth = $dbh->prepare($sql);
- $sth->execute( uc($source->name) );
+ my $sth;
+
+ # check for fully-qualified name (eg. SCHEMA.TABLENAME)
+ if ( my ( $schema, $table ) = $source->name =~ /(\w+)\.(\w+)/ ) {
+ $sql = q{
+ SELECT trigger_body FROM ALL_TRIGGERS t
+ WHERE t.owner = ? AND t.table_name = ?
+ AND t.triggering_event = 'INSERT'
+ AND t.status = 'ENABLED'
+ };
+ $sth = $dbh->prepare($sql);
+ $sth->execute( uc($schema), uc($table) );
+ }
+ else {
+ $sth = $dbh->prepare($sql);
+ $sth->execute( uc( $source->name ) );
+ }
while (my ($insert_trigger) = $sth->fetchrow_array) {
return uc($1) if $insert_trigger =~ m!(\w+)\.nextval!i; # col name goes here???
}
@@ -69,6 +84,72 @@
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 {
+ my $self = shift;
+
+ if (not $self->SUPER::connected(@_)) {
+ return 0;
+ }
+ else {
+ my $dbh = $self->_dbh;
+
+ local $dbh->{RaiseError} = 1;
+
+ eval {
+ my $ping_sth = $dbh->prepare_cached("select 1 from dual");
+ $ping_sth->execute;
+ $ping_sth->finish;
+ };
+
+ return $@ ? 0 : 1;
+ }
+}
+
+sub _dbh_execute {
+ my $self = shift;
+ my ($dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
+
+ my $wantarray = wantarray;
+
+ my (@res, $exception, $retried);
+
+ RETRY: {
+ do {
+ eval {
+ if ($wantarray) {
+ @res = $self->SUPER::_dbh_execute(@_);
+ } else {
+ $res[0] = $self->SUPER::_dbh_execute(@_);
+ }
+ };
+ $exception = $@;
+ if ($exception =~ /ORA-01003/) {
+ # ORA-01003: no statement parsed (someone changed the table somehow,
+ # invalidating your cursor.)
+ my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args);
+ delete $dbh->{CachedKids}{$sql};
+ } else {
+ last RETRY;
+ }
+ } while (not $retried++);
+ }
+
+ $self->throw_exception($exception) if $exception;
+
+ wantarray ? @res : $res[0]
+}
+
=head2 get_autoinc_seq
Returns the sequence name for an autoincrement column
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -187,17 +187,19 @@
sub _safely_ensure_connected {
my ($self, $replicant, @args) = @_;
- my $return; eval {
- $return = $replicant->ensure_connected(@args);
- }; if ($@) {
+ eval {
+ $replicant->ensure_connected(@args);
+ };
+ if ($@) {
$replicant
- ->debugobj
- ->print(
- sprintf( "Exception trying to ->ensure_connected for replicant %s, error is %s",
- $self->_dbi_connect_info->[0], $@)
+ ->debugobj
+ ->print(
+ sprintf( "Exception trying to ->ensure_connected for replicant %s, error is %s",
+ $replicant->_dbi_connect_info->[0], $@)
);
+ return;
}
- return $return;
+ return 1;
}
=head2 connected_replicants
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class/Storage/DBI.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -50,16 +50,46 @@
$self;
}
+# DB2 is the only remaining DB using this. Even though we are not sure if
+# RowNumberOver is still needed here (should be part of SQLA) leave the
+# code in place
+sub _RowNumberOver {
+ my ($self, $sql, $order, $rows, $offset ) = @_;
+
+ $offset += 1;
+ my $last = $rows + $offset;
+ my ( $order_by ) = $self->_order_by( $order );
+
+ $sql = <<"SQL";
+SELECT * FROM
+(
+ SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
+ $sql
+ $order_by
+ ) Q1
+) Q2
+WHERE ROW_NUM BETWEEN $offset AND $last
+
+SQL
+
+ return $sql;
+}
+
+
# While we're at it, this should make LIMIT queries more efficient,
# without digging into things too deeply
use Scalar::Util 'blessed';
sub _find_syntax {
my ($self, $syntax) = @_;
- my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax;
+
+ # DB2 is the only remaining DB using this. Even though we are not sure if
+ # RowNumberOver is still needed here (should be part of SQLA) leave the
+ # code in place
+ my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax;
if(ref($self) && $dbhname && $dbhname eq 'DB2') {
return 'RowNumberOver';
}
-
+
$self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
}
@@ -922,10 +952,18 @@
$self->_do_query($_) foreach @$action;
}
else {
- my @to_run = (ref $action eq 'ARRAY') ? (@$action) : ($action);
- $self->_query_start(@to_run);
- $self->_dbh->do(@to_run);
- $self->_query_end(@to_run);
+ # Most debuggers expect ($sql, @bind), so we need to exclude
+ # the attribute hash which is the second argument to $dbh->do
+ # furthermore the bind values are usually to be presented
+ # as named arrayref pairs, so wrap those here too
+ my @do_args = (ref $action eq 'ARRAY') ? (@$action) : ($action);
+ my $sql = shift @do_args;
+ my $attrs = shift @do_args;
+ my @bind = map { [ undef, $_ ] } @do_args;
+
+ $self->_query_start($sql, @bind);
+ $self->_dbh->do($sql, $attrs, @do_args);
+ $self->_query_end($sql, @bind);
}
return $self;
@@ -1135,11 +1173,15 @@
sub _prep_for_execute {
my ($self, $op, $extra_bind, $ident, $args) = @_;
+ if( blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
+ $ident = $ident->from();
+ }
+
my ($sql, @bind) = $self->sql_maker->$op($ident, @$args);
+
unshift(@bind,
map { ref $_ eq 'ARRAY' ? $_ : [ '!!dummy', $_ ] } @$extra_bind)
if $extra_bind;
-
return ($sql, \@bind);
}
@@ -1181,10 +1223,6 @@
sub _dbh_execute {
my ($self, $dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
- if( blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
- $ident = $ident->from();
- }
-
my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args);
$self->_query_start( $sql, @$bind );
@@ -1319,6 +1357,13 @@
}
sub _select {
+ my $self = shift;
+ my $sql_maker = $self->sql_maker;
+ local $sql_maker->{for};
+ return $self->_execute($self->_select_args(@_));
+}
+
+sub _select_args {
my ($self, $ident, $select, $condition, $attrs) = @_;
my $order = $attrs->{order_by};
@@ -1332,7 +1377,7 @@
my $for = delete $attrs->{for};
my $sql_maker = $self->sql_maker;
- local $sql_maker->{for} = $for;
+ $sql_maker->{for} = $for;
if (exists $attrs->{group_by} || $attrs->{having}) {
$order = {
@@ -1355,7 +1400,7 @@
push @args, $attrs->{rows}, $attrs->{offset};
}
- return $self->_execute(@args);
+ return @args;
}
sub source_bind_attributes {
@@ -1578,7 +1623,7 @@
%{$sqltargs || {}}
};
- $self->throw_exception(q{Can't create a ddl file without SQL::Translator 0.09: '}
+ $self->throw_exception(q{Can't create a ddl file without SQL::Translator 0.09003: '}
. $self->_check_sqlt_message . q{'})
if !$self->_check_sqlt_version;
@@ -1725,7 +1770,7 @@
return join('', @rows);
}
- $self->throw_exception(q{Can't deploy without SQL::Translator 0.09: '}
+ $self->throw_exception(q{Can't deploy without SQL::Translator 0.09003: '}
. $self->_check_sqlt_message . q{'})
if !$self->_check_sqlt_version;
@@ -1745,24 +1790,34 @@
sub deploy {
my ($self, $schema, $type, $sqltargs, $dir) = @_;
- foreach my $statement ( $self->deployment_statements($schema, $type, undef, $dir, { no_comments => 1, %{ $sqltargs || {} } } ) ) {
- foreach my $line ( split(";\n", $statement)) {
- next if($line =~ /^--/);
- next if(!$line);
-# next if($line =~ /^DROP/m);
- next if($line =~ /^BEGIN TRANSACTION/m);
- next if($line =~ /^COMMIT/m);
- next if $line =~ /^\s+$/; # skip whitespace only
- $self->_query_start($line);
- eval {
- $self->dbh->do($line); # shouldn't be using ->dbh ?
- };
- if ($@) {
- warn qq{$@ (running "${line}")};
- }
- $self->_query_end($line);
+ my $deploy = sub {
+ my $line = shift;
+ return if($line =~ /^--/);
+ return if(!$line);
+ # next if($line =~ /^DROP/m);
+ return if($line =~ /^BEGIN TRANSACTION/m);
+ return if($line =~ /^COMMIT/m);
+ return if $line =~ /^\s+$/; # skip whitespace only
+ $self->_query_start($line);
+ eval {
+ $self->dbh->do($line); # shouldn't be using ->dbh ?
+ };
+ if ($@) {
+ warn qq{$@ (running "${line}")};
}
+ $self->_query_end($line);
+ };
+ my @statements = $self->deployment_statements($schema, $type, undef, $dir, { no_comments => 1, %{ $sqltargs || {} } } );
+ if (@statements > 1) {
+ foreach my $statement (@statements) {
+ $deploy->( $statement );
+ }
}
+ elsif (@statements == 1) {
+ foreach my $line ( split(";\n", $statements[0])) {
+ $deploy->( $line );
+ }
+ }
}
=head2 datetime_parser
@@ -1807,7 +1862,7 @@
my $_check_sqlt_message; # private
sub _check_sqlt_version {
return $_check_sqlt_version if defined $_check_sqlt_version;
- eval 'use SQL::Translator "0.09"';
+ eval 'use SQL::Translator "0.09003"';
$_check_sqlt_message = $@ || '';
$_check_sqlt_version = !$@;
}
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/DBIx/Class.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -24,7 +24,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.08099_05';
+$VERSION = '0.08099_06';
$VERSION = eval $VERSION; # numify for warning-free dev releases
@@ -291,6 +291,8 @@
rjbs: Ricardo Signes <rjbs at cpan.org>
+robkinyon: Rob Kinyon <rkinyon at cpan.org>
+
sc_: Just Another Perl Hacker
scotty: Scotty Allen <scotty at scottyallen.com>
Modified: DBIx-Class/0.08/branches/multi_stuff/lib/SQL/Translator/Parser/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/lib/SQL/Translator/Parser/DBIx/Class.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/lib/SQL/Translator/Parser/DBIx/Class.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -8,7 +8,8 @@
use strict;
use warnings;
-use vars qw($DEBUG @EXPORT_OK);
+use vars qw($DEBUG $VERSION @EXPORT_OK);
+$VERSION = '1.10';
$DEBUG = 0 unless defined $DEBUG;
use Exporter;
@@ -214,7 +215,7 @@
}
}
- $source->sqlt_deploy_hook($table)
+ $source->_invoke_sqlt_deploy_hook($table);
}
if ($dbicschema->can('sqlt_deploy_hook')) {
@@ -233,7 +234,15 @@
=head1 SYNOPSIS
+ ## Via DBIx::Class
use MyApp::Schema;
+ my $schema = MyApp::Schema->connect("dbi:SQLite:something.db");
+ $schema->create_ddl_dir();
+ ## or
+ $schema->deploy();
+
+ ## Standalone
+ use MyApp::Schema;
use SQL::Translator;
my $schema = MyApp::Schema->connect;
@@ -246,12 +255,24 @@
=head1 DESCRIPTION
+This class requires L<SQL::Translator> installed to work.
+
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
+of L<DBIx::Class> classes, to a database. To do this, see the
+L<DBIx::Class::Schema/deploy> method.
+
+This can also be achieved by having DBIx::Class export the schema as a
+set of SQL files ready for import into your database, or passed to
+other machines that need to have your application installed but don't
+have SQL::Translator installed. To do this see the
+L<DBIx::Class::Schema/create_ddl_dir> method.
+
=head1 SEE ALSO
-SQL::Translator.
+L<SQL::Translator>, L<DBIx::Class::Schema>
=head1 AUTHORS
Modified: DBIx-Class/0.08/branches/multi_stuff/t/103many_to_many_warning.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/103many_to_many_warning.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/103many_to_many_warning.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -7,15 +7,16 @@
plan ( ($] >= 5.009000 and $] < 5.010001)
? (skip_all => 'warnings::register broken under 5.10: http://rt.perl.org/rt3/Public/Bug/Display.html?id=62522')
- : (tests => 2)
+ : (tests => 4)
);
{
my @w;
local $SIG{__WARN__} = sub { push @w, @_ };
-
my $code = gen_code ( suffix => 1 );
eval "$code";
+ ok (! $@, 'Eval code without warnings suppression')
+ || diag $@;
ok ( (grep { $_ =~ /The many-to-many relationship bars is trying to create/ } @w), "Warning triggered without relevant 'no warnings'");
}
@@ -26,6 +27,8 @@
my $code = gen_code ( suffix => 2, no_warn => 1 );
eval "$code";
+ ok (! $@, 'Eval code with warnings suppression')
+ || diag $@;
ok ( (not grep { $_ =~ /The many-to-many relationship bars is trying to create/ } @w), "No warning triggered with relevant 'no warnings'");
}
@@ -47,6 +50,7 @@
package #
DBICTest::Schema::Foo${suffix};
use base 'DBIx::Class::Core';
+
__PACKAGE__->table('foo');
__PACKAGE__->add_columns(
'fooid' => {
@@ -82,6 +86,7 @@
DBICTest::Schema::Bar${suffix};
use base 'DBIx::Class::Core';
+
__PACKAGE__->table('bar');
__PACKAGE__->add_columns(
'barid' => {
Modified: DBIx-Class/0.08/branches/multi_stuff/t/66relationship.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/66relationship.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/66relationship.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -8,7 +8,7 @@
my $schema = DBICTest->init_schema();
-plan tests => 68;
+plan tests => 75;
# has_a test
my $cd = $schema->resultset("CD")->find(4);
@@ -228,7 +228,10 @@
$undef_artist_cd->related_resultset('artist')->new({name => 'foo'});
};
is( $@, '', "Object created on a resultset related to not yet inserted object");
-
+lives_ok{
+ $schema->resultset('Artwork')->new_result({})->cd;
+} 'undef_on_null_fk does not choke on empty conds';
+
my $def_artist_cd = $schema->resultset("CD")->new_result({ 'title' => 'badgers', 'year' => 2007, artist => undef });
is($def_artist_cd->has_column_loaded('artist'), 1, 'FK loaded');
is($def_artist_cd->search_related('artist')->count, 0, 'closed search on null FK');
Modified: DBIx-Class/0.08/branches/multi_stuff/t/72pg.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/72pg.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/72pg.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -38,13 +38,11 @@
my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
-#warn "$dsn $user $pass";
-
plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test '.
'(note: This test drops and creates tables called \'artist\', \'casecheck\', \'array_test\' and \'sequence_test\''.
' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\''.
' as well as following schemas: \'testschema\'!)'
- unless ($dsn && $user && $pass);
+ unless ($dsn && $user);
plan tests => 37;
@@ -155,7 +153,7 @@
my $count;
lives_ok {
$count = $schema->resultset('ArrayTest')->search({
- arrayfield => \[ '= ?' => [3, 4] ], #TODO anything less ugly than this?
+ arrayfield => \[ '= ?' => [arrayfield => [3, 4]] ], #TODO anything less ugly than this?
})->count;
} 'comparing arrayref to pg array data does not blow up';
is($count, 1, 'comparing arrayref to pg array data gives correct result');
Modified: DBIx-Class/0.08/branches/multi_stuff/t/73oracle.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/73oracle.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/73oracle.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,3 +1,30 @@
+{
+ package # hide from PAUSE
+ DBICTest::Schema::ArtistFQN;
+
+ use base 'DBIx::Class::Core';
+
+ __PACKAGE__->table(
+ defined $ENV{DBICTEST_ORA_USER}
+ ? $ENV{DBICTEST_ORA_USER} . '.artist'
+ : 'artist'
+ );
+ __PACKAGE__->add_columns(
+ 'artistid' => {
+ data_type => 'integer',
+ is_auto_increment => 1,
+ },
+ 'name' => {
+ data_type => 'varchar',
+ size => 100,
+ is_nullable => 1,
+ },
+ );
+ __PACKAGE__->set_primary_key('artistid');
+
+ 1;
+}
+
use strict;
use warnings;
@@ -12,8 +39,9 @@
' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\''
unless ($dsn && $user && $pass);
-plan tests => 23;
+plan tests => 24;
+DBICTest::Schema->load_classes('ArtistFQN');
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
my $dbh = $schema->storage->dbh;
@@ -62,6 +90,10 @@
my $new = $schema->resultset('Artist')->create({ name => 'foo' });
is($new->artistid, 1, "Oracle Auto-PK worked");
+# test again with fully-qualified table name
+$new = $schema->resultset('ArtistFQN')->create( { name => 'bar' } );
+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' });
@@ -90,7 +122,7 @@
}
my $it = $schema->resultset('Artist')->search( {},
{ rows => 3,
- offset => 2,
+ offset => 3,
order_by => 'artistid' }
);
is( $it->count, 3, "LIMIT count ok" );
@@ -117,7 +149,7 @@
# clean up our mess
END {
- if($dbh) {
+ if($schema && ($dbh = $schema->storage->dbh)) {
$dbh->do("DROP SEQUENCE artist_seq");
$dbh->do("DROP SEQUENCE pkid1_seq");
$dbh->do("DROP SEQUENCE pkid2_seq");
Modified: DBIx-Class/0.08/branches/multi_stuff/t/745db2.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/745db2.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/745db2.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -20,7 +20,7 @@
eval { $dbh->do("DROP TABLE artist") };
-$dbh->do("CREATE TABLE artist (artistid INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1), name VARCHAR(255), charfield CHAR(10));");
+$dbh->do("CREATE TABLE artist (artistid INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1), name VARCHAR(255), charfield CHAR(10), rank INTEGER DEFAULT 13);");
# This is in core, just testing that it still loads ok
$schema->class('Artist')->load_components('PK::Auto');
@@ -60,6 +60,11 @@
'is_nullable' => 1,
'size' => 10
},
+ 'rank' => {
+ 'data_type' => 'INTEGER',
+ 'is_nullable' => 1,
+ 'size' => 10
+ },
};
Modified: DBIx-Class/0.08/branches/multi_stuff/t/746db2_400.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/746db2_400.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/746db2_400.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -23,7 +23,13 @@
eval { $dbh->do("DROP TABLE artist") };
-$dbh->do("CREATE TABLE artist (artistid INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1), name VARCHAR(255), charfield CHAR(10))");
+$dbh->do(<<'');
+CREATE TABLE artist (
+ artistid INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1),
+ name VARCHAR(255),
+ rank INTEGER default 13 not null,
+ charfield CHAR(10)
+)
# Just to test loading, already in Core
$schema->class('Artist')->load_components('PK::Auto');
@@ -58,6 +64,11 @@
'is_nullable' => 1,
'size' => 255
},
+ 'rank' => {
+ 'data_type' => 'INTEGER',
+ 'is_nullable' => 0,
+ 'size' => 10,
+ },
'charfield' => {
'data_type' => 'CHAR',
'is_nullable' => 1,
Modified: DBIx-Class/0.08/branches/multi_stuff/t/746mssql.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/746mssql.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/746mssql.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -17,11 +17,11 @@
$schema->storage->ensure_connected;
isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' );
-my $dbh = $schema->storage->_dbh;
+$schema->storage->dbh_do (sub {
+ my ($storage, $dbh) = @_;
+ eval { $dbh->do("DROP TABLE artist") };
+ $dbh->do(<<'SQL');
-eval { $dbh->do("DROP TABLE artist") };
-
- $dbh->do(<<'');
CREATE TABLE artist (
artistid INT IDENTITY NOT NULL,
name VARCHAR(100),
@@ -30,6 +30,10 @@
primary key(artistid)
)
+SQL
+
+});
+
my %seen_id;
# fresh $schema so we start unconnected
@@ -62,7 +66,7 @@
# clean up our mess
END {
- $dbh = eval { $schema->storage->_dbh };
+ my $dbh = eval { $schema->storage->_dbh };
$dbh->do('DROP TABLE artist') if $dbh;
}
Modified: DBIx-Class/0.08/branches/multi_stuff/t/76joins.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/76joins.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/76joins.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -17,7 +17,7 @@
eval "use DBD::SQLite";
plan $@
? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 16 );
+ : ( tests => 18 );
}
# figure out if we've got a version of sqlite that is older than 3.2.6, in
@@ -179,3 +179,28 @@
is($rs->first->name, 'We Are Goth', 'Correct record returned');
+# test for warnings on delete of joined resultset
+$rs = $schema->resultset("CD")->search(
+ { 'artist.name' => 'Caterwauler McCrae' },
+ { join => [qw/artist/]}
+);
+my $tst_delete_warning;
+eval {
+ local $SIG{__WARN__} = sub { $tst_delete_warning = shift };
+ $rs->delete();
+};
+
+ok( ($@ || $tst_delete_warning), 'fail/warning on attempt to delete a join-ed resultset');
+
+# test for warnings on update of joined resultset
+$rs = $schema->resultset("CD")->search(
+ { 'artist.name' => 'Random Boy Band' },
+ { join => [qw/artist/]}
+);
+my $tst_update_warning;
+eval {
+ local $SIG{__WARN__} = sub { $tst_update_warning = shift };
+ $rs->update({ 'artist' => 1 });
+};
+
+ok( ($@ || $tst_update_warning), 'fail/warning on attempt to update a join-ed resultset');
Modified: DBIx-Class/0.08/branches/multi_stuff/t/77prefetch.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/77prefetch.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/77prefetch.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -2,6 +2,7 @@
use warnings;
use Test::More;
+use Test::Exception;
use lib qw(t/lib);
use DBICTest;
use Data::Dumper;
@@ -16,7 +17,7 @@
eval "use DBD::SQLite";
plan $@
? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 58 );
+ : ( tests => 68 );
}
# figure out if we've got a version of sqlite that is older than 3.2.6, in
@@ -45,6 +46,49 @@
is(Dumper($attr), $attr_str, 'Attribute hash untouched after search()');
cmp_ok($rs + 0, '==', 3, 'Correct number of records returned');
+# A search() with prefetch seems to pollute an already joined resultset
+# in a way that offsets future joins (adapted from a test case by Debolaz)
+{
+ my ($cd_rs, $attrs);
+
+ # test a real-life case - rs is obtained by an implicit m2m join
+ $cd_rs = $schema->resultset ('Producer')->first->cds;
+ $attrs = Dumper $cd_rs->{attrs};
+
+ $cd_rs->search ({})->all;
+ is (Dumper ($cd_rs->{attrs}), $attrs, 'Resultset attributes preserved after a simple search');
+
+ lives_ok (sub {
+ $cd_rs->search ({'artist.artistid' => 1}, { prefetch => 'artist' })->all;
+ is (Dumper ($cd_rs->{attrs}), $attrs, 'Resultset attributes preserved after search with prefetch');
+ }, 'first prefetching search ok');
+
+ lives_ok (sub {
+ $cd_rs->search ({'artist.artistid' => 1}, { prefetch => 'artist' })->all;
+ is (Dumper ($cd_rs->{attrs}), $attrs, 'Resultset attributes preserved after another search with prefetch')
+ }, 'second prefetching search ok');
+
+
+ # test a regular rs with an empty seen_join injected - it should still work!
+ $cd_rs = $schema->resultset ('CD');
+ $cd_rs->{attrs}{seen_join} = {};
+ $attrs = Dumper $cd_rs->{attrs};
+
+ $cd_rs->search ({})->all;
+ is (Dumper ($cd_rs->{attrs}), $attrs, 'Resultset attributes preserved after a simple search');
+
+ lives_ok (sub {
+ $cd_rs->search ({'artist.artistid' => 1}, { prefetch => 'artist' })->all;
+ is (Dumper ($cd_rs->{attrs}), $attrs, 'Resultset attributes preserved after search with prefetch');
+ }, 'first prefetching search ok');
+
+ lives_ok (sub {
+ $cd_rs->search ({'artist.artistid' => 1}, { prefetch => 'artist' })->all;
+ is (Dumper ($cd_rs->{attrs}), $attrs, 'Resultset attributes preserved after another search with prefetch')
+ }, 'second prefetching search ok');
+}
+
+
my $queries = 0;
$schema->storage->debugcb(sub { $queries++; });
$schema->storage->debug(1);
Modified: DBIx-Class/0.08/branches/multi_stuff/t/81transactions.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/81transactions.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/81transactions.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -260,7 +260,7 @@
});
$guard->commit;
- } qr/No such column made_up_column .*? at .*?81transactions.t line \d+/, "Error propogated okay";
+ } qr/No such column made_up_column .*? at .*?81transactions.t line \d+/s, "Error propogated okay";
ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
Modified: DBIx-Class/0.08/branches/multi_stuff/t/86sqlt.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/86sqlt.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/86sqlt.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -10,7 +10,7 @@
my $schema = DBICTest->init_schema;
-plan tests => 132;
+plan tests => 133;
my $translator = SQL::Translator->new(
parser_args => {
@@ -29,7 +29,7 @@
$schema->source('Track')->sqlt_deploy_callback(sub {
my ($self, $sqlt_table) = @_;
- if ($sqlt_table->schema->translator->producer_type =~ /SQLite$/ ) {
+ if ($schema->storage->sqlt_type eq 'SQLite' ) {
$sqlt_table->add_index( name => 'track_title', fields => ['title'] )
or die $sqlt_table->error;
}
@@ -282,6 +282,18 @@
# the 'dummy' table
ok( !defined($tschema->get_table('dummy')), "Dummy table was removed by hook");
+# Test that the Artist resultsource sqlt_deploy_hook was called okay and added
+# an index
+SKIP: {
+ skip ('Artist sqlt_deploy_hook is only called with an SQLite backend', 1)
+ if $schema->storage->sqlt_type ne 'SQLite';
+
+ ok( ( grep
+ { $_->name eq 'artist_name_hookidx' }
+ $tschema->get_table('artist')->get_indices
+ ), 'sqlt_deploy_hook fired within a resultsource');
+}
+
# Test that nonexistent constraints are not found
my $constraint = get_constraint('FOREIGN KEY', 'cd', ['title'], 'cd', ['year']);
ok( !defined($constraint), 'nonexistent FOREIGN KEY constraint not found' );
Modified: DBIx-Class/0.08/branches/multi_stuff/t/89dbicadmin.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/89dbicadmin.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/89dbicadmin.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -6,7 +6,6 @@
use lib qw(t/lib);
use DBICTest;
-my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
eval 'require JSON::Any';
plan skip_all => 'Install JSON::Any to run this test' if ($@);
@@ -17,33 +16,75 @@
plan skip_all => 'Install Text::CSV_XS or Text::CSV_PP to run this test' if ($@);
}
-plan tests => 5;
+my @json_backends = qw/XS JSON DWIW Syck/;
+my $tests_per_run = 5;
-# the script supports double quotes round the arguments and single-quote within
-# to make sure it runs on windows as well, but only if JSON::Any picks the right module
+plan tests => $tests_per_run * @json_backends;
+use JSON::Any;
+for my $js (@json_backends) {
+ eval {JSON::Any->import ($js) };
+ SKIP: {
+ skip ("Json backend $js is not available, skip testing", $tests_per_run) if $@;
-my $employees = $schema->resultset('Employee');
-my @cmd = ($^X, qw|script/dbicadmin --quiet --schema=DBICTest::Schema --class=Employee --tlibs|, q|--connect=["dbi:SQLite:dbname=t/var/DBIxClass.db","","",{"AutoCommit":1}]|, qw|--force --tlibs|);
+ $ENV{JSON_ANY_ORDER} = $js;
+ eval { test_dbicadmin () };
+ diag $@ if $@;
+ }
+}
-system(@cmd, qw|--op=insert --set={"name":"Matt"}|);
-ok( ($employees->count()==1), 'insert count' );
+sub test_dbicadmin {
+ my $schema = DBICTest->init_schema( sqlite_use_file => 1 ); # reinit a fresh db for every run
-my $employee = $employees->find(1);
-ok( ($employee->name() eq 'Matt'), 'insert valid' );
+ my $employees = $schema->resultset('Employee');
-system(@cmd, qw|--op=update --set={"name":"Trout"}|);
-$employee = $employees->find(1);
-ok( ($employee->name() eq 'Trout'), 'update' );
+ system( _prepare_system_args( qw|--op=insert --set={"name":"Matt"}| ) );
+ ok( ($employees->count()==1), "$ENV{JSON_ANY_ORDER}: insert count" );
-system(@cmd, qw|--op=insert --set={"name":"Aran"}|);
+ my $employee = $employees->find(1);
+ ok( ($employee->name() eq 'Matt'), "$ENV{JSON_ANY_ORDER}: insert valid" );
-open(my $fh, "-|", @cmd, qw|--op=select --attrs={"order_by":"name"}|) or die $!;
-my $data = do { local $/; <$fh> };
-close($fh);
-ok( ($data=~/Aran.*Trout/s), 'select with attrs' );
+ system( _prepare_system_args( qw|--op=update --set={"name":"Trout"}| ) );
+ $employee = $employees->find(1);
+ ok( ($employee->name() eq 'Trout'), "$ENV{JSON_ANY_ORDER}: update" );
-system(@cmd, qw|--op=delete --where={"name":"Trout"}|);
-ok( ($employees->count()==1), 'delete' );
+ system( _prepare_system_args( qw|--op=insert --set={"name":"Aran"}| ) );
+ SKIP: {
+ skip ("MSWin32 doesn't support -| either", 1) if $^O eq 'MSWin32';
+
+ open(my $fh, "-|", _prepare_system_args( qw|--op=select --attrs={"order_by":"name"}| ) ) or die $!;
+ my $data = do { local $/; <$fh> };
+ close($fh);
+ ok( ($data=~/Aran.*Trout/s), "$ENV{JSON_ANY_ORDER}: select with attrs" );
+ }
+
+ system( _prepare_system_args( qw|--op=delete --where={"name":"Trout"}| ) );
+ ok( ($employees->count()==1), "$ENV{JSON_ANY_ORDER}: delete" );
+}
+
+# Why do we need this crap? Apparently MSWin32 can not pass through quotes properly
+# (sometimes it will and sometimes not, depending on what compiler was used to build
+# perl). So we go the extra mile to escape all the quotes. We can't also use ' instead
+# of ", because JSON::XS (proudly) does not support "malformed JSON" as the author
+# calls it. Bleh.
+#
+sub _prepare_system_args {
+ my $perl = $^X;
+ my @args = (
+ qw|script/dbicadmin --quiet --schema=DBICTest::Schema --class=Employee --tlibs|,
+ q|--connect=["dbi:SQLite:dbname=t/var/DBIxClass.db","","",{"AutoCommit":1}]|,
+ qw|--force --tlibs|,
+ @_,
+ );
+
+ if ( $^O eq 'MSWin32' ) {
+ $perl = qq|"$perl"|; # execution will fail if $^X contains paths
+ for (@args) {
+ $_ =~ s/"/\\"/g;
+ }
+ }
+
+ return ($perl, @args);
+}
Modified: DBIx-Class/0.08/branches/multi_stuff/t/89inflate_datetime.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/89inflate_datetime.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/89inflate_datetime.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -10,7 +10,7 @@
eval { require DateTime::Format::MySQL };
plan skip_all => "Need DateTime::Format::MySQL for inflation tests" if $@;
-plan tests => 28;
+plan tests => 32;
# inflation test
my $event = $schema->resultset("Event")->find(1);
@@ -58,6 +58,11 @@
hour => 13, minute => 34, second => 56, time_zone => "America/New_York" ),
});
+is ($event_tz->starts_at->day_name, "Montag", 'Locale de_DE loaded: day_name');
+is ($event_tz->starts_at->month_name, "Dezember", 'Locale de_DE loaded: month_name');
+is ($event_tz->created_on->day_name, "Tuesday", 'Default locale loaded: day_name');
+is ($event_tz->created_on->month_name, "January", 'Default locale loaded: month_name');
+
my $starts_at = $event_tz->starts_at;
is("$starts_at", '2007-12-31T00:00:00', 'Correct date/time using timezone');
Modified: DBIx-Class/0.08/branches/multi_stuff/t/90ensure_class_loaded.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/90ensure_class_loaded.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/90ensure_class_loaded.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -13,7 +13,7 @@
my $schema = DBICTest->init_schema();
-plan tests => 20;
+plan tests => 28;
# Test ensure_class_found
ok( $schema->ensure_class_found('DBIx::Class::Schema'),
@@ -40,6 +40,50 @@
like( $@, qr/did not return a true value/,
'DBICTest::ErrorComponent threw ok' );
+# Simulate a PAR environment
+{
+ my @code;
+ local @INC = @INC;
+ unshift @INC, sub {
+ if ($_[1] eq 'VIRTUAL/PAR/PACKAGE.pm') {
+ return (sub { return 0 unless @code; $_ = shift @code; 1; } );
+ }
+ else {
+ return ();
+ }
+ };
+
+ $retval = eval { $schema->load_optional_class('FAKE::PAR::PACKAGE') };
+ ok( !$@, 'load_optional_class on a nonexistent PAR class did not throw' );
+ ok( !$retval, 'nonexistent PAR package not loaded' );
+
+
+ # simulate a class which does load but does not return true
+ @code = (
+ q/package VIRTUAL::PAR::PACKAGE;/,
+ q/0;/,
+ );
+
+ $retval = eval { $schema->load_optional_class('VIRTUAL::PAR::PACKAGE') };
+ ok( $@, 'load_optional_class of a no-true-returning PAR module did throw' );
+ ok( !$retval, 'no-true-returning PAR package not loaded' );
+
+ # simulate a normal class (no one adjusted %INC so it will be tried again
+ @code = (
+ q/package VIRTUAL::PAR::PACKAGE;/,
+ q/1;/,
+ );
+
+ $retval = eval { $schema->load_optional_class('VIRTUAL::PAR::PACKAGE') };
+ ok( !$@, 'load_optional_class of a PAR module did not throw' );
+ ok( $retval, 'PAR package "loaded"' );
+
+ # see if we can still load stuff with the coderef present
+ $retval = eval { $schema->load_optional_class('DBIx::Class::ResultClass::HashRefInflator') };
+ ok( !$@, 'load_optional_class did not throw' ) || diag $@;
+ ok( $retval, 'DBIx::Class::ResultClass::HashRefInflator loaded' );
+}
+
# Test ensure_class_loaded
ok( Class::Inspector->loaded('TestPackage::A'), 'anonymous package exists' );
eval { $schema->ensure_class_loaded('TestPackage::A'); };
Modified: DBIx-Class/0.08/branches/multi_stuff/t/94versioning.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/94versioning.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/94versioning.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -16,9 +16,9 @@
unless ($dsn);
- eval "use DBD::mysql; use SQL::Translator 0.09;";
+ eval "use DBD::mysql; use SQL::Translator 0.09003;";
plan $@
- ? ( skip_all => 'needs DBD::mysql and SQL::Translator 0.09 for testing' )
+ ? ( skip_all => 'needs DBD::mysql and SQL::Translator 0.09003 for testing' )
: ( tests => 22 );
}
Modified: DBIx-Class/0.08/branches/multi_stuff/t/99dbic_sqlt_parser.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/99dbic_sqlt_parser.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/99dbic_sqlt_parser.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -7,19 +7,20 @@
BEGIN {
- eval "use DBD::mysql; use SQL::Translator 0.09;";
+ eval "use DBD::mysql; use SQL::Translator 0.09003;";
if ($@) {
- plan skip_all => 'needs DBD::mysql and SQL::Translator 0.09 for testing';
+ plan skip_all => 'needs DBD::mysql and SQL::Translator 0.09003 for testing';
}
}
my $schema = DBICTest->init_schema();
-plan tests => ($schema->sources * 3);
+my @sources = grep { $_ ne 'Dummy' } ($schema->sources); # Dummy was yanked out by the sqlt hook test
+plan tests => ( @sources * 3);
{
my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { } } });
- foreach my $source ($schema->sources) {
+ foreach my $source (@sources) {
my $table = $sqlt_schema->get_table($schema->source($source)->from);
my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints);
@@ -33,7 +34,7 @@
{
my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 1 } } });
- foreach my $source ($schema->sources) {
+ foreach my $source (@sources) {
my $table = $sqlt_schema->get_table($schema->source($source)->from);
my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints);
@@ -47,7 +48,7 @@
{
my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 0 } } });
- foreach my $source ($schema->sources) {
+ foreach my $source (@sources) {
my $table = $sqlt_schema->get_table($schema->source($source)->from);
my @indices = $table->get_indices;
Modified: DBIx-Class/0.08/branches/multi_stuff/t/99rh_perl_perf_bug.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/99rh_perl_perf_bug.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/99rh_perl_perf_bug.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -61,11 +61,15 @@
ok( ( $ratio < 2 ), 'Overload/bless performance acceptable' )
|| diag(
+ "\n",
"This perl has a substantial slow down when handling large numbers\n",
"of blessed/overloaded objects. This can severely adversely affect\n",
"the performance of DBIx::Class programs. Please read the section\n",
"in the Troubleshooting POD documentation entitled\n",
"'Perl Performance Issues on Red Hat Systems'\n",
+ "As this is an extremely serious condition, the only way to skip\n",
+ "over this test is to --force the installation, or to edit the test\n",
+ "file " . __FILE__ . "\n",
);
# We will only check for the difference in bless handling (whether the
@@ -106,8 +110,12 @@
ok( !_possibly_has_bad_overload_performance(),
'Checking whether bless applies to reference not object' )
|| diag(
+ "\n",
"This perl is probably derived from a buggy Red Hat perl build\n",
"Please read the section in the Troubleshooting POD documentation\n",
"entitled 'Perl Performance Issues on Red Hat Systems'\n",
+ "As this is an extremely serious condition, the only way to skip\n",
+ "over this test is to --force the installation, or to edit the test\n",
+ "file " . __FILE__ . "\n",
);
}
Modified: DBIx-Class/0.08/branches/multi_stuff/t/bindtype_columns.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/bindtype_columns.t 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/bindtype_columns.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -10,7 +10,7 @@
plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test'
unless ($dsn && $dbuser);
-plan tests => 3;
+plan tests => 6;
my $schema = DBICTest::Schema->connection($dsn, $dbuser, $dbpass, { AutoCommit => 1 });
@@ -18,7 +18,7 @@
{
local $SIG{__WARN__} = sub {};
- $dbh->do('DROP TABLE IF EXISTS artist');
+ $dbh->do('DROP TABLE IF EXISTS bindtype_test');
# the blob/clob are for reference only, will be useful when we switch to SQLT and can test Oracle along the way
$dbh->do(qq[
@@ -32,19 +32,57 @@
],{ RaiseError => 1, PrintError => 1 });
}
-# test primary key handling
-my $big_long_string = 'abcd' x 250000;
+my $big_long_string = "\x00\x01\x02 abcd" x 125000;
-my $new = $schema->resultset('BindType')->create({ bytea => $big_long_string });
+my $new;
+# test inserting a row
+{
+ $new = $schema->resultset('BindType')->create({ bytea => $big_long_string });
-ok($new->id, "Created a bytea row");
-is($new->bytea, $big_long_string, "Set the blob correctly.");
+ ok($new->id, "Created a bytea row");
+ is($new->bytea, $big_long_string, "Set the blob correctly.");
+}
-my $rs = $schema->resultset('BindType')->find({ id => $new->id });
+# test retrieval of the bytea column
+{
+ my $row = $schema->resultset('BindType')->find({ id => $new->id });
+ is($row->get_column('bytea'), $big_long_string, "Created the blob correctly.");
+}
-is($rs->get_column('bytea'), $big_long_string, "Created the blob correctly.");
+TODO: {
+ local $TODO =
+ 'Passing bind attributes to $sth->bind_param() should be implemented (it only works in $storage->insert ATM)';
-$dbh->do("DROP TABLE bindtype_test");
+ my $rs = $schema->resultset('BindType')->search({ bytea => $big_long_string });
+ # search on the bytea column (select)
+ {
+ my $row = $rs->first;
+ is($row ? $row->id : undef, $new->id, "Found the row searching on the bytea column.");
+ }
+ # search on the bytea column (update)
+ {
+ my $new_big_long_string = $big_long_string . "2";
+ $schema->txn_do(sub {
+ $rs->update({ bytea => $new_big_long_string });
+ my $row = $schema->resultset('BindType')->find({ id => $new->id });
+ is($row ? $row->get_column('bytea') : undef, $new_big_long_string,
+ "Updated the row correctly (searching on the bytea column)."
+ );
+ $schema->txn_rollback;
+ });
+ }
+ # search on the bytea column (delete)
+ {
+ $schema->txn_do(sub {
+ $rs->delete;
+ my $row = $schema->resultset('BindType')->find({ id => $new->id });
+ is($row, undef, "Deleted the row correctly (searching on the bytea column).");
+ $schema->txn_rollback;
+ });
+ }
+}
+
+$dbh->do("DROP TABLE bindtype_test");
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/01-columns.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/01-columns.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/01-columns.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/01-columns.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,153 @@
+use strict;
+
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@") : (tests=> 24);
+}
+
+
+#-----------------------------------------------------------------------
+# Make sure that we can set up columns properly
+#-----------------------------------------------------------------------
+package State;
+
+use base 'DBIx::Class::Test::SQLite';
+
+State->table('State');
+State->columns(Essential => qw/Abbreviation Name/);
+State->columns(Primary => 'Name');
+State->columns(Weather => qw/Rain Snowfall/);
+State->columns(Other => qw/Capital Population/);
+#State->has_many(cities => "City");
+
+sub accessor_name_for {
+ my ($class, $column) = @_;
+ my $return = $column eq "Rain" ? "Rainfall" : $column;
+ return $return;
+}
+
+sub mutator_name_for {
+ my ($class, $column) = @_;
+ my $return = $column eq "Rain" ? "set_Rainfall" : "set_$column";
+ return $return;
+}
+
+sub Snowfall { 1 }
+
+
+package City;
+
+use base 'DBIx::Class::Test::SQLite';
+
+City->table('City');
+City->columns(All => qw/Name State Population/);
+
+{
+ # Disable the `no such table' warning
+ local $SIG{__WARN__} = sub {
+ my $warning = shift;
+ warn $warning unless ($warning =~ /\Qno such table: City(1)\E/);
+ };
+
+ City->has_a(State => 'State');
+}
+
+#-------------------------------------------------------------------------
+package CD;
+use base 'DBIx::Class::Test::SQLite';
+
+CD->table('CD');
+CD->columns('All' => qw/artist title length/);
+
+#-------------------------------------------------------------------------
+
+package main;
+
+is(State->table, 'State', 'State table()');
+is(State->primary_column, 'name', 'State primary()');
+is_deeply [ State->columns('Primary') ] => [qw/name/],
+ 'State Primary:' . join ", ", State->columns('Primary');
+is_deeply [ sort State->columns('Essential') ] => [qw/abbreviation name/],
+ 'State Essential:' . join ", ", State->columns('Essential');
+is_deeply [ sort State->columns('All') ] =>
+ [ sort qw/name abbreviation rain snowfall capital population/ ],
+ 'State All:' . join ", ", State->columns('All');
+
+is(CD->primary_column, 'artist', 'CD primary()');
+is_deeply [ CD->columns('Primary') ] => [qw/artist/],
+ 'CD primary:' . join ", ", CD->columns('Primary');
+is_deeply [ sort CD->columns('All') ] => [qw/artist length title/],
+ 'CD all:' . join ", ", CD->columns('All');
+is_deeply [ sort CD->columns('Essential') ] => [qw/artist/],
+ 'CD essential:' . join ", ", CD->columns('Essential');
+
+ok(State->find_column('Rain'), 'find_column Rain');
+ok(State->find_column('rain'), 'find_column rain');
+ok(!State->find_column('HGLAGAGlAG'), '!find_column HGLAGAGlAG');
+
+{
+
+ can_ok +State => qw/Rainfall _Rainfall_accessor set_Rainfall
+ _set_Rainfall_accessor Snowfall _Snowfall_accessor set_Snowfall
+ _set_Snowfall_accessor/;
+
+ foreach my $method (qw/Rain _Rain_accessor rain snowfall/) {
+ ok !State->can($method), "State can't $method";
+ }
+
+}
+
+{
+ SKIP: {
+ skip "No column objects", 1;
+
+ eval { my @grps = State->__grouper->groups_for("Huh"); };
+ ok $@, "Huh not in groups";
+ }
+
+ my @grps = sort State->__grouper->groups_for(State->_find_columns(qw/rain capital/));
+ is @grps, 2, "Rain and Capital = 2 groups";
+ @grps = sort @grps; # Because the underlying API is hash-based
+ is $grps[0], 'Other', " - Other";
+ is $grps[1], 'Weather', " - Weather";
+}
+
+#{
+#
+# package DieTest;
+# @DieTest::ISA = qw(DBIx::Class);
+# DieTest->load_components(qw/CDBICompat::Retrieve Core/);
+# package main;
+# local $SIG{__WARN__} = sub { };
+# eval { DieTest->retrieve(1) };
+# like $@, qr/unless primary columns are defined/, "Need primary key for retrieve";
+#}
+
+#-----------------------------------------------------------------------
+# Make sure that columns inherit properly
+#-----------------------------------------------------------------------
+package State;
+
+package A;
+ at A::ISA = qw(DBIx::Class);
+__PACKAGE__->load_components(qw/CDBICompat Core/);
+__PACKAGE__->table('dummy');
+__PACKAGE__->columns(Primary => 'id');
+
+package A::B;
+ at A::B::ISA = 'A';
+__PACKAGE__->table('dummy2');
+__PACKAGE__->columns(All => qw(id b1));
+
+package A::C;
+ at A::C::ISA = 'A';
+__PACKAGE__->table('dummy3');
+__PACKAGE__->columns(All => qw(id c1 c2 c3));
+
+package main;
+is join (' ', sort A->columns), 'id', "A columns";
+is join (' ', sort A::B->columns), 'b1 id', "A::B columns";
+is join (' ', sort A::C->columns), 'c1 c2 c3 id', "A::C columns";
+
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/01-columns.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/02-Film.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/02-Film.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/02-Film.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/02-Film.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,417 @@
+use strict;
+use Test::More;
+$| = 1;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 98);
+}
+
+INIT {
+ use lib 't/cdbi/testlib';
+ use Film;
+}
+
+ok(Film->can('db_Main'), 'set_db()');
+is(Film->__driver, "SQLite", "Driver set correctly");
+
+{
+ my $nul = eval { Film->retrieve() };
+ is $nul, undef, "Can't retrieve nothing";
+ like $@, qr/./, "retrieve needs parameters"; # TODO fix this...
+}
+
+{
+ eval { my $id = Film->id };
+ like $@, qr/class method/, "Can't get id with no object";
+}
+
+{
+ eval { my $id = Film->title };
+ #like $@, qr/class method/, "Can't get title with no object";
+ ok $@, "Can't get title with no object";
+}
+
+eval { my $duh = Film->insert; };
+like $@, qr/create needs a hashref/, "needs a hashref";
+
+ok +Film->create_test_film;
+
+my $btaste = Film->retrieve('Bad Taste');
+isa_ok $btaste, 'Film';
+is($btaste->Title, 'Bad Taste', 'Title() get');
+is($btaste->Director, 'Peter Jackson', 'Director() get');
+is($btaste->Rating, 'R', 'Rating() get');
+is($btaste->NumExplodingSheep, 1, 'NumExplodingSheep() get');
+
+{
+ my $bt2 = Film->find_or_create(Title => 'Bad Taste');
+ is $bt2->Director, $btaste->Director, "find_or_create";
+ my @bt = Film->search(Title => 'Bad Taste');
+ is @bt, 1, " doesn't create a new one";
+}
+
+ok my $gone = Film->find_or_create(
+ {
+ Title => 'Gone With The Wind',
+ Director => 'Bob Baggadonuts',
+ Rating => 'PG',
+ NumExplodingSheep => 0
+ }
+ ),
+ "Add Gone With The Wind";
+isa_ok $gone, 'Film';
+ok $gone = Film->retrieve(Title => 'Gone With The Wind'),
+ "Fetch it back again";
+isa_ok $gone, 'Film';
+
+# Shocking new footage found reveals bizarre Scarlet/sheep scene!
+is($gone->NumExplodingSheep, 0, 'NumExplodingSheep() get again');
+$gone->NumExplodingSheep(5);
+is($gone->NumExplodingSheep, 5, 'NumExplodingSheep() set');
+is($gone->numexplodingsheep, 5, 'numexplodingsheep() set');
+
+is($gone->Rating, 'PG', 'Rating() get again');
+$gone->Rating('NC-17');
+is($gone->Rating, 'NC-17', 'Rating() set');
+$gone->update;
+
+{
+ my @films = eval { Film->retrieve_all };
+ cmp_ok(@films, '==', 2, "We have 2 films in total");
+}
+
+# EXTRA TEST: added by mst to check a bug found by Numa
+cmp_ok(Film->count_all, '==', 2, "count_all confirms 2 films");
+
+my $gone_copy = Film->retrieve('Gone With The Wind');
+ok($gone->NumExplodingSheep == 5, 'update()');
+ok($gone->Rating eq 'NC-17', 'update() again');
+
+# Grab the 'Bladerunner' entry.
+Film->create(
+ {
+ Title => 'Bladerunner',
+ Director => 'Bob Ridley Scott',
+ Rating => 'R'
+ }
+);
+
+my $blrunner = Film->retrieve('Bladerunner');
+is(ref $blrunner, 'Film', 'retrieve() again');
+is $blrunner->Title, 'Bladerunner', "Correct title";
+is $blrunner->Director, 'Bob Ridley Scott', " and Director";
+is $blrunner->Rating, 'R', " and Rating";
+is $blrunner->NumExplodingSheep, undef, " and sheep";
+
+# Make a copy of 'Bladerunner' and create an entry of the directors cut
+my $blrunner_dc = $blrunner->copy(
+ {
+ title => "Bladerunner: Director's Cut",
+ rating => "15",
+ }
+);
+is(ref $blrunner_dc, 'Film', "copy() produces a film");
+is($blrunner_dc->Title, "Bladerunner: Director's Cut", 'Title correct');
+is($blrunner_dc->Director, 'Bob Ridley Scott', 'Director correct');
+is($blrunner_dc->Rating, '15', 'Rating correct');
+is($blrunner_dc->NumExplodingSheep, undef, 'Sheep correct');
+
+# Set up own SQL:
+{
+ Film->add_constructor(title_asc => "title LIKE ? ORDER BY title");
+ Film->add_constructor(title_desc => "title LIKE ? ORDER BY title DESC");
+ Film->add_constructor(title_asc_nl => q{
+ title LIKE ?
+ ORDER BY title
+ LIMIT 1
+ });
+
+ {
+ my @films = Film->title_asc("Bladerunner%");
+ is @films, 2, "We have 2 Bladerunners";
+ is $films[0]->Title, $blrunner->Title, "Ordered correctly";
+ }
+ {
+ my @films = Film->title_desc("Bladerunner%");
+ is @films, 2, "We have 2 Bladerunners";
+ is $films[0]->Title, $blrunner_dc->Title, "Ordered correctly";
+ }
+ {
+ my @films = Film->title_asc_nl("Bladerunner%");
+ is @films, 1, "We have 2 Bladerunners";
+ is $films[0]->Title, $blrunner->Title, "Ordered correctly";
+ }
+}
+
+# Multi-column search
+{
+ my @films = $blrunner->search_like(title => "Bladerunner%", rating => '15');
+ is @films, 1, "Only one Bladerunner is a 15";
+}
+
+# Inline SQL
+{
+ my @films = Film->retrieve_from_sql("numexplodingsheep > 0 ORDER BY title");
+ is @films, 2, "Inline SQL";
+ is $films[0]->id, $btaste->id, "Correct film";
+ is $films[1]->id, $gone->id, "Correct film";
+}
+
+# Inline SQL removes WHERE
+{
+ my @films =
+ Film->retrieve_from_sql(" WHErE numexplodingsheep > 0 ORDER BY title");
+ is @films, 2, "Inline SQL";
+ is $films[0]->id, $btaste->id, "Correct film";
+ is $films[1]->id, $gone->id, "Correct film";
+}
+
+eval {
+ my $ishtar = Film->insert({ Title => 'Ishtar', Director => 'Elaine May' });
+ my $mandn =
+ Film->insert({ Title => 'Mikey and Nicky', Director => 'Elaine May' });
+ my $new_leaf =
+ Film->insert({ Title => 'A New Leaf', Director => 'Elaine May' });
+
+#use Data::Dumper; die Dumper(Film->search( Director => 'Elaine May' ));
+ cmp_ok(Film->search(Director => 'Elaine May'), '==', 3,
+ "3 Films by Elaine May");
+ ok(Film->retrieve('Ishtar')->delete,
+ "Ishtar doesn't deserve an entry any more");
+ ok(!Film->retrieve('Ishtar'), 'Ishtar no longer there');
+ {
+ my $deprecated = 0;
+ #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 $@, '', "No problems with deletes";
+
+# Find all films which have a rating of NC-17.
+my @films = Film->search('Rating', 'NC-17');
+is(scalar @films, 1, ' search returns one film');
+is($films[0]->id, $gone->id, ' ... the correct one');
+
+# Find all films which were directed by Bob
+ at films = Film->search_like('Director', 'Bob %');
+is(scalar @films, 3, ' search_like returns 3 films');
+ok(
+ eq_array(
+ [ sort map { $_->id } @films ],
+ [ sort map { $_->id } $blrunner_dc, $gone, $blrunner ]
+ ),
+ 'the correct ones'
+);
+
+# Find Ridley Scott films which don't have vomit
+ at films =
+ Film->search(numExplodingSheep => undef, Director => 'Bob Ridley Scott');
+is(scalar @films, 2, ' search where attribute is null returns 2 films');
+ok(
+ eq_array(
+ [ sort map { $_->id } @films ],
+ [ sort map { $_->id } $blrunner_dc, $blrunner ]
+ ),
+ 'the correct ones'
+);
+
+# Test that a disconnect doesnt harm anything.
+{
+ # SQLite is loud on disconnect/reconnect.
+ # This is solved in DBIC but not in ContextualFetch
+ local $SIG{__WARN__} = sub {
+ warn @_ unless $_[0] =~
+ /active statement handles|inactive database handle/;
+ };
+
+ Film->db_Main->disconnect;
+ @films = Film->search({ Rating => 'NC-17' });
+ ok(@films == 1 && $films[0]->id eq $gone->id, 'auto reconnection');
+
+ # Test discard_changes().
+ my $orig_director = $btaste->Director;
+ $btaste->Director('Lenny Bruce');
+ is($btaste->Director, 'Lenny Bruce', 'set new Director');
+ $btaste->discard_changes;
+ is($btaste->Director, $orig_director, 'discard_changes()');
+}
+
+SKIP: {
+ skip "ActiveState perl produces additional warnings", 3
+ if ($^O eq 'MSWin32');
+
+ Film->autoupdate(1);
+ my $btaste2 = Film->retrieve($btaste->id);
+ $btaste->NumExplodingSheep(18);
+ my @warnings;
+ local $SIG{__WARN__} = sub { push(@warnings, @_); };
+ {
+
+ # unhook from live object cache, so next one is not from cache
+ $btaste2->remove_from_object_index;
+ my $btaste3 = Film->retrieve($btaste->id);
+ is $btaste3->NumExplodingSheep, 18, "Class based AutoCommit";
+ $btaste3->autoupdate(0); # obj a/c should override class a/c
+ is @warnings, 0, "No warnings so far";
+ $btaste3->NumExplodingSheep(13);
+ }
+ is @warnings, 1, "DESTROY without update warns";
+ Film->autoupdate(0);
+}
+
+{ # update unchanged object
+ my $film = Film->retrieve($btaste->id);
+ my $retval = $film->update;
+ is $retval, -1, "Unchanged object";
+}
+
+{ # update deleted object
+ my $rt = "Royal Tenenbaums";
+ my $ten = Film->insert({ title => $rt, Rating => "R" });
+ $ten->rating(18);
+ Film->set_sql(drt => "DELETE FROM __TABLE__ WHERE title = ?");
+ Film->sql_drt->execute($rt);
+ my @films = Film->search({ title => $rt });
+ is @films, 0, "RT gone";
+ my $retval = eval { $ten->update };
+ like $@, qr/row not found/, "Update deleted object throws error";
+ $ten->discard_changes;
+}
+
+{
+ $btaste->autoupdate(1);
+ $btaste->NumExplodingSheep(32);
+ my $btaste2 = Film->retrieve($btaste->id);
+ is $btaste2->NumExplodingSheep, 32, "Object based AutoCommit";
+ $btaste->autoupdate(0);
+}
+
+# Primary key of 0
+{
+ my $zero = Film->insert({ Title => 0, Rating => "U" });
+ ok defined $zero, "Create 0";
+ ok my $ret = Film->retrieve(0), "Retrieve 0";
+ is $ret->Title, 0, "Title OK";
+ is $ret->Rating, "U", "Rating OK";
+}
+
+# Change after_update policy
+SKIP: {
+ skip "DBIx::Class compat doesn't handle the exists stuff quite right yet", 4;
+ my $bt = Film->retrieve($btaste->id);
+ $bt->autoupdate(1);
+
+ $bt->rating("17");
+ ok !$bt->_attribute_exists('rating'), "changed column needs reloaded";
+ ok $bt->_attribute_exists('title'), "but we still have the title";
+
+ # Don't re-load
+ $bt->add_trigger(
+ after_update => sub {
+ my ($self, %args) = @_;
+ my $discard_columns = $args{discard_columns};
+ @$discard_columns = qw/title/;
+ }
+ );
+ $bt->rating("19");
+ ok $bt->_attribute_exists('rating'), "changed column needs reloaded";
+ ok !$bt->_attribute_exists('title'), "but no longer have the title";
+}
+
+# Make sure that we can have other accessors. (Bugfix in 0.28)
+if (0) {
+ Film->mk_accessors(qw/temp1 temp2/);
+ my $blrunner = Film->retrieve('Bladerunner');
+ $blrunner->temp1("Foo");
+ $blrunner->NumExplodingSheep(2);
+ eval { $blrunner->update };
+ ok(!$@, "Other accessors");
+}
+
+# overloading
+{
+ is "$blrunner", "Bladerunner", "stringify";
+
+ ok(Film->columns(Stringify => 'rating'), "Can change stringify column");
+ is "$blrunner", "R", "And still stringifies correctly";
+
+ ok(
+ Film->columns(Stringify => qw/title rating/),
+ "Can have multiple stringify columns"
+ );
+ is "$blrunner", "Bladerunner/R", "And still stringifies correctly";
+
+ no warnings 'once';
+ local *Film::stringify_self = sub { join ":", $_[0]->title, $_[0]->rating };
+ is "$blrunner", "Bladerunner:R", "Provide stringify_self()";
+}
+
+{
+ {
+ ok my $byebye = DeletingFilm->insert(
+ {
+ Title => 'Goodbye Norma Jean',
+ Rating => 'PG',
+ }
+ ),
+ "Add a deleting Film";
+
+ isa_ok $byebye, 'DeletingFilm';
+ isa_ok $byebye, 'Film';
+ ok(Film->retrieve('Goodbye Norma Jean'), "Fetch it back again");
+ }
+ my $film;
+ eval { $film = Film->retrieve('Goodbye Norma Jean') };
+ ok !$film, "It destroys itself";
+}
+
+SKIP: {
+ skip "Caching has been removed", 5
+ if Film->isa("DBIx::Class::CDBICompat::NoObjectIndex");
+
+ # my bad taste is your bad taste
+ my $btaste = Film->retrieve('Bad Taste');
+ my $btaste2 = Film->retrieve('Bad Taste');
+ is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste2),
+ "Retrieving twice gives ref to same object";
+
+ my ($btaste5) = Film->search(title=>'Bad Taste');
+ is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste5),
+ "Searching also gives ref to same object";
+
+ $btaste2->remove_from_object_index;
+ my $btaste3 = Film->retrieve('Bad Taste');
+ isnt Scalar::Util::refaddr($btaste2), Scalar::Util::refaddr($btaste3),
+ "Removing from object_index and retrieving again gives new object";
+
+ $btaste3->clear_object_index;
+ my $btaste4 = Film->retrieve('Bad Taste');
+ isnt Scalar::Util::refaddr($btaste2), Scalar::Util::refaddr($btaste4),
+ "Clearing cache and retrieving again gives new object";
+
+ $btaste=Film->insert({
+ Title => 'Bad Taste 2',
+ Director => 'Peter Jackson',
+ Rating => 'R',
+ NumExplodingSheep => 2,
+ });
+ $btaste2 = Film->retrieve('Bad Taste 2');
+ is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste2),
+ "Creating and retrieving gives ref to same object";
+
+}
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/02-Film.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/03-subclassing.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/03-subclassing.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/03-subclassing.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/03-subclassing.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,31 @@
+use strict;
+use Test::More;
+
+#----------------------------------------------------------------------
+# Make sure subclasses can be themselves subclassed
+#----------------------------------------------------------------------
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 6);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+
+INIT { @Film::Threat::ISA = qw/Film/; }
+
+ok(Film::Threat->db_Main->ping, 'subclass db_Main()');
+is_deeply [ sort Film::Threat->columns ], [ sort Film->columns ],
+ 'has the same columns';
+
+my $bt = Film->create_test_film;
+ok my $btaste = Film::Threat->retrieve('Bad Taste'), "subclass retrieve";
+isa_ok $btaste => "Film::Threat";
+isa_ok $btaste => "Film";
+is $btaste->Title, 'Bad Taste', 'subclass get()';
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/03-subclassing.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/04-lazy.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/04-lazy.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/04-lazy.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/04-lazy.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,184 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Test::More;
+use Test::Warn;
+
+#----------------------------------------------------------------------
+# Test lazy loading
+#----------------------------------------------------------------------
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 36);
+}
+
+INIT {
+ use lib 't/cdbi/testlib';
+ use Lazy;
+}
+
+is_deeply [ Lazy->columns('Primary') ], [qw/this/], "Pri";
+is_deeply [ sort Lazy->columns('Essential') ], [qw/opop this/], "Essential";
+is_deeply [ sort Lazy->columns('things') ], [qw/that this/], "things";
+is_deeply [ sort Lazy->columns('horizon') ], [qw/eep orp/], "horizon";
+is_deeply [ sort Lazy->columns('vertical') ], [qw/oop opop/], "vertical";
+is_deeply [ sort Lazy->columns('All') ], [qw/eep oop opop orp that this/], "All";
+
+{
+ my @groups = Lazy->__grouper->groups_for(Lazy->find_column('this'));
+ is_deeply [ sort @groups ], [sort qw/things Essential Primary/], "this (@groups)";
+}
+
+{
+ my @groups = Lazy->__grouper->groups_for(Lazy->find_column('that'));
+ is_deeply \@groups, [qw/things/], "that (@groups)";
+}
+
+Lazy->create({ this => 1, that => 2, oop => 3, opop => 4, eep => 5 });
+
+ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary');
+ok($obj->_attribute_exists('this'), "Gets primary");
+ok($obj->_attribute_exists('opop'), "Gets other essential");
+ok(!$obj->_attribute_exists('that'), "But other things");
+ok(!$obj->_attribute_exists('eep'), " nor eep");
+ok(!$obj->_attribute_exists('orp'), " nor orp");
+ok(!$obj->_attribute_exists('oop'), " nor oop");
+
+ok(my $val = $obj->eep, 'Fetch eep');
+ok($obj->_attribute_exists('orp'), 'Gets orp too');
+ok(!$obj->_attribute_exists('oop'), 'But still not oop');
+ok(!$obj->_attribute_exists('that'), 'nor that');
+
+{
+ Lazy->columns(All => qw/this that eep orp oop opop/);
+ ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary');
+ ok !$obj->_attribute_exists('oop'), " Don't have oop";
+ my $null = $obj->eep;
+ ok !$obj->_attribute_exists('oop'),
+ " Don't have oop - even after getting eep";
+}
+
+# Test contructor breaking.
+
+eval { # Need a hashref
+ Lazy->create(this => 10, that => 20, oop => 30, opop => 40, eep => 50);
+};
+ok($@, $@);
+
+eval { # False column
+ Lazy->create({ this => 10, that => 20, theother => 30 });
+};
+ok($@, $@);
+
+eval { # Multiple false columns
+ Lazy->create({ this => 10, that => 20, theother => 30, andanother => 40 });
+};
+ok($@, $@);
+
+
+warning_is {
+ Lazy->columns( TEMP => qw(that) );
+} "Declaring column that as TEMP but it already exists";
+
+# Test that create() and update() throws out columns that changed
+{
+ my $l = Lazy->create({
+ this => 99,
+ that => 2,
+ oop => 3,
+ opop => 4,
+ });
+
+ ok $l->db_Main->do(qq{
+ UPDATE @{[ $l->table ]}
+ SET oop = ?
+ WHERE this = ?
+ }, undef, 87, $l->this);
+
+ is $l->oop, 87;
+
+ $l->oop(32);
+ $l->update;
+
+ ok $l->db_Main->do(qq{
+ UPDATE @{[ $l->table ]}
+ SET oop = ?
+ WHERE this = ?
+ }, undef, 23, $l->this);
+
+ is $l->oop, 23;
+
+ $l->delete;
+}
+
+
+# Now again for inflated values
+SKIP: {
+ skip "Requires Date::Simple", 5 unless eval "use Date::Simple; 1; ";
+ Lazy->has_a(
+ orp => 'Date::Simple',
+ inflate => sub { Date::Simple->new($_[0] . '-01-01') },
+ deflate => 'format'
+ );
+
+ my $l = Lazy->create({
+ this => 89,
+ that => 2,
+ orp => 1998,
+ });
+
+ ok $l->db_Main->do(qq{
+ UPDATE @{[ $l->table ]}
+ SET orp = ?
+ WHERE this = ?
+ }, undef, 1987, $l->this);
+
+ is $l->orp, '1987-01-01';
+
+ $l->orp(2007);
+ is $l->orp, '2007-01-01'; # make sure it's inflated
+ $l->update;
+
+ ok $l->db_Main->do(qq{
+ UPDATE @{[ $l->table ]}
+ SET orp = ?
+ WHERE this = ?
+ }, undef, 1942, $l->this);
+
+ is $l->orp, '1942-01-01';
+
+ $l->delete;
+}
+
+
+# Test that a deleted object works
+{
+ Lazy->search()->delete_all;
+ my $l = Lazy->create({
+ this => 99,
+ that => 2,
+ oop => 3,
+ opop => 4,
+ });
+
+ # Delete the object without it knowing.
+ Lazy->db_Main->do(qq[
+ DELETE
+ FROM @{[ Lazy->table ]}
+ WHERE this = 99
+ ]);
+
+ $l->eep;
+
+ # The problem was when an object had an inflated object
+ # loaded. _flesh() would set _column_data to undef and
+ # get_column() would think nothing was there.
+ # I'm too lazy to set up the proper inflation test.
+ ok !exists $l->{_column_data}{orp};
+}
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/04-lazy.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/06-hasa.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/06-hasa.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/06-hasa.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/06-hasa.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,170 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@");
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 24);
+}
+
+ at YA::Film::ISA = 'Film';
+
+#local $SIG{__WARN__} = sub { };
+
+INIT {
+ use lib 't/cdbi/testlib';
+ use Film;
+ use Director;
+}
+
+Film->create_test_film;
+ok(my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste");
+ok(my $pj = $btaste->Director, "Bad taste has_a() director");
+ok(!ref($pj), ' ... which is not an object');
+
+ok(Film->has_a('Director' => 'Director'), "Link Director table");
+ok(
+ Director->create(
+ {
+ Name => 'Peter Jackson',
+ Birthday => -300000000,
+ IsInsane => 1
+ }
+ ),
+ 'create Director'
+);
+
+$btaste = Film->retrieve('Bad Taste');
+
+ok($pj = $btaste->Director, "Bad taste now has_a() director");
+isa_ok($pj => 'Director');
+is($pj->id, 'Peter Jackson', ' ... and is the correct director');
+
+# Oh no! Its Peter Jacksons even twin, Skippy! Born one minute after him.
+my $sj = Director->create(
+ {
+ Name => 'Skippy Jackson',
+ Birthday => (-300000000 + 60),
+ IsInsane => 1,
+ }
+);
+
+is($sj->id, 'Skippy Jackson', 'We have a new director');
+
+Film->has_a(CoDirector => 'Director');
+
+$btaste->CoDirector($sj);
+$btaste->update;
+is($btaste->CoDirector->Name, 'Skippy Jackson', 'He co-directed');
+is(
+ $btaste->Director->Name,
+ 'Peter Jackson',
+ "Didnt interfere with each other"
+);
+
+{ # Ensure search can take an object
+ my @films = Film->search(Director => $pj);
+ is @films, 1, "1 Film directed by $pj";
+ is $films[0]->id, "Bad Taste", "Bad Taste";
+}
+
+inheriting_hasa();
+
+{
+
+ # Skippy directs a film and Peter helps!
+ $sj = Director->retrieve('Skippy Jackson');
+ $pj = Director->retrieve('Peter Jackson');
+
+ fail_with_bad_object($sj, $btaste);
+ taste_bad($sj, $pj);
+}
+
+sub inheriting_hasa {
+ my $btaste = YA::Film->retrieve('Bad Taste');
+ is(ref($btaste->Director), 'Director', 'inheriting has_a()');
+ is(ref($btaste->CoDirector), 'Director', 'inheriting has_a()');
+ is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly');
+}
+
+sub taste_bad {
+ my ($dir, $codir) = @_;
+ my $tastes_bad = YA::Film->create(
+ {
+ Title => 'Tastes Bad',
+ Director => $dir,
+ CoDirector => $codir,
+ Rating => 'R',
+ NumExplodingSheep => 23
+ }
+ );
+ is($tastes_bad->_Director_accessor, 'Skippy Jackson', 'Director_accessor');
+ is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director');
+ is($tastes_bad->CoDirector->Name, 'Peter Jackson', 'CoDirector');
+ is(
+ $tastes_bad->_CoDirector_accessor,
+ 'Peter Jackson',
+ 'CoDirector_accessor'
+ );
+}
+
+sub fail_with_bad_object {
+ my ($dir, $codir) = @_;
+ eval {
+ YA::Film->create(
+ {
+ Title => 'Tastes Bad',
+ Director => $dir,
+ CoDirector => $codir,
+ Rating => 'R',
+ NumExplodingSheep => 23
+ }
+ );
+ };
+ ok $@, $@;
+}
+
+package Foo;
+use base 'CDBase';
+__PACKAGE__->table('foo');
+__PACKAGE__->columns('All' => qw/ id fav /);
+# fav is a film
+__PACKAGE__->db_Main->do( qq{
+ CREATE TABLE foo (
+ id INTEGER,
+ fav VARCHAR(255)
+ )
+});
+
+
+package Bar;
+use base 'CDBase';
+__PACKAGE__->table('bar');
+__PACKAGE__->columns('All' => qw/ id fav /);
+# fav is a foo
+__PACKAGE__->db_Main->do( qq{
+ CREATE TABLE bar (
+ id INTEGER,
+ fav INTEGER
+ )
+});
+
+package main;
+Foo->has_a("fav" => "Film");
+Bar->has_a("fav" => "Foo");
+my $foo = Foo->create({ id => 6, fav => 'Bad Taste' });
+my $bar = Bar->create({ id => 2, fav => 6 });
+isa_ok($bar->fav, "Foo");
+isa_ok($foo->fav, "Film");
+
+{
+ my $foo;
+ Foo->add_trigger(after_create => sub { $foo = shift->fav });
+ my $gwh = Foo->create({ id => 93, fav => 'Good Will Hunting' });
+ isa_ok $foo, "Film", "Object in after_create trigger";
+}
+
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/06-hasa.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/08-inheritcols.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/08-inheritcols.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/08-inheritcols.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/08-inheritcols.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,25 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => 'Class::Trigger and DBIx::ContextualFetch required')
+ : (tests=> 3);
+}
+
+package A;
+ at A::ISA = qw(DBIx::Class::CDBICompat);
+__PACKAGE__->columns(Primary => 'id');
+
+package A::B;
+ at A::B::ISA = 'A';
+__PACKAGE__->columns(All => qw(id b1));
+
+package A::C;
+ at A::C::ISA = 'A';
+__PACKAGE__->columns(All => qw(id c1 c2 c3));
+
+package main;
+is join (' ', sort A->columns), 'id', "A columns";
+is join (' ', sort A::B->columns), 'b1 id', "A::B columns";
+is join (' ', sort A::C->columns), 'c1 c2 c3 id', "A::C columns";
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/08-inheritcols.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/09-has_many.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/09-has_many.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/09-has_many.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/09-has_many.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,127 @@
+use strict;
+use Test::More;
+
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => 'Class::Trigger and DBIx::ContextualFetch required' if $@;
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 31);
+}
+
+
+use lib 't/cdbi/testlib';
+use Film;
+use Actor;
+Actor->has_a(Film => 'Film');
+Film->has_many(actors => 'Actor', { order_by => 'name' });
+is(Actor->primary_column, 'id', "Actor primary OK");
+
+ok(Actor->can('Salary'), "Actor table set-up OK");
+ok(Film->can('actors'), " and have a suitable method in Film");
+
+Film->create_test_film;
+
+ok(my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste");
+
+ok(
+ my $pvj = Actor->create(
+ {
+ Name => 'Peter Vere-Jones',
+ Film => undef,
+ Salary => '30_000', # For a voice!
+ }
+ ),
+ 'create Actor'
+);
+is $pvj->Name, "Peter Vere-Jones", "PVJ name ok";
+is $pvj->Film, undef, "No film";
+ok $pvj->set_Film($btaste), "Set film";
+$pvj->update;
+is $pvj->Film->id, $btaste->id, "Now film";
+{
+ my @actors = $btaste->actors;
+ is(@actors, 1, "Bad taste has one actor");
+ is($actors[0]->Name, $pvj->Name, " - the correct one");
+}
+
+my %pj_data = (
+ Name => 'Peter Jackson',
+ Salary => '0', # it's a labour of love
+);
+
+eval { my $pj = Film->add_to_actors(\%pj_data) };
+like $@, qr/class/, "add_to_actors must be object method";
+
+eval { my $pj = $btaste->add_to_actors(%pj_data) };
+like $@, qr/needs/, "add_to_actors takes hash";
+
+ok(
+ my $pj = $btaste->add_to_actors(
+ {
+ Name => 'Peter Jackson',
+ Salary => '0', # it's a labour of love
+ }
+ ),
+ 'add_to_actors'
+);
+is $pj->Name, "Peter Jackson", "PJ ok";
+is $pvj->Name, "Peter Vere-Jones", "PVJ still ok";
+
+{
+ my @actors = $btaste->actors;
+ is @actors, 2, " - so now we have 2";
+ is $actors[0]->Name, $pj->Name, "PJ first";
+ is $actors[1]->Name, $pvj->Name, "PVJ first";
+}
+
+eval {
+ my @actors = $btaste->actors(Name => $pj->Name);
+ is @actors, 1, "One actor from restricted (sorted) has_many";
+ is $actors[0]->Name, $pj->Name, "It's PJ";
+};
+is $@, '', "No errors";
+
+my $as = Actor->create(
+ {
+ Name => 'Arnold Schwarzenegger',
+ Film => 'Terminator 2',
+ Salary => '15_000_000'
+ }
+);
+
+eval { $btaste->actors($pj, $pvj, $as) };
+ok $@, $@;
+is($btaste->actors, 2, " - so we still only have 2 actors");
+
+my @bta_before = Actor->search(Film => 'Bad Taste');
+is(@bta_before, 2, "We have 2 actors in bad taste");
+ok($btaste->delete, "Delete bad taste");
+my @bta_after = Actor->search(Film => 'Bad Taste');
+is(@bta_after, 0, " - after deleting there are no actors");
+
+# While we're here, make sure Actors have unreadable mutators and
+# unwritable accessors
+
+eval { $as->Name("Paul Reubens") };
+ok $@, $@;
+eval { my $name = $as->set_Name };
+ok $@, $@;
+
+is($as->Name, 'Arnold Schwarzenegger', "Arnie's still Arnie");
+
+
+# Test infering of the foreign key of a has_many from an existing has_a
+{
+ use Thing;
+ use OtherThing;
+
+ Thing->has_a(that_thing => "OtherThing");
+ OtherThing->has_many(things => "Thing");
+
+ my $other_thing = OtherThing->create({ id => 1 });
+ Thing->create({ id => 1, that_thing => $other_thing });
+ Thing->create({ id => 2, that_thing => $other_thing });
+
+ is_deeply [sort map { $_->id } $other_thing->things], [1,2];
+}
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/09-has_many.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/11-triggers.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/11-triggers.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/11-triggers.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/11-triggers.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,66 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 13);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+
+sub create_trigger2 { ::ok(1, "Running create trigger 2"); }
+sub delete_trigger { ::ok(1, "Deleting " . shift->Title) }
+
+sub pre_up_trigger {
+ $_[0]->_attribute_set(numexplodingsheep => 1);
+ ::ok(1, "Running pre-update trigger");
+}
+sub pst_up_trigger { ::ok(1, "Running post-update trigger"); }
+
+sub default_rating { $_[0]->Rating(15); }
+
+Film->add_trigger(before_create => \&default_rating);
+Film->add_trigger(after_create => \&create_trigger2);
+Film->add_trigger(after_delete => \&delete_trigger);
+Film->add_trigger(before_update => \&pre_up_trigger);
+Film->add_trigger(after_update => \&pst_up_trigger);
+
+ok(
+ my $ver = Film->create({
+ title => 'La Double Vie De Veronique',
+ director => 'Kryzstof Kieslowski',
+
+ # rating => '15',
+ numexplodingsheep => 0,
+ }
+ ),
+ "Create Veronique"
+);
+
+is $ver->Rating, 15, "Default rating";
+is $ver->NumExplodingSheep, 0, "Original sheep count";
+ok $ver->Rating('12') && $ver->update, "Change the rating";
+is $ver->NumExplodingSheep, 1, "Updated object's sheep count";
+is + (
+ $ver->db_Main->selectall_arrayref(
+ 'SELECT numexplodingsheep FROM '
+ . $ver->table
+ . ' WHERE '
+ . $ver->primary_column . ' = '
+ . $ver->db_Main->quote($ver->id))
+)->[0]->[0], 1, "Updated database's sheep count";
+ok $ver->delete, "Delete";
+
+{
+ Film->add_trigger(before_create => sub {
+ my $self = shift;
+ ok !$self->_attribute_exists('title'), "PK doesn't auto-vivify";
+ });
+ Film->create({director => "Me"});
+}
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/11-triggers.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/12-filter.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/12-filter.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/12-filter.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/12-filter.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,181 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 50);
+}
+
+use lib 't/cdbi/testlib';
+use Actor;
+use Film;
+Film->has_many(actors => 'Actor');
+Actor->has_a('film' => 'Film');
+Actor->add_constructor(double_search => 'name = ? AND salary = ?');
+
+my $film = Film->create({ Title => 'MY Film' });
+my $film2 = Film->create({ Title => 'Another Film' });
+
+my @act = (
+ Actor->create(
+ {
+ name => 'Actor 1',
+ film => $film,
+ salary => 10,
+ }
+ ),
+ Actor->create(
+ {
+ name => 'Actor 2',
+ film => $film,
+ salary => 20,
+ }
+ ),
+ Actor->create(
+ {
+ name => 'Actor 3',
+ film => $film,
+ salary => 30,
+ }
+ ),
+ Actor->create(
+ {
+ name => 'Actor 4',
+ film => $film2,
+ salary => 50,
+ }
+ ),
+);
+
+eval {
+ my @actors = $film->actors(name => 'Actor 1');
+ is @actors, 1, "Got one actor from restricted has_many";
+ is $actors[0]->name, "Actor 1", "Correct name";
+};
+is $@, '', "No errors";
+
+{
+ my @actors = Actor->double_search("Actor 1", 10);
+ is @actors, 1, "Got one actor";
+ is $actors[0]->name, "Actor 1", "Correct name";
+}
+
+{
+ ok my @actors = Actor->salary_between(0, 100), "Range 0 - 100";
+ is @actors, 4, "Got all";
+}
+
+{
+ my @actors = Actor->salary_between(100, 200);
+ is @actors, 0, "None in Range 100 - 200";
+}
+
+{
+ ok my @actors = Actor->salary_between(0, 10), "Range 0 - 10";
+ is @actors, 1, "Got 1";
+ is $actors[0]->name, $act[0]->name, "Actor 1";
+}
+
+{
+ ok my @actors = Actor->salary_between(20, 30), "Range 20 - 20";
+ @actors = sort { $a->salary <=> $b->salary } @actors;
+ is @actors, 2, "Got 2";
+ is $actors[0]->name, $act[1]->name, "Actor 2";
+ is $actors[1]->name, $act[2]->name, "and Actor 3";
+}
+
+{
+ ok my @actors = Actor->search(Film => $film), "Search by object";
+ is @actors, 3, "3 actors in film 1";
+}
+
+#----------------------------------------------------------------------
+# Iterators
+#----------------------------------------------------------------------
+
+my $it_class = 'DBIx::Class::ResultSet';
+
+sub test_normal_iterator {
+ my $it = $film->actors;
+ isa_ok $it, $it_class;
+ is $it->count, 3, " - with 3 elements";
+ my $i = 0;
+ while (my $film = $it->next) {
+ is $film->name, $act[ $i++ ]->name, "Get $i";
+ }
+ ok !$it->next, "No more";
+ is $it->first->name, $act[0]->name, "Get first";
+}
+
+test_normal_iterator;
+{
+ Film->has_many(actor_ids => [ Actor => 'id' ]);
+ my $it = $film->actor_ids;
+ isa_ok $it, $it_class;
+ is $it->count, 3, " - with 3 elements";
+ my $i = 0;
+ while (my $film_id = $it->next) {
+ is $film_id, $act[ $i++ ]->id, "Get id $i";
+ }
+ ok !$it->next, "No more";
+ is $it->first, $act[0]->id, "Get first";
+}
+
+# make sure nothing gets clobbered;
+test_normal_iterator;
+
+SKIP: {
+ #skip "dbic iterators don't support slice yet", 12;
+
+
+{
+ my @acts = $film->actors->slice(1, 2);
+ is @acts, 2, "Slice gives 2 actor";
+ is $acts[0]->name, "Actor 2", "Actor 2";
+ is $acts[1]->name, "Actor 3", "and actor 3";
+}
+
+{
+ my @acts = $film->actors->slice(1);
+ is @acts, 1, "Slice of 1 actor";
+ is $acts[0]->name, "Actor 2", "Actor 2";
+}
+
+{
+ my @acts = $film->actors->slice(2, 8);
+ is @acts, 1, "Slice off the end";
+ is $acts[0]->name, "Actor 3", "Gets last actor only";
+}
+
+package Class::DBI::My::Iterator;
+
+use vars qw/@ISA/;
+
+ at ISA = ($it_class);
+
+sub slice { qw/fred barney/ }
+
+package main;
+
+Actor->iterator_class('Class::DBI::My::Iterator');
+
+delete $film->{related_resultsets};
+
+{
+ my @acts = $film->actors->slice(1, 2);
+ is @acts, 2, "Slice gives 2 results";
+ ok eq_set(\@acts, [qw/fred barney/]), "Fred and Barney";
+
+ ok $film->actors->delete_all, "Can delete via iterator";
+ is $film->actors, 0, "no actors left";
+
+ eval { $film->actors->delete_all };
+ is $@, '', "Deleting again does no harm";
+}
+
+} # end SKIP block
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/12-filter.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/13-constraint.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/13-constraint.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/13-constraint.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/13-constraint.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,121 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 23);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+
+sub valid_rating {
+ my $value = shift;
+ my $ok = grep $value eq $_, qw/U Uc PG 12 15 18/;
+ return $ok;
+}
+
+Film->add_constraint('valid rating', Rating => \&valid_rating);
+
+my %info = (
+ Title => 'La Double Vie De Veronique',
+ Director => 'Kryzstof Kieslowski',
+ Rating => '18',
+);
+
+{
+ local $info{Title} = "nonsense";
+ local $info{Rating} = 19;
+ eval { Film->create({%info}) };
+ ok $@, $@;
+ ok !Film->retrieve($info{Title}), "No film created";
+ is(Film->retrieve_all, 0, "So no films");
+}
+
+ok(my $ver = Film->create({%info}), "Can create with valid rating");
+is $ver->Rating, 18, "Rating 18";
+
+ok $ver->Rating(12), "Change to 12";
+ok $ver->update, "And update";
+is $ver->Rating, 12, "Rating now 12";
+
+eval {
+ $ver->Rating(13);
+ $ver->update;
+};
+ok $@, $@;
+is $ver->Rating, 12, "Rating still 12";
+ok $ver->delete, "Delete";
+
+# this threw an infinite loop in old versions
+Film->add_constraint('valid director', Director => sub { 1 });
+my $fred = Film->create({ Rating => '12' });
+
+# this test is a bit problematical because we don't supply a primary key
+# to the create() and the table doesn't use auto_increment or a sequence.
+ok $fred, "Got fred";
+
+{
+ ok +Film->constrain_column(rating => [qw/U PG 12 15 19/]),
+ "constraint_column";
+ my $narrower = eval { Film->create({ Rating => 'Uc' }) };
+ like $@, qr/fails.*constraint/, "Fails listref constraint";
+ my $ok = eval { Film->create({ Rating => 'U' }) };
+ is $@, '', "Can create with rating U";
+ SKIP: {
+ skip "No column objects", 2;
+ ok +Film->find_column('rating')->is_constrained, "Rating is constrained";
+ ok +Film->find_column('director')->is_constrained, "Director is not";
+ }
+}
+
+{
+ ok +Film->constrain_column(title => qr/The/), "constraint_column";
+ my $inferno = eval { Film->create({ Title => 'Towering Infero' }) };
+ like $@, qr/fails.*constraint/, "Can't create towering inferno";
+ my $the_inferno = eval { Film->create({ Title => 'The Towering Infero' }) };
+ is $@, '', "But can create THE towering inferno";
+}
+
+{
+
+ sub Film::_constrain_by_untaint {
+ my ($class, $col, $string, $type) = @_;
+ $class->add_constraint(
+ untaint => $col => sub {
+ my ($value, $self, $column_name, $changing) = @_;
+ $value eq "today" ? $changing->{$column_name} = "2001-03-03" : 0;
+ }
+ );
+ }
+ eval { Film->constrain_column(codirector => Untaint => 'date') };
+ is $@, '', 'Can constrain with untaint';
+ my $freeaa =
+ eval { Film->create({ title => "The Freaa", codirector => 'today' }) };
+ TODO: {
+ local $TODO = "no idea what this is supposed to do";
+ is $@, '', "Can create codirector";
+ is $freeaa && $freeaa->codirector, '2001-03-03', "Set the codirector";
+ }
+}
+
+__DATA__
+
+use CGI::Untaint;
+
+sub _constrain_by_untaint {
+ my ($class, $col, $string, $type) = @_;
+ $class->add_constraint(untaint => $col => sub {
+ my ($value, $self, $column_name, $changing) = @_;
+ my $h = CGI::Untaint->new({ %$changing });
+ return unless my $val = $h->extract("-as_$type" => $column_name);
+ $changing->{$column_name} = $val;
+ return 1;
+ });
+}
+
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/13-constraint.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/14-might_have.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/14-might_have.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/14-might_have.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/14-might_have.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,83 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 22);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+use Blurb;
+
+is(Blurb->primary_column, "title", "Primary key of Blurb = title");
+is_deeply [ Blurb->columns('Essential') ], [ Blurb->primary_column ], "Essential = Primary";
+
+eval { Blurb->retrieve(10) };
+is $@, "", "No problem retrieving non-existent Blurb";
+
+Film->might_have(info => Blurb => qw/blurb/);
+
+Film->create_test_film;
+
+{
+ ok my $bt = Film->retrieve('Bad Taste'), "Get Film";
+ isa_ok $bt, "Film";
+ is $bt->info, undef, "No blurb yet";
+ # bug where we couldn't write a class with a might_have that didn't_have
+ $bt->rating(16);
+ eval { $bt->update };
+ is $@, '', "No problems updating when don't have";
+ is $bt->rating, 16, "Updated OK";
+
+ is $bt->blurb, undef, "Bad taste has no blurb";
+ $bt->blurb("Wibble bar");
+ $bt->update;
+ is $bt->blurb, "Wibble bar", "And we can write the info";
+}
+
+{
+ my $bt = Film->retrieve('Bad Taste');
+ my $info = $bt->info;
+ isa_ok $info, 'Blurb';
+
+ is $bt->blurb, $info->blurb, "Blurb is the same as fetching the long way";
+ ok $bt->blurb("New blurb"), "We can set the blurb";
+ $bt->update;
+ is $bt->blurb, $info->blurb, "Blurb has been set";
+
+ $bt->rating(18);
+ eval { $bt->update };
+ is $@, '', "No problems updating when do have";
+ is $bt->rating, 18, "Updated OK";
+
+ # cascade delete?
+ {
+ my $blurb = Blurb->retrieve('Bad Taste');
+ isa_ok $blurb => "Blurb";
+ $bt->delete;
+ $blurb = Blurb->retrieve('Bad Taste');
+ is $blurb, undef, "Blurb has gone";
+ }
+
+}
+
+{
+ my $host = Film->create({ title => "Gwoemul" });
+ $host->blurb("Monsters are real.");
+ my $info = $host->info;
+ is $info->blurb, "Monsters are real.";
+
+ $host->discard_changes;
+ is $host->info->id, $info->id,
+ 'relationships still valid after discard_changes';
+
+ ok $host->info->delete;
+ $host->discard_changes;
+ ok !$host->info, 'relationships rechecked after discard_changes';
+}
\ No newline at end of file
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/14-might_have.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/15-accessor.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/15-accessor.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/15-accessor.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/15-accessor.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,268 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 75);
+}
+
+INIT {
+ #local $SIG{__WARN__} =
+ #sub { like $_[0], qr/clashes with built-in method/, $_[0] };
+ use lib 't/cdbi/testlib';
+ require Film;
+ require Actor;
+ require Director;
+
+ Actor->has_a(film => 'Film');
+ Film->has_a(director => 'Director');
+
+ sub Class::DBI::sheep { ok 0; }
+}
+
+sub Film::mutator_name {
+ my ($class, $col) = @_;
+ return "set_sheep" if lc $col eq "numexplodingsheep";
+ return $col;
+}
+
+sub Film::accessor_name {
+ my ($class, $col) = @_;
+ return "sheep" if lc $col eq "numexplodingsheep";
+ return $col;
+}
+
+sub Actor::accessor_name_for {
+ my ($class, $col) = @_;
+ return "movie" if lc $col eq "film";
+ return $col;
+}
+
+# This is a class with accessor_name_for() but no corresponding mutator_name_for()
+sub Director::accessor_name_for {
+ my($class, $col) = @_;
+ return "nutty_as_a_fruitcake" if lc $col eq "isinsane";
+ return $col;
+}
+
+my $data = {
+ Title => 'Bad Taste',
+ Director => 'Peter Jackson',
+ Rating => 'R',
+};
+
+eval {
+ my $data = { %$data };
+ $data->{NumExplodingSheep} = 1;
+ ok my $bt = Film->create($data), "Modified accessor - with column name";
+ isa_ok $bt, "Film";
+ is $bt->sheep, 1, 'sheep bursting violently';
+};
+is $@, '', "No errors";
+
+eval {
+ my $data = { %$data };
+ $data->{sheep} = 2;
+ ok my $bt = Film->create($data), "Modified accessor - with accessor";
+ isa_ok $bt, "Film";
+ is $bt->sheep, 2, 'sheep bursting violently';
+};
+is $@, '', "No errors";
+
+eval {
+ my $data = { %$data };
+ $data->{NumExplodingSheep} = 1;
+ ok my $bt = Film->find_or_create($data),
+ "find_or_create Modified accessor - find with column name";
+ isa_ok $bt, "Film";
+ is $bt->sheep, 1, 'sheep bursting violently';
+};
+is $@, '', "No errors";
+
+eval {
+ my $data = { %$data };
+ $data->{sheep} = 1;
+ ok my $bt = Film->find_or_create($data),
+ "find_or_create Modified accessor - find with accessor";
+ isa_ok $bt, "Film";
+ is $bt->sheep, 1, 'sheep bursting violently';
+};
+is $@, '', "No errors";
+
+TODO: { local $TODO = 'TODOifying failing tests, waiting for Schwern'; ok (1, 'remove me');
+eval {
+ my $data = { %$data };
+ $data->{NumExplodingSheep} = 3;
+ ok my $bt = Film->find_or_create($data),
+ "find_or_create Modified accessor - create with column name";
+ isa_ok $bt, "Film";
+ is $bt->sheep, 3, 'sheep bursting violently';
+};
+is $@, '', "No errors";
+
+eval {
+ my $data = { %$data };
+ $data->{sheep} = 4;
+ ok my $bt = Film->find_or_create($data),
+ "find_or_create Modified accessor - create with accessor";
+ isa_ok $bt, "Film";
+ is $bt->sheep, 4, 'sheep bursting violently';
+};
+is $@, '', "No errors";
+
+eval {
+ my @film = Film->search({ sheep => 1 });
+ is @film, 2, "Can search with modified accessor";
+};
+is $@, '', "No errors";
+
+}
+
+{
+
+ eval {
+ local $data->{set_sheep} = 1;
+ ok my $bt = Film->create($data), "Modified mutator - with mutator";
+ isa_ok $bt, "Film";
+ };
+ is $@, '', "No errors";
+
+ eval {
+ local $data->{NumExplodingSheep} = 1;
+ ok my $bt = Film->create($data), "Modified mutator - with column name";
+ isa_ok $bt, "Film";
+ };
+ is $@, '', "No errors";
+
+ eval {
+ local $data->{sheep} = 1;
+ ok my $bt = Film->create($data), "Modified mutator - with accessor";
+ isa_ok $bt, "Film";
+ };
+ is $@, '', "No errors";
+
+}
+
+{
+ my $p_data = {
+ name => 'Peter Jackson',
+ film => 'Bad Taste',
+ };
+ my $bt = Film->create($data);
+ my $ac = Actor->create($p_data);
+
+ ok !eval { my $f = $ac->film; 1 };
+ like $@, qr/film/, "no hasa film";
+
+ eval {
+ local $SIG{__WARN__} = sub {
+ warn @_ unless $_[0] =~ /Query returned more than one row/;
+ };
+ ok my $f = $ac->movie, "hasa movie";
+ isa_ok $f, "Film";
+ is $f->id, $bt->id, " - Bad Taste";
+ };
+ is $@, '', "No errors";
+
+ {
+ local $data->{Title} = "Another film";
+ my $film = Film->create($data);
+
+ eval { $ac->film($film) };
+ ok $@, $@;
+
+ eval { $ac->movie($film) };
+ ok $@, $@;
+
+ eval {
+ ok $ac->set_film($film), "Set movie through hasa";
+ $ac->update;
+ ok my $f = $ac->movie, "hasa movie";
+ isa_ok $f, "Film";
+ is $f->id, $film->id, " - Another Film";
+ };
+ is $@, '', "No problem";
+ }
+
+}
+
+
+# Make sure a class with an accessor_name() method has a similar mutator.
+{
+ my $aki = Director->create({
+ name => "Aki Kaurismaki",
+ });
+
+ $aki->nutty_as_a_fruitcake(1);
+ is $aki->nutty_as_a_fruitcake, 1,
+ "a custom accessor without a custom mutator is setable";
+ $aki->update;
+}
+
+{
+ Film->columns(TEMP => qw/nonpersistent/);
+ ok(Film->find_column('nonpersistent'), "nonpersistent is a column");
+ ok(!Film->has_real_column('nonpersistent'), " - but it's not real");
+
+ {
+ my $film = Film->create({ Title => "Veronique", nonpersistent => 42 });
+ is $film->title, "Veronique", "Title set OK";
+ is $film->nonpersistent, 42, "As is non persistent value";
+ $film->remove_from_object_index;
+ ok $film = Film->retrieve('Veronique'), "Re-retrieve film";
+ is $film->title, "Veronique", "Title still OK";
+ is $film->nonpersistent, undef, "Non persistent value gone";
+ ok $film->nonpersistent(40), "Can set it";
+ is $film->nonpersistent, 40, "And it's there again";
+ ok $film->update, "Commit the film";
+ is $film->nonpersistent, 40, "And it's still there";
+ }
+}
+
+{
+ is_deeply(
+ [Actor->columns('Essential')],
+ [Actor->columns('Primary')],
+ "Actor has no specific essential columns"
+ );
+ ok(Actor->find_column('nonpersistent'), "nonpersistent is a column");
+ ok(!Actor->has_real_column('nonpersistent'), " - but it's not real");
+ my $pj = eval { Actor->search(name => "Peter Jackson")->first };
+ is $@, '', "no problems retrieving actors";
+ isa_ok $pj => "Actor";
+}
+
+{
+ Film->autoupdate(1);
+ my $naked = Film->create({ title => 'Naked' });
+ my $sandl = Film->create({ title => 'Secrets and Lies' });
+
+ my $rating = 1;
+ my $update_failure = sub {
+ my $obj = shift;
+ eval { $obj->rating($rating++) };
+ return $@ =~ /read only/;
+ };
+
+ ok !$update_failure->($naked), "Can update Naked";
+ ok $naked->make_read_only, "Make Naked read only";
+ ok $update_failure->($naked), "Can't update Naked any more";
+ ok !$update_failure->($sandl), "But can still update Secrets and Lies";
+ my $july4 = eval { Film->create({ title => "4 Days in July" }) };
+ isa_ok $july4 => "Film", "And can still create new films";
+
+ ok(Film->make_read_only, "Make all Films read only");
+ ok $update_failure->($naked), "Still can't update Naked";
+ ok $update_failure->($sandl), "And can't update S&L any more";
+ eval { $july4->delete };
+ like $@, qr/read only/, "And can't delete 4 Days in July";
+ my $abigail = eval { Film->create({ title => "Abigail's Party" }) };
+ like $@, qr/read only/, "Or create new films";
+
+ $sandl->discard_changes;
+}
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/15-accessor.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/16-reserved.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/16-reserved.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/16-reserved.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/16-reserved.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,36 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 5);
+}
+
+use lib 't/cdbi/testlib';
+require Film;
+require Order;
+
+Film->has_many(orders => 'Order');
+Order->has_a(film => 'Film');
+
+Film->create_test_film;
+
+my $film = Film->retrieve('Bad Taste');
+isa_ok $film => 'Film';
+
+$film->add_to_orders({ orders => 10 });
+
+my $bto = (Order->search(film => 'Bad Taste'))[0];
+isa_ok $bto => 'Order';
+is $bto->orders, 10, "Correct number of orders";
+
+
+my $infilm = $bto->film;
+isa_ok $infilm, "Film";
+
+is $infilm->id, $film->id, "Orders hasa Film";
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/16-reserved.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/18-has_a.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/18-has_a.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/18-has_a.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/18-has_a.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,240 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 41);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+use Director;
+ at YA::Film::ISA = 'Film';
+
+Film->create_test_film;
+
+ok my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste";
+ok my $pj = $btaste->Director, "Bad taste has a director";
+ok !ref($pj), ' ... which is not an object';
+
+ok(Film->has_a('Director' => 'Director'), "Link Director table");
+ok(
+ Director->create({
+ Name => 'Peter Jackson',
+ Birthday => -300000000,
+ IsInsane => 1
+ }
+ ),
+ 'create Director'
+);
+
+{
+ ok $btaste = Film->retrieve('Bad Taste'), "Reretrieve Bad Taste";
+ ok $pj = $btaste->Director, "Bad taste now hasa() director";
+ isa_ok $pj => 'Director';
+ {
+ no warnings qw(redefine once);
+ local *Ima::DBI::st::execute =
+ sub { ::fail("Shouldn't need to query db"); };
+ is $pj->id, 'Peter Jackson', 'ID already stored';
+ }
+ ok $pj->IsInsane, "But we know he's insane";
+}
+
+# Oh no! Its Peter Jacksons even twin, Skippy! Born one minute after him.
+my $sj = Director->create({
+ Name => 'Skippy Jackson',
+ Birthday => (-300000000 + 60),
+ IsInsane => 1,
+ });
+
+{
+ eval { $btaste->Director($btaste) };
+ like $@, qr/Director/, "Can't set film as director";
+ is $btaste->Director->id, $pj->id, "PJ still the director";
+
+ # drop from cache so that next retrieve() is from db
+ $btaste->remove_from_object_index;
+}
+
+{ # Still inflated after update
+ my $btaste = Film->retrieve('Bad Taste');
+ isa_ok $btaste->Director, "Director";
+ $btaste->numexplodingsheep(17);
+ $btaste->update;
+ isa_ok $btaste->Director, "Director";
+
+ $btaste->Director('Someone Else');
+ $btaste->update;
+ isa_ok $btaste->Director, "Director";
+ is $btaste->Director->id, "Someone Else", "Can change director";
+}
+
+is $sj->id, 'Skippy Jackson', 'Create new director - Skippy';
+Film->has_a('CoDirector' => 'Director');
+{
+ eval { $btaste->CoDirector("Skippy Jackson") };
+ is $@, "", "Auto inflates";
+ isa_ok $btaste->CoDirector, "Director";
+ is $btaste->CoDirector->id, $sj->id, "To skippy";
+}
+
+$btaste->CoDirector($sj);
+$btaste->update;
+is($btaste->CoDirector->Name, 'Skippy Jackson', 'He co-directed');
+is(
+ $btaste->Director->Name,
+ 'Peter Jackson',
+ "Didnt interfere with each other"
+);
+
+{ # Inheriting hasa
+ my $btaste = YA::Film->retrieve('Bad Taste');
+ is(ref($btaste->Director), 'Director', 'inheriting hasa()');
+ is(ref($btaste->CoDirector), 'Director', 'inheriting hasa()');
+ is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly');
+}
+
+{
+ $sj = Director->retrieve('Skippy Jackson');
+ $pj = Director->retrieve('Peter Jackson');
+
+ my $fail;
+ eval {
+ $fail = YA::Film->create({
+ Title => 'Tastes Bad',
+ Director => $sj,
+ codirector => $btaste,
+ Rating => 'R',
+ NumExplodingSheep => 23
+ });
+ };
+ ok $@, "Can't have film as codirector: $@";
+ is $fail, undef, "We didn't get anything";
+
+ my $tastes_bad = YA::Film->create({
+ Title => 'Tastes Bad',
+ Director => $sj,
+ codirector => $pj,
+ Rating => 'R',
+ NumExplodingSheep => 23
+ });
+ is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director');
+ is(
+ $tastes_bad->_director_accessor->Name,
+ 'Skippy Jackson',
+ 'director_accessor'
+ );
+ is($tastes_bad->codirector->Name, 'Peter Jackson', 'codirector');
+ is(
+ $tastes_bad->_codirector_accessor->Name,
+ 'Peter Jackson',
+ 'codirector_accessor'
+ );
+}
+
+SKIP: {
+ skip "Non-standard CDBI relationships not supported by compat", 9;
+ {
+
+ YA::Film->add_relationship_type(has_a => "YA::HasA");
+
+ package YA::HasA;
+ #use base 'Class::DBI::Relationship::HasA';
+
+ sub _inflator {
+ my $self = shift;
+ my $col = $self->accessor;
+ my $super = $self->SUPER::_inflator($col);
+
+ return $super
+ unless $col eq $self->class->find_column('Director');
+
+ return sub {
+ my $self = shift;
+ $self->_attribute_store($col, 'Ghostly Peter')
+ if $self->_attribute_exists($col)
+ and not defined $self->_attrs($col);
+ return &$super($self);
+ };
+ }
+ }
+ {
+
+ package Rating;
+
+ sub new {
+ my ($class, $mpaa, @details) = @_;
+ bless {
+ MPAA => $mpaa,
+ WHY => "@details"
+ }, $class;
+ }
+ sub mpaa { shift->{MPAA}; }
+ sub why { shift->{WHY}; }
+ }
+ local *Director::mapme = sub {
+ my ($class, $val) = @_;
+ $val =~ s/Skippy/Peter/;
+ $val;
+ };
+ no warnings 'once';
+ local *Director::sanity_check = sub { $_[0]->IsInsane ? undef: $_[0] };
+ YA::Film->has_a(
+ director => 'Director',
+ inflate => 'mapme',
+ deflate => 'sanity_check'
+ );
+ YA::Film->has_a(
+ rating => 'Rating',
+ inflate => sub {
+ my ($val, $parent) = @_;
+ my $sheep = $parent->find_column('NumexplodingSheep');
+ if ($parent->_attrs($sheep) || 0 > 20) {
+ return new Rating 'NC17', 'Graphic ovine violence';
+ } else {
+ return new Rating $val, 'Just because';
+ }
+ },
+ deflate => sub {
+ shift->mpaa;
+ });
+
+ my $tbad = YA::Film->retrieve('Tastes Bad');
+
+ isa_ok $tbad->Director, 'Director';
+ is $tbad->Director->Name, 'Peter Jackson', 'Director shuffle';
+ $tbad->Director('Skippy Jackson');
+ $tbad->update;
+ is $tbad->Director, 'Ghostly Peter', 'Sanity checked';
+
+ isa_ok $tbad->Rating, 'Rating';
+ is $tbad->Rating->mpaa, 'NC17', 'Rating bumped';
+ $tbad->Rating(new Rating 'NS17', 'Shaken sheep');
+ no warnings 'redefine';
+ local *Director::mapme = sub {
+ my ($class, $obj) = @_;
+ $obj->isa('Film') ? $obj->Director : $obj;
+ };
+
+ $pj->IsInsane(0);
+ $pj->update; # Hush warnings
+
+ ok $tbad->Director($btaste), 'Cross-class mapping';
+ is $tbad->Director, 'Peter Jackson', 'Yields PJ';
+ $tbad->update;
+
+ $tbad = Film->retrieve('Tastes Bad');
+ ok !ref($tbad->Rating), 'Unmagical rating';
+ is $tbad->Rating, 'NS17', 'but prior change stuck';
+}
+
+{ # Broken has_a declaration
+ eval { Film->has_a(driector => "Director") };
+ like $@, qr/driector/, "Sensible error from has_a with incorrect column: $@";
+}
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/18-has_a.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/19-set_sql.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/19-set_sql.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/19-set_sql.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/19-set_sql.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,132 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 20);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+use Actor;
+
+{ # Check __ESSENTIAL__ expansion (RT#13038)
+ my @cols = Film->columns('Essential');
+ is_deeply \@cols, ['title'], "1 Column in essential";
+ is +Film->transform_sql('__ESSENTIAL__'), 'title', '__ESSENTIAL__ expansion';
+
+ # This provides a more interesting test
+ Film->columns(Essential => qw(title rating));
+ is +Film->transform_sql('__ESSENTIAL__'), 'title, rating',
+ 'multi-col __ESSENTIAL__ expansion';
+}
+
+my $f1 = Film->create({ title => 'A', director => 'AA', rating => 'PG' });
+my $f2 = Film->create({ title => 'B', director => 'BA', rating => 'PG' });
+my $f3 = Film->create({ title => 'C', director => 'AA', rating => '15' });
+my $f4 = Film->create({ title => 'D', director => 'BA', rating => '18' });
+my $f5 = Film->create({ title => 'E', director => 'AA', rating => '18' });
+
+Film->set_sql(
+ pgs => qq{
+ SELECT __ESSENTIAL__
+ FROM __TABLE__
+ WHERE __TABLE__.rating = 'PG'
+ ORDER BY title DESC
+}
+);
+
+{
+ (my $sth = Film->sql_pgs())->execute;
+ my @pgs = Film->sth_to_objects($sth);
+ is @pgs, 2, "Execute our own SQL";
+ is $pgs[0]->id, $f2->id, "get F2";
+ is $pgs[1]->id, $f1->id, "and F1";
+}
+
+{
+ my @pgs = Film->search_pgs;
+ is @pgs, 2, "SQL creates search() method";
+ is $pgs[0]->id, $f2->id, "get F2";
+ is $pgs[1]->id, $f1->id, "and F1";
+};
+
+Film->set_sql(
+ rating => qq{
+ SELECT __ESSENTIAL__
+ FROM __TABLE__
+ WHERE rating = ?
+ ORDER BY title DESC
+}
+);
+
+{
+ my @pgs = Film->search_rating('18');
+ is @pgs, 2, "Can pass parameters to created search()";
+ is $pgs[0]->id, $f5->id, "F5";
+ is $pgs[1]->id, $f4->id, "and F4";
+};
+
+{
+ Film->set_sql(
+ by_id => qq{
+ SELECT __ESSENTIAL__
+ FROM __TABLE__
+ WHERE __IDENTIFIER__
+ }
+ );
+
+ my $film = Film->retrieve_all->first;
+ my @found = Film->search_by_id($film->id);
+ is @found, 1;
+ is $found[0]->id, $film->id;
+}
+
+
+{
+ Actor->has_a(film => "Film");
+ Film->set_sql(
+ namerate => qq{
+ SELECT __ESSENTIAL(f)__
+ FROM __TABLE(=f)__, __TABLE(Actor=a)__
+ WHERE __JOIN(a f)__
+ AND a.name LIKE ?
+ AND f.rating = ?
+ ORDER BY title
+ }
+ );
+
+ my $a1 = Actor->create({ name => "A1", film => $f1 });
+ my $a2 = Actor->create({ name => "A2", film => $f2 });
+ my $a3 = Actor->create({ name => "B1", film => $f1 });
+
+ my @apg = Film->search_namerate("A_", "PG");
+ is @apg, 2, "2 Films with A* that are PG";
+ is $apg[0]->title, "A", "A";
+ is $apg[1]->title, "B", "and B";
+}
+
+{ # join in reverse
+ Actor->has_a(film => "Film");
+ Film->set_sql(
+ ratename => qq{
+ SELECT __ESSENTIAL(f)__
+ FROM __TABLE(=f)__, __TABLE(Actor=a)__
+ WHERE __JOIN(f a)__
+ AND f.rating = ?
+ AND a.name LIKE ?
+ ORDER BY title
+ }
+ );
+
+ my @apg = Film->search_ratename(PG => "A_");
+ is @apg, 2, "2 Films with A* that are PG";
+ is $apg[0]->title, "A", "A";
+ is $apg[1]->title, "B", "and B";
+}
+
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/19-set_sql.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/21-iterator.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/21-iterator.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/21-iterator.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/21-iterator.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,96 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@");
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 37);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+
+my $it_class = "DBIx::Class::ResultSet";
+
+my @film = (
+ Film->create({ Title => 'Film 1' }),
+ Film->create({ Title => 'Film 2' }),
+ Film->create({ Title => 'Film 3' }),
+ Film->create({ Title => 'Film 4' }),
+ Film->create({ Title => 'Film 5' }),
+ Film->create({ Title => 'Film 6' }),
+);
+
+{
+ my $it1 = Film->retrieve_all;
+ isa_ok $it1, $it_class;
+
+ my $it2 = Film->retrieve_all;
+ isa_ok $it2, $it_class;
+
+ while (my $from1 = $it1->next) {
+ my $from2 = $it2->next;
+ is $from1->id, $from2->id, "Both iterators get $from1";
+ }
+}
+
+{
+ my $it = Film->retrieve_all;
+ is $it->first->title, "Film 1", "Film 1 first";
+ is $it->next->title, "Film 2", "Film 2 next";
+ is $it->first->title, "Film 1", "First goes back to 1";
+ is $it->next->title, "Film 2", "With 2 still next";
+ $it->reset;
+ is $it->next->title, "Film 1", "Reset brings us to film 1 again";
+ is $it->next->title, "Film 2", "And 2 is still next";
+}
+
+
+{
+ my $it = Film->retrieve_all;
+ my @slice = $it->slice(2,4);
+ is @slice, 3, "correct slice size (array)";
+ is $slice[0]->title, "Film 3", "Film 3 first";
+ is $slice[2]->title, "Film 5", "Film 5 last";
+}
+
+{
+ my $it = Film->retrieve_all;
+ my $slice = $it->slice(2,4);
+ isa_ok $slice, $it_class, "slice as iterator";
+ is $slice->count, 3,"correct slice size (array)";
+ is $slice->first->title, "Film 3", "Film 3 first";
+ is $slice->next->title, "Film 4", "Film 4 next";
+ is $slice->first->title, "Film 3", "First goes back to 3";
+ is $slice->next->title, "Film 4", "With 4 still next";
+ $slice->reset;
+ is $slice->next->title, "Film 3", "Reset brings us to film 3 again";
+ is $slice->next->title, "Film 4", "And 4 is still next";
+
+ # check if the original iterator still works
+ is $it->count, 6, "back to the original iterator, is of right size";
+ is $it->first->title, "Film 1", "Film 1 first";
+ is $it->next->title, "Film 2", "Film 2 next";
+ is $it->first->title, "Film 1", "First goes back to 1";
+ is $it->next->title, "Film 2", "With 2 still next";
+ is $it->next->title, "Film 3", "Film 3 is still in original Iterator";
+ $it->reset;
+ is $it->next->title, "Film 1", "Reset brings us to film 1 again";
+ is $it->next->title, "Film 2", "And 2 is still next";
+}
+
+{
+ my $it = Film->retrieve_all;
+ is $it, $it->count, "iterator returns count as a scalar";
+ ok $it, "iterator returns true when there are results";
+}
+
+{
+ my $it = Film->search( Title => "something which does not exist" );
+ is $it, 0;
+ ok !$it, "iterator returns false when no results";
+}
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/21-iterator.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/22-deflate_order.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/22-deflate_order.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/22-deflate_order.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/22-deflate_order.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,30 @@
+$| = 1;
+use strict;
+
+use Test::More;
+
+eval "use DBIx::Class::CDBICompat;";
+if ($@) {
+ plan (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@");
+ next;
+}
+
+eval { require Time::Piece::MySQL };
+plan skip_all => "Need Time::Piece::MySQL for this test" if $@;
+
+eval { require 't/cdbi/testlib/Log.pm' };
+plan skip_all => "Need MySQL for this test" if $@;
+
+plan tests => 2;
+
+package main;
+
+my $log = Log->insert( { message => 'initial message' } );
+ok eval { $log->datetime_stamp }, "Have datetime";
+diag $@ if $@;
+
+$log->message( 'a revised message' );
+$log->update;
+ok eval { $log->datetime_stamp }, "Have datetime after update";
+diag $@ if $@;
+
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/22-deflate_order.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/22-self_referential.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/22-self_referential.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/22-self_referential.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/22-self_referential.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,25 @@
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => 'Class::Trigger and DBIx::ContextualFetch required') : (tests=> 2);
+}
+
+use strict;
+
+use lib 't/cdbi/testlib';
+use Actor;
+use ActorAlias;
+Actor->has_many( aliases => [ 'ActorAlias' => 'alias' ] );
+
+my $first = Actor->create( { Name => 'First' } );
+my $second = Actor->create( { Name => 'Second' } );
+
+ActorAlias->create( { actor => $first, alias => $second } );
+
+my @aliases = $first->aliases;
+
+is( scalar @aliases, 1, 'proper number of aliases' );
+is( $aliases[ 0 ]->name, 'Second', 'proper alias' );
+
+
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/22-self_referential.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/23-cascade.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/23-cascade.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/23-cascade.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/23-cascade.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,78 @@
+use strict;
+use Test::More;
+use Data::Dumper;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 12);
+}
+
+INIT {
+ use lib 't/cdbi/testlib';
+ use Film;
+ use Director;
+}
+
+{ # Cascade on delete
+ Director->has_many(nasties => 'Film');
+
+ my $dir = Director->insert({
+ name => "Lewis Teague",
+ });
+ my $kk = $dir->add_to_nasties({
+ Title => 'Alligator'
+ });
+ is $kk->director, $dir, "Director set OK";
+ is $dir->nasties, 1, "We have one nasty";
+
+ ok $dir->delete;
+ ok !Film->retrieve("Alligator"), "has_many cascade deletes by default";
+}
+
+
+# Two ways of saying not to cascade
+for my $args ({ no_cascade_delete => 1 }, { cascade => "None" }) {
+ Director->has_many(nasties => 'Film', $args);
+
+ my $dir = Director->insert({
+ name => "Lewis Teague",
+ });
+ my $kk = $dir->add_to_nasties({
+ Title => 'Alligator'
+ });
+ is $kk->director, $dir, "Director set OK";
+ is $dir->nasties, 1, "We have one nasty";
+
+ ok $dir->delete;
+ local $Data::Dumper::Terse = 1;
+ ok +Film->retrieve("Alligator"), 'has_many with ' . Dumper ($args);;
+ $kk->delete;
+}
+
+
+#{ # Fail on cascade
+# local $TODO = 'cascade => "Fail" unimplemented';
+#
+# Director->has_many(nasties => Film => { cascade => 'Fail' });
+#
+# my $dir = Director->insert({ name => "Nasty Noddy" });
+# my $kk = $dir->add_to_nasties({ Title => 'Killer Killers' });
+# is $kk->director, $dir, "Director set OK";
+# is $dir->nasties, 1, "We have one nasty";
+#
+# ok !eval { $dir->delete };
+# like $@, qr/1/, "Can't delete while films exist";
+#
+# my $rr = $dir->add_to_nasties({ Title => 'Revenge of the Revengers' });
+# ok !eval { $dir->delete };
+# like $@, qr/2/, "Still can't delete";
+#
+# $dir->nasties->delete_all;
+# ok eval { $dir->delete };
+# is $@, '', "Can delete once films are gone";
+#}
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/23-cascade.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/24-meta_info.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/24-meta_info.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/24-meta_info.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/24-meta_info.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,78 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@"
+ if $@;
+
+ plan skip_all => "Time::Piece required for this test"
+ unless eval { require Time::Piece };
+
+ plan tests => 12;
+}
+
+use Test::Warn;
+
+package Temp::DBI;
+use base qw(DBIx::Class::CDBICompat);
+Temp::DBI->columns(All => qw(id date));
+
+my $strptime_inflate = sub {
+ Time::Piece->strptime(shift, "%Y-%m-%d")
+};
+Temp::DBI->has_a(
+ date => 'Time::Piece',
+ inflate => $strptime_inflate
+);
+
+
+package Temp::Person;
+use base 'Temp::DBI';
+Temp::Person->table('people');
+Temp::Person->columns(Info => qw(name pet));
+Temp::Person->has_a( pet => 'Temp::Pet' );
+
+package Temp::Pet;
+use base 'Temp::DBI';
+Temp::Pet->table('pets');
+Temp::Pet->columns(Info => qw(name));
+Temp::Pet->has_many(owners => 'Temp::Person');
+
+package main;
+
+{
+ my $pn_meta = Temp::Person->meta_info('has_a');
+ is_deeply [sort keys %$pn_meta], [qw/date pet/], "Person has Date and Pet";
+}
+
+{
+ my $pt_meta = Temp::Pet->meta_info;
+ is_deeply [keys %{$pt_meta->{has_a}}], [qw/date/], "Pet has Date";
+ is_deeply [keys %{$pt_meta->{has_many}}], [qw/owners/], "And owners";
+}
+
+{
+ my $pet = Temp::Person->meta_info( has_a => 'pet' );
+ is $pet->class, 'Temp::Person';
+ is $pet->foreign_class, 'Temp::Pet';
+ is $pet->accessor, 'pet';
+ is $pet->name, 'has_a';
+}
+
+{
+ my $owners = Temp::Pet->meta_info( has_many => 'owners' );
+
+ is_deeply $owners->args, {
+ foreign_key => 'pet',
+ mapping => [],
+ };
+}
+
+{
+ my $date = Temp::Pet->meta_info( has_a => 'date' );
+ is $date->class, 'Temp::DBI';
+ is $date->foreign_class, 'Time::Piece';
+ is $date->accessor, 'date';
+ is $date->args->{inflate}, $strptime_inflate;
+}
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/24-meta_info.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/26-mutator.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/26-mutator.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/26-mutator.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/26-mutator.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,47 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@"
+ if $@;
+}
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@
+ ? (skip_all => 'needs DBD::SQLite for testing')
+ : (tests => 6);
+}
+
+use lib 't/cdbi/testlib';
+require Film;
+
+sub Film::accessor_name_for {
+ my ($class, $col) = @_;
+ return "sheep" if lc $col eq "numexplodingsheep";
+ return $col;
+}
+
+my $data = {
+ Title => 'Bad Taste',
+ Director => 'Peter Jackson',
+ Rating => 'R',
+};
+
+my $bt;
+eval {
+ my $data = $data;
+ $data->{sheep} = 1;
+ ok $bt = Film->insert($data), "Modified accessor - with
+accessor";
+ isa_ok $bt, "Film";
+};
+is $@, '', "No errors";
+
+eval {
+ ok $bt->sheep(2), 'Modified accessor, set';
+ ok $bt->update, 'Update';
+};
+is $@, '', "No errors";
+
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/26-mutator.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/30-pager.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/30-pager.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/30-pager.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/30-pager.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,52 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 6);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+
+my @film = (
+ Film->create({ Title => 'Film 1' }),
+ Film->create({ Title => 'Film 2' }),
+ Film->create({ Title => 'Film 3' }),
+ Film->create({ Title => 'Film 4' }),
+ Film->create({ Title => 'Film 5' }),
+);
+
+# first page
+my ( $pager, $it ) = Film->page(
+ {},
+ { rows => 3,
+ page => 1 }
+);
+
+is( $pager->entries_on_this_page, 3, "entries_on_this_page ok" );
+
+is( $pager->next_page, 2, "next_page ok" );
+
+is( $it->next->title, "Film 1", "iterator->next ok" );
+
+$it->next;
+$it->next;
+
+is( $it->next, undef, "next past end of page ok" );
+
+# second page
+( $pager, $it ) = Film->page(
+ {},
+ { rows => 3,
+ page => 2 }
+);
+
+is( $pager->entries_on_this_page, 2, "entries on second page ok" );
+
+is( $it->next->title, "Film 4", "second page first title ok" );
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/30-pager.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/68-inflate_has_a.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/68-inflate_has_a.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/68-inflate_has_a.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/68-inflate_has_a.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,67 @@
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => "Class::Trigger and DBIx::ContextualFetch required"
+ if $@;
+
+ eval { require DateTime };
+ plan skip_all => "Need DateTime for inflation tests" if $@;
+
+ eval { require Clone };
+ plan skip_all => "Need Clone for CDBICompat inflation tests" if $@;
+}
+
+plan tests => 6;
+
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+DBICTest::Schema::CD->load_components(qw/CDBICompat::Relationships/);
+
+DBICTest::Schema::CD->has_a( 'year', 'DateTime',
+ inflate => sub { DateTime->new( year => shift ) },
+ deflate => sub { shift->year }
+);
+Class::C3->reinitialize;
+
+# inflation test
+my $cd = $schema->resultset("CD")->find(3);
+
+is( ref($cd->year), 'DateTime', 'year is a DateTime, ok' );
+
+is( $cd->year->month, 1, 'inflated month ok' );
+
+# deflate test
+my $now = DateTime->now;
+$cd->year( $now );
+$cd->update;
+
+($cd) = $schema->resultset("CD")->search( year => $now->year );
+is( $cd->year->year, $now->year, 'deflate ok' );
+
+# re-test using alternate deflate syntax
+$schema->class("CD")->has_a( 'year', 'DateTime',
+ inflate => sub { DateTime->new( year => shift ) },
+ deflate => 'year'
+);
+
+# inflation test
+$cd = $schema->resultset("CD")->find(3);
+
+is( ref($cd->year), 'DateTime', 'year is a DateTime, ok' );
+
+is( $cd->year->month, 1, 'inflated month ok' );
+
+# deflate test
+$now = DateTime->now;
+$cd->year( $now );
+$cd->update;
+
+($cd) = $schema->resultset("CD")->search( year => $now->year );
+is( $cd->year->year, $now->year, 'deflate ok' );
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/98-failure.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/98-failure.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/98-failure.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/98-failure.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,62 @@
+use strict;
+use Test::More;
+
+#----------------------------------------------------------------------
+# Test database failures
+#----------------------------------------------------------------------
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 7);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+
+Film->create_test_film;
+
+{
+ my $btaste = Film->retrieve('Bad Taste');
+ isa_ok $btaste, 'Film', "We have Bad Taste";
+ {
+ no warnings 'redefine';
+ local *DBIx::ContextualFetch::st::execute = sub { die "Database died" };
+ eval { $btaste->delete };
+ ::like $@, qr/Database died/s, "We failed";
+ }
+ my $still = Film->retrieve('Bad Taste');
+ isa_ok $btaste, 'Film', "We still have Bad Taste";
+}
+
+{
+ my $btaste = Film->retrieve('Bad Taste');
+ isa_ok $btaste, 'Film', "We have Bad Taste";
+ $btaste->numexplodingsheep(10);
+ {
+ no warnings 'redefine';
+ local *DBIx::ContextualFetch::st::execute = sub { die "Database died" };
+ eval { $btaste->update };
+ ::like $@, qr/Database died/s, "We failed";
+ }
+ $btaste->discard_changes;
+ my $still = Film->retrieve('Bad Taste');
+ isa_ok $btaste, 'Film', "We still have Bad Taste";
+ is $btaste->numexplodingsheep, 1, "with 1 sheep";
+}
+
+if (0) {
+ my $sheep = Film->maximum_value_of('numexplodingsheep');
+ is $sheep, 1, "1 exploding sheep";
+ {
+ local *DBIx::ContextualFetch::st::execute = sub { die "Database died" };
+ my $sheep = eval { Film->maximum_value_of('numexplodingsheep') };
+ ::like $@, qr/select.*Database died/s,
+ "Handle database death in single value select";
+ }
+}
+
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/98-failure.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/DeepAbstractSearch (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-DeepAbstractSearch)
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/DeepAbstractSearch
___________________________________________________________________
Name: svn:mergeinfo
+
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/DeepAbstractSearch/01_search.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi-DeepAbstractSearch/01_search.t 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/DeepAbstractSearch/01_search.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -17,7 +17,7 @@
plan tests => 19;
}
-my $DB = "t/testdb";
+my $DB = "t/var/cdbi_testdb";
unlink $DB if -e $DB;
my @DSN = ("dbi:SQLite:dbname=$DB", '', '', { AutoCommit => 0 });
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/abstract (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-abstract)
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/abstract
___________________________________________________________________
Name: svn:mergeinfo
+
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/abstract/search_where.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi-abstract/search_where.t 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/abstract/search_where.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,5 +1,3 @@
-#!/usr/bin/perl -w
-
use Test::More;
use strict;
@@ -16,7 +14,7 @@
}
INIT {
- use lib 't/testlib';
+ use lib 't/cdbi/testlib';
use Film;
}
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/columns_as_hashes.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/columns_as_hashes.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/columns_as_hashes.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/columns_as_hashes.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,104 @@
+use strict;
+use Test::More;
+use Test::Warn;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+ : ('no_plan');
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+
+my $waves = Film->insert({
+ Title => "Breaking the Waves",
+ Director => 'Lars von Trier',
+ Rating => 'R'
+});
+
+local $ENV{DBIC_CDBICOMPAT_HASH_WARN} = 0;
+
+{
+ local $ENV{DBIC_CDBICOMPAT_HASH_WARN} = 1;
+
+ warnings_like {
+ my $rating = $waves->{rating};
+ $waves->Rating("PG");
+ is $rating, "R", 'evaluation of column value is not deferred';
+ } qr{^Column 'rating' of 'Film/$waves' was fetched as a hash at \Q$0};
+
+ warnings_like {
+ is $waves->{title}, $waves->Title, "columns can be accessed as hashes";
+ } qr{^Column 'title' of 'Film/$waves' was fetched as a hash at\b};
+
+ $waves->Rating("G");
+
+ warnings_like {
+ is $waves->{rating}, "G", "updating via the accessor updates the hash";
+ } qr{^Column 'rating' of 'Film/$waves' was fetched as a hash at\b};
+
+
+ warnings_like {
+ $waves->{rating} = "PG";
+ } qr{^Column 'rating' of 'Film/$waves' was stored as a hash at\b};
+
+ $waves->update;
+ my @films = Film->search( Rating => "PG", Title => "Breaking the Waves" );
+ is @films, 1, "column updated as hash was saved";
+}
+
+warning_is {
+ $waves->{rating}
+} '', 'DBIC_CDBICOMPAT_HASH_WARN controls warnings';
+
+
+{
+ $waves->rating("R");
+ $waves->update;
+
+ no warnings 'redefine';
+ local *Film::rating = sub {
+ return "wibble";
+ };
+
+ is $waves->{rating}, "R";
+}
+
+
+{
+ no warnings 'redefine';
+ no warnings 'once';
+ local *Actor::accessor_name_for = sub {
+ my($class, $col) = @_;
+ return "movie" if lc $col eq "film";
+ return $col;
+ };
+
+ require Actor;
+ Actor->has_a( film => "Film" );
+
+ my $actor = Actor->insert({
+ name => 'Emily Watson',
+ film => $waves,
+ });
+
+ ok !eval { $actor->film };
+ is $actor->{film}->id, $waves->id,
+ 'hash access still works despite lack of accessor';
+}
+
+
+# Emulate that Class::DBI inflates immediately
+SKIP: {
+ skip "Need MySQL to run this test", 3 unless eval { require MyFoo };
+
+ my $foo = MyFoo->insert({
+ name => 'Whatever',
+ tdate => '1949-02-01',
+ });
+ isa_ok $foo, 'MyFoo';
+
+ isa_ok $foo->{tdate}, 'Date::Simple';
+ is $foo->{tdate}->year, 1949;
+}
\ No newline at end of file
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/columns_as_hashes.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/columns_dont_override_custom_accessors.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/columns_dont_override_custom_accessors.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/columns_dont_override_custom_accessors.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/columns_dont_override_custom_accessors.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,32 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+ : (tests=> 5);
+}
+
+{
+ package Thing;
+
+ use base 'DBIx::Class::Test::SQLite';
+
+ Thing->columns(TEMP => qw[foo bar]);
+ Thing->columns(All => qw[thing_id yarrow flower]);
+ sub foo { 42 }
+ sub yarrow { "hock" }
+}
+
+is_deeply( [sort Thing->columns("TEMP")],
+ [sort qw(foo bar)],
+ "TEMP columns set"
+);
+my $thing = Thing->construct(
+ { thing_id => 23, foo => "this", bar => "that" }
+);
+
+is( $thing->id, 23 );
+is( $thing->yarrow, "hock", 'custom accessor not overwritten by column' );
+is( $thing->foo, 42, 'custom routine not overwritten by temp column' );
+is( $thing->bar, "that", 'temp column accessor generated' );
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/columns_dont_override_custom_accessors.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/construct.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/construct.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/construct.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/construct.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,43 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+ : (tests=> 5);
+}
+
+INIT {
+ use lib 't/cdbi/testlib';
+ use Film;
+}
+
+{
+ Film->insert({
+ Title => "Breaking the Waves",
+ Director => 'Lars von Trier',
+ Rating => 'R'
+ });
+
+ my $film = Film->construct({
+ Title => "Breaking the Waves",
+ Director => 'Lars von Trier',
+ });
+
+ isa_ok $film, "Film";
+ is $film->title, "Breaking the Waves";
+ is $film->director, "Lars von Trier";
+ is $film->rating, "R",
+ "constructed objects can get missing data from the db";
+}
+
+{
+ package Foo;
+ use base qw(Film);
+ Foo->columns( TEMP => qw(temp_thing) );
+ my $film = Foo->construct({
+ temp_thing => 23
+ });
+
+ ::is $film->temp_thing, 23, "construct sets temp columns";
+}
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/construct.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/copy.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/copy.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/copy.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/copy.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,41 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+ : (tests=> 4);
+}
+
+INIT {
+ use lib 't/cdbi/testlib';
+}
+
+{
+ package # hide from PAUSE
+ MyFilm;
+
+ use base 'DBIx::Class::Test::SQLite';
+ use strict;
+
+ __PACKAGE__->set_table('Movies');
+ __PACKAGE__->columns(All => qw(id title));
+
+ sub create_sql {
+ return qq{
+ id INTEGER PRIMARY KEY AUTOINCREMENT,
+ title VARCHAR(255)
+ }
+ }
+}
+
+my $film = MyFilm->create({ title => "For Your Eyes Only" });
+ok $film->id;
+
+my $new_film = $film->copy;
+ok $new_film->id;
+isnt $new_film->id, $film->id, "copy() gets new primary key";
+
+$new_film = $film->copy(42);
+is $new_film->id, 42, "copy() with new id";
+
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/copy.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/early_column_heisenbug.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/early_column_heisenbug.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/early_column_heisenbug.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/early_column_heisenbug.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,28 @@
+use strict;
+
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+ : ('no_plan');
+}
+
+
+{
+ package Thing;
+ use base qw(DBIx::Class::CDBICompat);
+}
+
+{
+ package Stuff;
+ use base qw(DBIx::Class::CDBICompat);
+}
+
+# There was a bug where looking at a column group before any were
+# set would cause them to be shared across classes.
+is_deeply [Stuff->columns("Essential")], [];
+Thing->columns(Essential => qw(foo bar baz));
+is_deeply [Stuff->columns("Essential")], [];
+
+1;
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/early_column_heisenbug.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/has_many_loads_foreign_class.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/has_many_loads_foreign_class.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/has_many_loads_foreign_class.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/has_many_loads_foreign_class.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,37 @@
+use strict;
+use Test::More;
+
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => 'Class::Trigger and DBIx::ContextualFetch required' if $@;
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 3);
+}
+
+
+use lib 't/cdbi/testlib';
+use Director;
+
+# Test that has_many() will load the foreign class.
+ok !Class::Inspector->loaded( 'Film' );
+ok eval { Director->has_many( films => 'Film' ); 1; } || diag $@;
+
+my $shan_hua = Director->create({
+ Name => "Shan Hua",
+});
+
+my $inframan = Film->create({
+ Title => "Inframan",
+ Director => "Shan Hua",
+});
+my $guillotine2 = Film->create({
+ Title => "Flying Guillotine 2",
+ Director => "Shan Hua",
+});
+my $guillotine = Film->create({
+ Title => "Master of the Flying Guillotine",
+ Director => "Yu Wang",
+});
+
+is_deeply [sort $shan_hua->films], [sort $inframan, $guillotine2];
\ No newline at end of file
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/has_many_loads_foreign_class.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/hasa_without_loading.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/hasa_without_loading.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/hasa_without_loading.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/hasa_without_loading.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,21 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => 'Class::Trigger and DBIx::ContextualFetch required')
+ : (tests=> 2);
+}
+
+package Foo;
+
+use base qw(DBIx::Class::CDBICompat);
+
+eval {
+ Foo->table("foo");
+ Foo->columns(Essential => qw(foo bar));
+ #Foo->has_a( bar => "This::Does::Not::Exist::Yet" );
+};
+#::is $@, '';
+::is(Foo->table, "foo");
+::is_deeply [sort map lc, Foo->columns], [sort map lc, qw(foo bar)];
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/hasa_without_loading.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/max_min_value_of.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/max_min_value_of.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/max_min_value_of.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/max_min_value_of.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,32 @@
+use strict;
+use Test::More;
+
+#----------------------------------------------------------------------
+# Test database failures
+#----------------------------------------------------------------------
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ next;
+ }
+ eval "use DBD::SQLite";
+ plan $@ ? (skip_all => 'needs DBD::SQLite for testing') : (tests => 2);
+}
+
+use lib 't/cdbi/testlib';
+use Film;
+
+Film->create({
+ title => "Bad Taste",
+ numexplodingsheep => 10,
+});
+
+Film->create({
+ title => "Evil Alien Conquerers",
+ numexplodingsheep => 2,
+});
+
+is( Film->maximum_value_of("numexplodingsheep"), 10 );
+is( Film->minimum_value_of("numexplodingsheep"), 2 );
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/max_min_value_of.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/mk_group_accessors.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/mk_group_accessors.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/mk_group_accessors.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/mk_group_accessors.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,69 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => 'Class::Trigger and DBIx::ContextualFetch required' if $@;
+
+ eval "use DBD::SQLite";
+ plan skip_all => 'needs DBD::SQLite for testing' if $@;
+
+ plan 'no_plan';
+}
+
+INIT {
+ use lib 't/cdbi/testlib';
+ require Film;
+}
+
+sub Film::get_test {
+ my $self = shift;
+ my $key = shift;
+ $self->{get_test}++;
+ return $self->{$key};
+}
+
+sub Film::set_test {
+ my($self, $key, $val) = @_;
+ $self->{set_test}++;
+ return $self->{$key} = $val;
+}
+
+
+my $film = Film->create({ Title => "No Wolf McQuade" });
+
+# Test mk_group_accessors() with a list of fields.
+{
+ Film->mk_group_accessors(test => qw(foo bar));
+ $film->foo(42);
+ is $film->foo, 42;
+
+ $film->bar(23);
+ is $film->bar, 23;
+}
+
+
+# An explicit accessor passed to mk_group_accessors should
+# ignore accessor/mutator_name_for.
+sub Film::accessor_name_for {
+ my($class, $col) = @_;
+ return "hlaglagh" if $col eq "wibble";
+ return $col;
+}
+
+sub Film::mutator_name_for {
+ my($class, $col) = @_;
+ return "hlaglagh" if $col eq "wibble";
+ return $col;
+}
+
+
+# Test with a mix of fields and field specs
+{
+ Film->mk_group_accessors(test => ("baz", [wibble_thing => "wibble"]));
+ $film->baz(42);
+ is $film->baz, 42;
+
+ $film->wibble_thing(23);
+ is $film->wibble_thing, 23;
+}
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/mk_group_accessors.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/multi_column_set.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/multi_column_set.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/multi_column_set.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/multi_column_set.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,25 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+ : (tests=> 3);
+}
+
+{
+ package Thing;
+
+ use base 'DBIx::Class::Test::SQLite';
+
+ Thing->columns(TEMP => qw[foo bar baz]);
+ Thing->columns(All => qw[some real stuff]);
+}
+
+my $thing = Thing->construct({ foo => 23, some => 42, baz => 99 });
+$thing->set( foo => "wibble", some => "woosh" );
+is $thing->foo, "wibble";
+is $thing->some, "woosh";
+is $thing->baz, 99;
+
+$thing->discard_changes;
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/multi_column_set.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/object_cache.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/object_cache.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/object_cache.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/object_cache.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,82 @@
+use strict;
+use Test::More;
+$| = 1;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ if ($@) {
+ plan (skip_all => 'Class::Trigger and DBIx::ContextualFetch required');
+ }
+
+ eval "use DBD::SQLite";
+ plan skip_all => 'needs DBD::SQLite for testing' if $@;
+}
+
+INIT {
+ use lib 't/cdbi/testlib';
+ use Film;
+}
+
+plan skip_all => "Object cache is turned off"
+ if Film->isa("DBIx::Class::CDBICompat::NoObjectIndex");
+
+plan tests => 5;
+
+
+ok +Film->create({
+ Title => 'This Is Spinal Tap',
+ Director => 'Rob Reiner',
+ Rating => 'R',
+});
+
+{
+ my $film1 = Film->retrieve( "This Is Spinal Tap" );
+ my $film2 = Film->retrieve( "This Is Spinal Tap" );
+
+ $film1->Director("Marty DiBergi");
+ is $film2->Director, "Marty DiBergi", 'retrieve returns the same object';
+
+ $film1->discard_changes;
+}
+
+{
+ Film->nocache(1);
+
+ my $film1 = Film->retrieve( "This Is Spinal Tap" );
+ my $film2 = Film->retrieve( "This Is Spinal Tap" );
+
+ $film1->Director("Marty DiBergi");
+ is $film2->Director, "Rob Reiner",
+ 'caching turned off';
+
+ $film1->discard_changes;
+}
+
+{
+ Film->nocache(0);
+
+ my $film1 = Film->retrieve( "This Is Spinal Tap" );
+ my $film2 = Film->retrieve( "This Is Spinal Tap" );
+
+ $film1->Director("Marty DiBergi");
+ is $film2->Director, "Marty DiBergi",
+ 'caching back on';
+
+ $film1->discard_changes;
+}
+
+
+{
+ Film->nocache(1);
+
+ local $Class::DBI::Weaken_Is_Available = 0;
+
+ my $film1 = Film->retrieve( "This Is Spinal Tap" );
+ my $film2 = Film->retrieve( "This Is Spinal Tap" );
+
+ $film1->Director("Marty DiBergi");
+ is $film2->Director, "Rob Reiner",
+ 'CDBI::Weaken_Is_Available turns off all caching';
+
+ $film1->discard_changes;
+}
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/object_cache.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/retrieve_from_sql_with_limit.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/retrieve_from_sql_with_limit.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/retrieve_from_sql_with_limit.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/retrieve_from_sql_with_limit.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,25 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan $@ ? (skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@")
+ : (tests=> 3);
+}
+
+INIT {
+ use lib 't/cdbi/testlib';
+ use Film;
+}
+
+for my $title ("Bad Taste", "Braindead", "Forgotten Silver") {
+ Film->insert({ Title => $title, Director => 'Peter Jackson' });
+}
+
+Film->insert({ Title => "Transformers", Director => "Michael Bay"});
+
+{
+ my @films = Film->retrieve_from_sql(qq[director = "Peter Jackson" LIMIT 2]);
+ is @films, 2, "retrieve_from_sql with LIMIT";
+ is( $_->director, "Peter Jackson" ) for @films;
+}
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/retrieve_from_sql_with_limit.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/set_to_undef.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/set_to_undef.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/set_to_undef.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/set_to_undef.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,32 @@
+use strict;
+use Test::More;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@"
+ if $@;
+ plan skip_all => "DateTime required" unless eval { require DateTime };
+ plan tests => 2;
+}
+
+
+# Don't use Test::NoWarnings because of an unrelated DBD::SQLite warning.
+my @warnings;
+local $SIG{__WARN__} = sub {
+ push @warnings, @_;
+};
+
+{
+ package Thing;
+
+ use base 'DBIx::Class::Test::SQLite';
+
+ Thing->columns(All => qw[thing_id this that date]);
+}
+
+my $thing = Thing->construct({ thing_id => 23, this => 42 });
+$thing->set( this => undef );
+is $thing->get( "this" ), undef, 'undef set';
+$thing->discard_changes;
+
+is @warnings, 0, 'no warnings';
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/set_to_undef.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/set_vs_DateTime.t (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-t/set_vs_DateTime.t)
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/cdbi/set_vs_DateTime.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/set_vs_DateTime.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,30 @@
+use strict;
+use Test::More;
+use Test::Exception;
+
+BEGIN {
+ eval "use DBIx::Class::CDBICompat;";
+ plan skip_all => "Class::Trigger and DBIx::ContextualFetch required: $@"
+ if $@;
+ plan skip_all => "DateTime required" unless eval { require DateTime };
+ plan tests => 1;
+}
+
+{
+ package Thing;
+
+ use base 'DBIx::Class::Test::SQLite';
+
+ Thing->columns(All => qw[thing_id this that date]);
+}
+
+my $thing = Thing->construct({ thing_id => 23, date => "01-02-1994" });
+my $date = DateTime->now;
+lives_ok {
+ $thing->set( date => $date );
+ $thing->set( date => $date );
+};
+
+
+
+$thing->discard_changes;
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/set_vs_DateTime.t
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/sweet (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/cdbi-sweet-t)
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/sweet
___________________________________________________________________
Name: svn:mergeinfo
+
Copied: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib (from rev 5343, DBIx-Class/0.08/branches/multi_stuff/t/testlib)
Property changes on: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib
___________________________________________________________________
Name: svn:mergeinfo
+
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Actor.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/testlib/Actor.pm 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Actor.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,8 +1,6 @@
package # hide from PAUSE
Actor;
-BEGIN { unshift @INC, './t/testlib'; }
-
use strict;
use warnings;
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/ActorAlias.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/testlib/ActorAlias.pm 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/ActorAlias.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,27 +1,25 @@
-package # hide from PAUSE
- ActorAlias;
-
-BEGIN { unshift @INC, './t/testlib'; }
-
-use strict;
-use warnings;
-
-use base 'DBIx::Class::Test::SQLite';
-
-__PACKAGE__->set_table( 'ActorAlias' );
-
-__PACKAGE__->columns( Primary => 'id' );
-__PACKAGE__->columns( All => qw/ actor alias / );
-__PACKAGE__->has_a( actor => 'Actor' );
-__PACKAGE__->has_a( alias => 'Actor' );
-
-sub create_sql {
- return qq{
- id INTEGER PRIMARY KEY,
- actor INTEGER,
- alias INTEGER
- }
-}
-
-1;
-
+package # hide from PAUSE
+ ActorAlias;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Test::SQLite';
+
+__PACKAGE__->set_table( 'ActorAlias' );
+
+__PACKAGE__->columns( Primary => 'id' );
+__PACKAGE__->columns( All => qw/ actor alias / );
+__PACKAGE__->has_a( actor => 'Actor' );
+__PACKAGE__->has_a( alias => 'Actor' );
+
+sub create_sql {
+ return qq{
+ id INTEGER PRIMARY KEY,
+ actor INTEGER,
+ alias INTEGER
+ }
+}
+
+1;
+
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Binary.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/testlib/Binary.pm 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Binary.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,8 +1,6 @@
package # hide from PAUSE
Binary;
-BEGIN { unshift @INC, './t/testlib'; }
-
use strict;
use base 'PgBase';
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Blurb.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/testlib/Blurb.pm 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Blurb.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,8 +1,6 @@
package # hide from PAUSE
Blurb;
-BEGIN { unshift @INC, './t/testlib'; }
-
use strict;
use base 'DBIx::Class::Test::SQLite';
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Director.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/testlib/Director.pm 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Director.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,8 +1,6 @@
package # hide from PAUSE
Director;
-BEGIN { unshift @INC, './t/testlib'; }
-
use strict;
use base 'DBIx::Class::Test::SQLite';
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Film.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/testlib/Film.pm 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Film.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,7 +1,6 @@
package # hide from PAUSE
Film;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'DBIx::Class::Test::SQLite';
use strict;
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Lazy.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/testlib/Lazy.pm 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Lazy.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,7 +1,6 @@
package # hide from PAUSE
Lazy;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'DBIx::Class::Test::SQLite';
use strict;
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Log.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/testlib/Log.pm 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Log.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,7 +1,6 @@
package # hide from PAUSE
Log;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'MyBase';
use strict;
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/MyFilm.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/testlib/MyFilm.pm 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/MyFilm.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,7 +1,6 @@
package # hide from PAUSE
MyFilm;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'MyBase';
use MyStarLink;
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/MyFoo.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/testlib/MyFoo.pm 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/MyFoo.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,7 +1,6 @@
package # hide from PAUSE
MyFoo;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'MyBase';
use strict;
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/MyStar.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/testlib/MyStar.pm 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/MyStar.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,7 +1,6 @@
package # hide from PAUSE
MyStar;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'MyBase';
use strict;
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/MyStarLink.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/testlib/MyStarLink.pm 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/MyStarLink.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,7 +1,6 @@
package # hide from PAUSE
MyStarLink;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'MyBase';
use strict;
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/MyStarLinkMCPK.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/testlib/MyStarLinkMCPK.pm 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/MyStarLinkMCPK.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,7 +1,6 @@
package # hide from PAUSE
MyStarLinkMCPK;
-BEGIN { unshift @INC, './t/testlib'; }
use base 'MyBase';
use MyStar;
Modified: DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Order.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/testlib/Order.pm 2009-01-24 18:44:08 UTC (rev 5343)
+++ DBIx-Class/0.08/branches/multi_stuff/t/cdbi/testlib/Order.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -1,8 +1,6 @@
package # hide from PAUSE
Order;
-BEGIN { unshift @INC, './t/testlib'; }
-
use strict;
use base 'DBIx::Class::Test::SQLite';
Modified: DBIx-Class/0.08/branches/multi_stuff/t/lib/DBIC/DebugObj.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/lib/DBIC/DebugObj.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/lib/DBIC/DebugObj.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -28,7 +28,7 @@
$self->debugfh(undef);
$self->dbictest_sql_ref($sql_ref);
- $self->dbictest_bind_ref($bind_ref);
+ $self->dbictest_bind_ref($bind_ref || []);
return $self;
}
Modified: DBIx-Class/0.08/branches/multi_stuff/t/lib/DBIC/SqlMakerTest.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/lib/DBIC/SqlMakerTest.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/lib/DBIC/SqlMakerTest.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -7,8 +7,11 @@
our @EXPORT = qw/
&is_same_sql_bind
+ &is_same_sql
+ &is_same_bind
&eq_sql
&eq_bind
+ &eq_sql_bind
/;
@@ -39,19 +42,59 @@
$tb->ok($same_sql && $same_bind, $msg);
if (!$same_sql) {
- $tb->diag("SQL expressions differ\n"
- . " got: $sql1\n"
- . "expected: $sql2\n"
- );
+ _sql_differ_diag($sql1, $sql2);
}
if (!$same_bind) {
- $tb->diag("BIND values differ\n"
- . " got: " . Dumper($bind_ref1)
- . "expected: " . Dumper($bind_ref2)
- );
+ _bind_differ_diag($bind_ref1, $bind_ref2);
}
}
+ sub is_same_sql
+ {
+ my ($sql1, $sql2, $msg) = @_;
+
+ my $same_sql = eq_sql($sql1, $sql2);
+
+ $tb->ok($same_sql, $msg);
+
+ if (!$same_sql) {
+ _sql_differ_diag($sql1, $sql2);
+ }
+ }
+
+ sub is_same_bind
+ {
+ my ($bind_ref1, $bind_ref2, $msg) = @_;
+
+ my $same_bind = eq_bind($bind_ref1, $bind_ref2);
+
+ $tb->ok($same_bind, $msg);
+
+ if (!$same_bind) {
+ _bind_differ_diag($bind_ref1, $bind_ref2);
+ }
+ }
+
+ sub _sql_differ_diag
+ {
+ my ($sql1, $sql2) = @_;
+
+ $tb->diag("SQL expressions differ\n"
+ . " got: $sql1\n"
+ . "expected: $sql2\n"
+ );
+ }
+
+ sub _bind_differ_diag
+ {
+ my ($bind_ref1, $bind_ref2) = @_;
+
+ $tb->diag("BIND values differ\n"
+ . " got: " . Dumper($bind_ref1)
+ . "expected: " . Dumper($bind_ref2)
+ );
+ }
+
sub eq_sql
{
my ($left, $right) = @_;
@@ -68,6 +111,13 @@
return eq_deeply($bind_ref1, $bind_ref2);
}
+
+ sub eq_sql_bind
+ {
+ my ($sql1, $bind_ref1, $sql2, $bind_ref2) = @_;
+
+ return eq_sql($sql1, $sql2) && eq_bind($bind_ref1, $bind_ref2);
+ }
}
eval "use SQL::Abstract::Test;";
@@ -75,14 +125,20 @@
# SQL::Abstract::Test available
*is_same_sql_bind = \&SQL::Abstract::Test::is_same_sql_bind;
+ *is_same_sql = \&SQL::Abstract::Test::is_same_sql;
+ *is_same_bind = \&SQL::Abstract::Test::is_same_bind;
*eq_sql = \&SQL::Abstract::Test::eq_sql;
*eq_bind = \&SQL::Abstract::Test::eq_bind;
+ *eq_sql_bind = \&SQL::Abstract::Test::eq_sql_bind;
} else {
# old SQL::Abstract
*is_same_sql_bind = \&DBIC::SqlMakerTest::SQLATest::is_same_sql_bind;
+ *is_same_sql = \&DBIC::SqlMakerTest::SQLATest::is_same_sql;
+ *is_same_bind = \&DBIC::SqlMakerTest::SQLATest::is_same_bind;
*eq_sql = \&DBIC::SqlMakerTest::SQLATest::eq_sql;
*eq_bind = \&DBIC::SqlMakerTest::SQLATest::eq_bind;
+ *eq_sql_bind = \&DBIC::SqlMakerTest::SQLATest::eq_sql_bind;
}
@@ -131,6 +187,28 @@
Compares given and expected pairs of C<($sql, \@bind)>, and calls
L<Test::Builder/ok> on the result, with C<$test_msg> as message.
+=head2 is_same_sql
+
+ is_same_sql(
+ $given_sql,
+ $expected_sql,
+ $test_msg
+ );
+
+Compares given and expected SQL statement, and calls L<Test::Builder/ok> on the
+result, with C<$test_msg> as message.
+
+=head2 is_same_bind
+
+ is_same_bind(
+ \@given_bind,
+ \@expected_bind,
+ $test_msg
+ );
+
+Compares given and expected bind value lists, and calls L<Test::Builder/ok> on
+the result, with C<$test_msg> as message.
+
=head2 eq_sql
my $is_same = eq_sql($given_sql, $expected_sql);
@@ -143,7 +221,17 @@
Compares two lists of bind values. Returns true IFF their values are the same.
+=head2 eq_sql_bind
+ my $is_same = eq_sql_bind(
+ $given_sql, \@given_bind,
+ $expected_sql, \@expected_bind
+ );
+
+Compares the two SQL statements and the two lists of bind values. Returns true
+IFF they are equivalent and the bind values are the same.
+
+
=head1 SEE ALSO
L<SQL::Abstract::Test>, L<Test::More>, L<Test::Builder>.
Modified: DBIx-Class/0.08/branches/multi_stuff/t/lib/DBICTest/Schema/Artist.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/lib/DBICTest/Schema/Artist.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/lib/DBICTest/Schema/Artist.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -62,9 +62,8 @@
sub sqlt_deploy_hook {
my ($self, $sqlt_table) = @_;
-
if ($sqlt_table->schema->translator->producer_type =~ /SQLite$/ ) {
- $sqlt_table->add_index( name => 'artist_name', fields => ['name'] )
+ $sqlt_table->add_index( name => 'artist_name_hookidx', fields => ['name'] )
or die $sqlt_table->error;
}
}
Modified: DBIx-Class/0.08/branches/multi_stuff/t/lib/DBICTest/Schema/EventTZ.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/lib/DBICTest/Schema/EventTZ.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/lib/DBICTest/Schema/EventTZ.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -10,7 +10,7 @@
__PACKAGE__->add_columns(
id => { data_type => 'integer', is_auto_increment => 1 },
- starts_at => { data_type => 'datetime', extra => { timezone => "America/Chicago" } },
+ starts_at => { data_type => 'datetime', extra => { timezone => "America/Chicago", locale => 'de_DE' } },
created_on => { data_type => 'timestamp', extra => { timezone => "America/Chicago", floating_tz_ok => 1 } },
);
Modified: DBIx-Class/0.08/branches/multi_stuff/t/lib/DBICTest/Schema.pm
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/lib/DBICTest/Schema.pm 2009-02-19 02:24:44 UTC (rev 5528)
+++ DBIx-Class/0.08/branches/multi_stuff/t/lib/DBICTest/Schema.pm 2009-02-19 03:04:53 UTC (rev 5529)
@@ -41,6 +41,7 @@
'ArtistSubclass',
'Producer',
'CD_to_Producer',
+ 'Dummy', # this is a real result class we remove in the hook below
),
qw/SelfRefAlias TreeLike TwoKeyTreeLike Event EventTZ NoPrimaryKey/,
qw/Collection CollectionObject TypedObject Owners BooksInLibrary/,
Modified: DBIx-Class/0.08/branches/multi_stuff/t/lib/sqlite.sql
===================================================================
Added: DBIx-Class/0.08/branches/multi_stuff/t/resultset/as_query.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/resultset/as_query.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/resultset/as_query.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings FATAL => 'all';
+
+use Data::Dumper;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+plan tests => 4;
+
+my $schema = DBICTest->init_schema();
+my $art_rs = $schema->resultset('Artist');
+my $cdrs = $schema->resultset('CD');
+
+{
+ my $arr = $art_rs->as_query;
+ my ($query, @bind) = @{$$arr};
+
+ is_same_sql_bind(
+ $query, \@bind,
+ "SELECT me.artistid, me.name, me.rank, me.charfield FROM artist me", [],
+ );
+}
+
+$art_rs = $art_rs->search({ name => 'Billy Joel' });
+
+{
+ my $arr = $art_rs->as_query;
+ my ($query, @bind) = @{$$arr};
+
+ is_same_sql_bind(
+ $query, \@bind,
+ "SELECT me.artistid, me.name, me.rank, me.charfield FROM artist me WHERE ( name = ? )",
+ [ [ name => 'Billy Joel' ] ],
+ );
+}
+
+$art_rs = $art_rs->search({ rank => 2 });
+
+{
+ my $arr = $art_rs->as_query;
+ my ($query, @bind) = @{$$arr};
+
+ is_same_sql_bind(
+ $query, \@bind,
+ "SELECT me.artistid, me.name, me.rank, me.charfield FROM artist me WHERE ( ( rank = ? ) AND ( name = ? ) )",
+ [ [ rank => 2 ], [ name => 'Billy Joel' ] ],
+ );
+}
+
+my $rscol = $art_rs->get_column( 'charfield' );
+
+{
+ my $arr = $rscol->as_query;
+ my ($query, @bind) = @{$$arr};
+
+ is_same_sql_bind(
+ $query, \@bind,
+ "SELECT me.charfield FROM artist me WHERE ( ( ( rank = ? ) AND ( name = ? ) ) )",
+ [ [ rank => 2 ], [ name => 'Billy Joel' ] ],
+ );
+}
+
+__END__
Added: DBIx-Class/0.08/branches/multi_stuff/t/search/subquery.t
===================================================================
--- DBIx-Class/0.08/branches/multi_stuff/t/search/subquery.t (rev 0)
+++ DBIx-Class/0.08/branches/multi_stuff/t/search/subquery.t 2009-02-19 03:04:53 UTC (rev 5529)
@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings FATAL => 'all';
+
+use Data::Dumper;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+plan tests => 4;
+
+my $schema = DBICTest->init_schema();
+my $art_rs = $schema->resultset('Artist');
+my $cdrs = $schema->resultset('CD');
+
+{
+ my $cdrs2 = $cdrs->search({
+ artist_id => { 'in' => $art_rs->search({}, { rows => 1 })->get_column( 'id' )->as_query },
+ });
+
+ my $arr = $cdrs2->as_query;
+ my ($query, @bind) = @{$$arr};
+ is_same_sql_bind(
+ $query, \@bind,
+ "SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE artist_id IN ( SELECT id FROM artist me LIMIT 1 )",
+ [],
+ );
+}
+
+TODO: {
+ local $TODO = "'+select' doesn't work with as_query yet.";
+ my $rs = $art_rs->search(
+ {},
+ {
+ '+select' => [
+ $cdrs->search({}, { rows => 1 })->get_column('id')->as_query,
+ ],
+ '+as' => [
+ 'cdid',
+ ],
+ },
+ );
+
+ my $arr = $rs->as_query;
+ my ($query, @bind) = @{$$arr};
+ is_same_sql_bind(
+ $query, \@bind,
+ "SELECT me.artistid, me.name, me.rank, me.charfield, (SELECT id FROM cds LIMIT 1) AS cdid FROM artist me",
+ [],
+ );
+}
+
+TODO: {
+ local $TODO = "'from' doesn't work with as_query yet.";
+ my $rs = $cdrs->search(
+ {},
+ {
+ alias => 'cd2',
+ from => [
+ { cd2 => $cdrs->search({ id => { '>' => 20 } })->as_query },
+ ],
+ },
+ );
+
+ my $arr = $rs->as_query;
+ my ($query, @bind) = @{$$arr};
+ is_same_sql_bind(
+ $query, \@bind,
+ "SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track FROM (SELECT me.artistid, me.name, me.rank, me.charfield FROM cds me WHERE id > 20) cd2",
+ [],
+ );
+}
+
+{
+ my $rs = $cdrs->search({
+ year => {
+ '=' => $cdrs->search(
+ { artistid => { '=' => \'me.artistid' } },
+ { alias => 'inner' }
+ )->get_column('year')->max_rs->as_query,
+ },
+ });
+ my $arr = $rs->as_query;
+ my ($query, @bind) = @{$$arr};
+ is_same_sql_bind(
+ $query, \@bind,
+ "SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE year = (SELECT MAX(inner.year) FROM cd inner WHERE artistid = me.artistid)",
+ [],
+ );
+}
+
+__END__
More information about the Bast-commits
mailing list