[Bast-commits] r5616 - in DBIx-Class/0.08/branches/subquery: .
lib/DBIx/Class lib/DBIx/Class/ResultSource
lib/SQL/Translator/Parser/DBIx t t/96multi_create t/lib
t/lib/DBICNSTest t/lib/DBICNSTest/RtBug41083
t/lib/DBICNSTest/RtBug41083/ResultSet
t/lib/DBICNSTest/RtBug41083/ResultSet_A
t/lib/DBICNSTest/RtBug41083/Schema
t/lib/DBICNSTest/RtBug41083/Schema/Foo
t/lib/DBICNSTest/RtBug41083/Schema_A
t/lib/DBICNSTest/RtBug41083/Schema_A/A t/lib/DBICTest
t/lib/DBICTest/Schema t/ordered
robkinyon at dev.catalyst.perl.org
robkinyon at dev.catalyst.perl.org
Sun Feb 22 01:25:19 GMT 2009
Author: robkinyon
Date: 2009-02-22 01:25:19 +0000 (Sun, 22 Feb 2009)
New Revision: 5616
Added:
DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/ResultSource/View.pm
DBIx-Class/0.08/branches/subquery/t/104view.t
DBIx-Class/0.08/branches/subquery/t/39load_namespaces_rt41083.t
DBIx-Class/0.08/branches/subquery/t/96multi_create/multilev_might_have_PKeqFK.t
DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/
DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/ResultSet.pm
DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/ResultSet/
DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/ResultSet/Foo.pm
DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/ResultSet_A/
DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/ResultSet_A/A.pm
DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema/
DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema/Foo.pm
DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema/Foo/
DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema/Foo/Sub.pm
DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema_A/
DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema_A/A.pm
DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema_A/A/
DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema_A/A/Sub.pm
DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Year1999CDs.pm
DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Year2000CDs.pm
DBIx-Class/0.08/branches/subquery/t/ordered/
DBIx-Class/0.08/branches/subquery/t/ordered/cascade_delete.t
Modified:
DBIx-Class/0.08/branches/subquery/
DBIx-Class/0.08/branches/subquery/Changes
DBIx-Class/0.08/branches/subquery/Makefile.PL
DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Ordered.pm
DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/ResultSource.pm
DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Row.pm
DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Schema.pm
DBIx-Class/0.08/branches/subquery/lib/SQL/Translator/Parser/DBIx/Class.pm
DBIx-Class/0.08/branches/subquery/t/60core.t
DBIx-Class/0.08/branches/subquery/t/66relationship.t
DBIx-Class/0.08/branches/subquery/t/87ordered.t
DBIx-Class/0.08/branches/subquery/t/96multi_create.t
DBIx-Class/0.08/branches/subquery/t/96multi_create/cd_single.t
DBIx-Class/0.08/branches/subquery/t/96multi_create_new.t
DBIx-Class/0.08/branches/subquery/t/96multi_create_torture.t
DBIx-Class/0.08/branches/subquery/t/99dbic_sqlt_parser.t
DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema.pm
DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Employee.pm
DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Track.pm
DBIx-Class/0.08/branches/subquery/t/lib/sqlite.sql
Log:
r5577 at rkinyon-lt-osx (orig r5576): jmmills | 2009-02-20 01:42:38 -0500
r6230 at ofelia (orig r5167): jmmills | 2008-11-20 04:45:48 -0800
Test written.
Currently fails.
r5578 at rkinyon-lt-osx (orig r5577): jmmills | 2009-02-20 01:42:56 -0500
r6232 at ofelia (orig r5169): jmmills | 2008-11-20 07:29:29 -0800
Added weird passes/failes test
r5579 at rkinyon-lt-osx (orig r5578): jmmills | 2009-02-20 01:43:11 -0500
r6233 at ofelia (orig r5170): jmmills | 2008-11-20 07:30:48 -0800
cleaned out unneeded test packages
r5580 at rkinyon-lt-osx (orig r5579): jmmills | 2009-02-20 01:43:28 -0500
r6277 at ofelia (orig r5252): jmmills | 2008-12-16 22:13:07 -0800
A simple fix to the warning generated by a sub-classed proxy - Please verify.
r5581 at rkinyon-lt-osx (orig r5580): jmmills | 2009-02-20 01:43:42 -0500
r6401 at ofelia (orig r5436): jmmills | 2009-02-09 16:23:28 -0800
Modified fix - removed %done tracking and replaced with a more elegant and proper isa() sorting.
The core issue with this bug was that sub classes resultset class would be set before the related parent|super class
was to have it's resultset class. This would cause problems since sub-classes inherit resultset classes from it's parent.
Fix is simple, sort the source classes via sub-class last.
r5582 at rkinyon-lt-osx (orig r5581): jmmills | 2009-02-20 01:45:44 -0500
r6402 at ofelia (orig r5437): jmmills | 2009-02-09 21:30:07 -0800
Merged trunk in to rt_bug_t41083 branch via svk merge.
r5583 at rkinyon-lt-osx (orig r5582): caelum | 2009-02-20 02:03:02 -0500
check a couple more signals during sqlite health check
r5584 at rkinyon-lt-osx (orig r5583): matthewt | 2009-02-20 02:07:46 -0500
revert previous revision
r5587 at rkinyon-lt-osx (orig r5586): matthewt | 2009-02-20 02:55:59 -0500
r27790 at agaton (orig r5451): castaway | 2009-02-11 14:38:08 +0000
Original code
r5588 at rkinyon-lt-osx (orig r5587): matthewt | 2009-02-20 02:56:17 -0500
r27866 at agaton (orig r5527): castaway | 2009-02-18 22:59:29 +0000
Fix name of view.
New sqlite.sql containing test view.
r5589 at rkinyon-lt-osx (orig r5588): matthewt | 2009-02-20 02:56:24 -0500
r27869 at agaton (orig r5530): castaway | 2009-02-19 22:04:06 +0000
Add view test.
Only check is_virtual on view sources
r5590 at rkinyon-lt-osx (orig r5589): matthewt | 2009-02-20 02:56:30 -0500
r27870 at agaton (orig r5531): castaway | 2009-02-19 22:12:20 +0000
Add tests for virtual view
r5591 at rkinyon-lt-osx (orig r5590): matthewt | 2009-02-20 02:56:36 -0500
r27871 at agaton (orig r5532): castaway | 2009-02-19 22:35:05 +0000
POD fixing to explain views, and mention in main ResultSource.
r5592 at rkinyon-lt-osx (orig r5591): matthewt | 2009-02-20 02:56:49 -0500
r5593 at rkinyon-lt-osx (orig r5592): castaway | 2009-02-20 03:01:25 -0500
Add missing views test file, oops
r5594 at rkinyon-lt-osx (orig r5593): matthewt | 2009-02-20 03:16:48 -0500
skip views. because we use get_table to test. that's not gonna work.
r5595 at rkinyon-lt-osx (orig r5594): ribasushi | 2009-02-20 04:17:21 -0500
Ordered now works correctly with MC too \o/
r5596 at rkinyon-lt-osx (orig r5595): ribasushi | 2009-02-20 04:27:42 -0500
Silence verbose MC tests
r5597 at rkinyon-lt-osx (orig r5596): ribasushi | 2009-02-20 04:31:07 -0500
Sanify test
r5598 at rkinyon-lt-osx (orig r5597): ribasushi | 2009-02-20 05:05:35 -0500
Switching Track to Ordered uncovered a number of deficiences - we will keep it this way. Adjusting some tests
r5599 at rkinyon-lt-osx (orig r5598): ribasushi | 2009-02-20 05:05:50 -0500
A couple fixes to Ordered
r5601 at rkinyon-lt-osx (orig r5600): ribasushi | 2009-02-20 08:30:01 -0500
Sanify MC test and correct the plan
r5602 at rkinyon-lt-osx (orig r5601): ribasushi | 2009-02-20 09:08:03 -0500
separate MC failing test
r5603 at rkinyon-lt-osx (orig r5602): ribasushi | 2009-02-20 09:12:29 -0500
failing test pulled
r5604 at rkinyon-lt-osx (orig r5603): ribasushi | 2009-02-20 09:25:41 -0500
moved all evals to lives_ok
r5605 at rkinyon-lt-osx (orig r5604): ribasushi | 2009-02-20 09:33:24 -0500
Ordered test
r5606 at rkinyon-lt-osx (orig r5605): ribasushi | 2009-02-20 09:34:13 -0500
rename test
r5607 at rkinyon-lt-osx (orig r5606): matthewt | 2009-02-20 12:43:27 -0500
more mc fixes
r5608 at rkinyon-lt-osx (orig r5607): matthewt | 2009-02-20 13:12:38 -0500
fix test bug, also: fuck you, multi create
r5609 at rkinyon-lt-osx (orig r5608): ribasushi | 2009-02-20 13:27:39 -0500
Now even the torture corner case works
r5610 at rkinyon-lt-osx (orig r5609): caelum | 2009-02-20 13:39:34 -0500
comment for SIGBUS
r5611 at rkinyon-lt-osx (orig r5610): caelum | 2009-02-20 17:39:31 -0500
make sure to not leave zombie processes from Makefile.PL
r5612 at rkinyon-lt-osx (orig r5611): ribasushi | 2009-02-21 11:28:13 -0500
Extend ordered test
r5613 at rkinyon-lt-osx (orig r5612): ribasushi | 2009-02-21 18:16:04 -0500
Somewhat fix bloody messy test
r5614 at rkinyon-lt-osx (orig r5613): ribasushi | 2009-02-21 18:38:12 -0500
silence loud test
r5615 at rkinyon-lt-osx (orig r5614): ribasushi | 2009-02-21 18:44:41 -0500
Need latest SQLA for proper order_by in Ordered.pm
Also require SQL::Translator for developers
r5616 at rkinyon-lt-osx (orig r5615): ribasushi | 2009-02-21 19:56:47 -0500
FInally rewrote Ordered properly - a number of FIXME's still remain (grep source)
Property changes on: DBIx-Class/0.08/branches/subquery
___________________________________________________________________
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: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/multi_stuff:5565
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle_sequence:4173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/parser_fk_index:4485
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/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:/DBIx-Class/0.08/trunk:5572
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/multi_stuff:5565
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle_sequence:4173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/parser_fk_index:4485
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/replication_dedux:4600
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/rt_bug_41083:5437
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/savepoints:4223
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sqla_1.50_compat:5321
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-ms-access:4142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioned_enhancements:4125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioning:4578
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/views:5585
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/trunk:5615
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/subquery/Changes
===================================================================
--- DBIx-Class/0.08/branches/subquery/Changes 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/Changes 2009-02-22 01:25:19 UTC (rev 5616)
@@ -1,4 +1,6 @@
Revision history for DBIx::Class
+ - multi-create using find_or_create rather than _related for post-insert
+ - fix get_inflated_columns to check has_column_loaded
- Add DBIC_MULTICREATE_DEBUG env var (undocumented, quasi-internal)
- Fix up multi-create to:
- correctly propagate columns loaded during multi-insert of rels
@@ -10,6 +12,8 @@
containing all statements to be executed
- Add as_query() for ResultSet and ResultSetColumn. This makes subqueries
possible. See the Cookbook for details. (robkinyon, michaelr)
+ - Massive rewrite of Ordered to properly handle position constraints and
+ to make it more matpath-friendly
0.08099_06 2009-01-23 07:30:00 (UTC)
- Allow a scalarref to be supplied to the 'from' resultset attribute
Modified: DBIx-Class/0.08/branches/subquery/Makefile.PL
===================================================================
--- DBIx-Class/0.08/branches/subquery/Makefile.PL 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/Makefile.PL 2009-02-22 01:25:19 UTC (rev 5616)
@@ -9,54 +9,57 @@
perl_version '5.006001';
all_from 'lib/DBIx/Class.pm';
-requires 'Data::Page' => 2.00;
-requires 'Scalar::Util' => 0;
-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.08002;
-requires 'JSON::Any' => 1.17;
-requires 'Scope::Guard' => 0.03;
-requires 'Path::Class' => 0;
-requires 'List::Util' => 1.19;
-requires 'Sub::Name' => 0.04;
-requires 'namespace::clean' => 0.09;
+requires 'Data::Page' => 2.00;
+requires 'Scalar::Util' => 0;
+requires 'SQL::Abstract' => 1.49;
+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.08002;
+requires 'JSON::Any' => 1.17;
+requires 'Scope::Guard' => 0.03;
+requires 'Path::Class' => 0;
+requires 'List::Util' => 1.19;
+requires 'Sub::Name' => 0.04;
+requires 'namespace::clean' => 0.09;
# Perl 5.8.0 doesn't have utf8::is_utf8()
-requires 'Encode' => 0 if ($] <= 5.008000);
+requires 'Encode' => 0 if ($] <= 5.008000);
-configure_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;
test_requires 'Test::Deep' => 0;
+recommends 'SQL::Translator' => 0.09004;
+
install_script 'script/dbicadmin';
tests_recursive 't';
# re-build README and require CDBI modules for testing if we're in a checkout
-my @force_build_requires_if_author = qw(
- DBIx::ContextualFetch
- Class::Trigger
- Time::Piece
- Clone
- Test::Pod::Coverage
- Test::Memory::Cycle
+my %force_requires_if_author = (
+ 'DBIx::ContextualFetch' => 0,
+ 'Class::Trigger' => 0,
+ 'Time::Piece' => 0,
+ 'Clone' => 0,
+ 'Test::Pod::Coverage' => 0,
+ 'Test::Memory::Cycle' => 0,
+ 'SQL::Translator' => 0.09004,
);
if ($Module::Install::AUTHOR) {
- foreach my $module (@force_build_requires_if_author) {
- build_requires $module;
+ foreach my $module (keys %force_requires_if_author) {
+ requires ($module => $force_requires_if_author{$module});
}
system('pod2text lib/DBIx/Class.pm > README');
@@ -126,8 +129,15 @@
wait();
alarm 0;
};
+ my $exception = $@;
+
my $sig = $? & 127;
- if ($@ || $sig == POSIX::SIGSEGV()) {
+
+# make sure process actually dies
+ $exception && kill POSIX::SIGKILL(), $pid;
+
+ if ($exception || $sig == POSIX::SIGSEGV() || $sig == POSIX::SIGABRT()
+ || $sig == 7) { # 7 == SIGBUS, haven't seen it but just in case
warn (<<EOE);
############################### WARNING #################################
@@ -160,7 +170,7 @@
# Need to do this _after_ WriteAll else it looses track of them
Meta->{values}{build_requires} = [ grep {
my $ok = 1;
- foreach my $module (@force_build_requires_if_author) {
+ foreach my $module (keys %force_requires_if_author) {
if ($_->[0] =~ /$module/) {
$ok = 0;
last;
Modified: DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Ordered.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Ordered.pm 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Ordered.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -1,4 +1,3 @@
-# vim: ts=8:sw=4:sts=4:et
package DBIx::Class::Ordered;
use strict;
use warnings;
@@ -121,117 +120,158 @@
__PACKAGE__->mk_classdata( 'grouping_column' );
+=head2 null_position_value
+
+ __PACKAGE__->null_position_value(undef);
+
+This method specifies a value of L</position_column> which B<would
+never be assigned to a row> during normal operation. When
+a row is moved, its position is set to this value temporarily, so
+that any unique constrainst can not be violated. This value defaults
+to 0, which should work for all cases except when your positions do
+indeed start from 0.
+
+=cut
+
+__PACKAGE__->mk_classdata( 'null_position_value' => 0 );
+
=head2 siblings
my $rs = $item->siblings();
my @siblings = $item->siblings();
-Returns either a resultset or an array of all other objects
-excluding the one you called it on.
+Returns an B<ordered> resultset of all other objects in the same
+group excluding the one you called it on.
+The ordering is a backwards-compatibility artifact - if you need
+a resultset with no ordering applied use L</_siblings>
+
=cut
-
sub siblings {
- my( $self ) = @_;
- my $position_column = $self->position_column;
- my $rs = $self->result_source->resultset->search(
- {
- $position_column => { '!=' => $self->get_column($position_column) },
- $self->_grouping_clause(),
- },
- { order_by => $self->position_column },
- );
- return $rs->all() if (wantarray());
- return $rs;
+ my $self = shift;
+ return $self->_siblings->search ({}, { order_by => $self->position_column } );
}
-=head2 first_sibling
+=head2 previous_siblings
- my $sibling = $item->first_sibling();
+ my $prev_rs = $item->previous_siblings();
+ my @prev_siblings = $item->previous_siblings();
-Returns the first sibling object, or 0 if the first sibling
-is this sibling.
+Returns a resultset of all objects in the same group
+positioned before the object on which this method was called.
=cut
-
-sub first_sibling {
- my( $self ) = @_;
- return 0 if ($self->get_column($self->position_column())==1);
-
- return ($self->result_source->resultset->search(
- {
- $self->position_column => 1,
- $self->_grouping_clause(),
- },
- )->all())[0];
+sub previous_siblings {
+ my $self = shift;
+ my $position_column = $self->position_column;
+ my $position = $self->get_column ($position_column);
+ return ( defined $position
+ ? $self->_siblings->search ({ $position_column => { '<', $position } })
+ : $self->_siblings
+ );
}
-=head2 last_sibling
+=head2 next_siblings
- my $sibling = $item->last_sibling();
+ my $next_rs = $item->next_siblings();
+ my @next_siblings = $item->next_siblings();
-Returns the last sibling, or 0 if the last sibling is this
-sibling.
+Returns a resultset of all objects in the same group
+positioned after the object on which this method was called.
=cut
-
-sub last_sibling {
- my( $self ) = @_;
- my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
- return 0 if ($self->get_column($self->position_column())==$count);
- return ($self->result_source->resultset->search(
- {
- $self->position_column => $count,
- $self->_grouping_clause(),
- },
- )->all())[0];
+sub next_siblings {
+ my $self = shift;
+ my $position_column = $self->position_column;
+ my $position = $self->get_column ($position_column);
+ return ( defined $position
+ ? $self->_siblings->search ({ $position_column => { '>', $position } })
+ : $self->_siblings
+ );
}
=head2 previous_sibling
my $sibling = $item->previous_sibling();
-Returns the sibling that resides one position back. Returns undef
+Returns the sibling that resides one position back. Returns 0
if the current object is the first one.
=cut
sub previous_sibling {
- my( $self ) = @_;
+ my $self = shift;
my $position_column = $self->position_column;
- my $position = $self->get_column( $position_column );
- return 0 if ($position==1);
- return ($self->result_source->resultset->search(
- {
- $position_column => $position - 1,
- $self->_grouping_clause(),
- }
- )->all())[0];
+
+ my $psib = $self->previous_siblings->search(
+ {},
+ { rows => 1, order_by => { '-desc' => $position_column } },
+ )->single;
+
+ return defined $psib ? $psib : 0;
}
+=head2 first_sibling
+
+ my $sibling = $item->first_sibling();
+
+Returns the first sibling object, or 0 if the first sibling
+is this sibling.
+
+=cut
+
+sub first_sibling {
+ my $self = shift;
+ my $position_column = $self->position_column;
+
+ my $fsib = $self->previous_siblings->search(
+ {},
+ { rows => 1, order_by => { '-asc' => $position_column } },
+ )->single;
+
+ return defined $fsib ? $fsib : 0;
+}
+
=head2 next_sibling
my $sibling = $item->next_sibling();
-Returns the sibling that resides one position forward. Returns undef
+Returns the sibling that resides one position forward. Returns 0
if the current object is the last one.
=cut
sub next_sibling {
- my( $self ) = @_;
+ my $self = shift;
my $position_column = $self->position_column;
- my $position = $self->get_column( $position_column );
- my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
- return 0 if ($position==$count);
- return ($self->result_source->resultset->search(
- {
- $position_column => $position + 1,
- $self->_grouping_clause(),
- },
- )->all())[0];
+ my $nsib = $self->next_siblings->search(
+ {},
+ { rows => 1, order_by => { '-asc' => $position_column } },
+ )->single;
+
+ return defined $nsib ? $nsib : 0;
}
+=head2 last_sibling
+
+ my $sibling = $item->last_sibling();
+
+Returns the last sibling, or 0 if the last sibling is this
+sibling.
+
+=cut
+
+sub last_sibling {
+ my $self = shift;
+ my $position_column = $self->position_column;
+ my $lsib = $self->next_siblings->search(
+ {},
+ { rows => 1, order_by => { '-desc' => $position_column } },
+ )->single;
+
+ return defined $lsib ? $lsib : 0;
+}
+
=head2 move_previous
$item->move_previous();
@@ -243,9 +283,8 @@
=cut
sub move_previous {
- my( $self ) = @_;
- my $position = $self->get_column( $self->position_column() );
- return $self->move_to( $position - 1 );
+ my $self = shift;
+ return $self->move_to ($self->_position - 1);
}
=head2 move_next
@@ -259,11 +298,9 @@
=cut
sub move_next {
- my( $self ) = @_;
- my $position = $self->get_column( $self->position_column() );
- my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
- return 0 if ($position==$count);
- return $self->move_to( $position + 1 );
+ my $self = shift;
+ return 0 unless $self->next_siblings->count;
+ return $self->move_to ($self->_position + 1);
}
=head2 move_first
@@ -276,8 +313,7 @@
=cut
sub move_first {
- my( $self ) = @_;
- return $self->move_to( 1 );
+ return shift->move_to( 1 );
}
=head2 move_last
@@ -290,9 +326,8 @@
=cut
sub move_last {
- my( $self ) = @_;
- my $count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
- return $self->move_to( $count );
+ my $self = shift;
+ return $self->move_to( $self->_group_rs->count );
}
=head2 move_to
@@ -307,28 +342,34 @@
sub move_to {
my( $self, $to_position ) = @_;
- my $position_column = $self->position_column;
- my $from_position = $self->get_column( $position_column );
return 0 if ( $to_position < 1 );
- return 0 if ( $from_position==$to_position );
- my @between = (
- ( $from_position < $to_position )
- ? ( $from_position+1, $to_position )
- : ( $to_position, $from_position-1 )
- );
- my $rs = $self->result_source->resultset->search({
- $position_column => { -between => [ @between ] },
- $self->_grouping_clause(),
- });
- my $op = ($from_position>$to_position) ? '+' : '-';
- $rs->update({ $position_column => \"$position_column $op 1" }); #" Sorry, GEdit bug
- $self->{_ORDERED_INTERNAL_UPDATE} = 1;
- $self->update({ $position_column => $to_position });
- return 1;
-}
+ my $from_position = $self->_position;
+ return 0 if ( $from_position == $to_position );
+ my $position_column = $self->position_column;
+ # FIXME this needs to be wrapped in a transaction
+ {
+ my ($direction, @between);
+ if ( $from_position < $to_position ) {
+ $direction = -1;
+ @between = map { $self->_position_value ($_) } ( $from_position + 1, $to_position );
+ }
+ else {
+ $direction = 1;
+ @between = map { $self->_position_value ($_) } ( $to_position, $from_position - 1 );
+ }
+
+ my $new_pos_val = $self->_position_value ($to_position); # record this before the shift
+ $self->_ordered_internal_update({ $position_column => $self->null_position_value }); # take the row out of the picture for a bit
+ $self->_shift_siblings ($direction, @between);
+ $self->_ordered_internal_update({ $position_column => $new_pos_val });
+
+ return 1;
+ }
+}
+
=head2 move_to_group
$item->move_to_group( $group, $position );
@@ -347,44 +388,51 @@
sub move_to_group {
my( $self, $to_group, $to_position ) = @_;
+ $self->throw_exception ('move_to_group() expects a group specification')
+ unless defined $to_group;
+
# if we're given a string, turn it into a hashref
unless (ref $to_group eq 'HASH') {
- $to_group = {($self->_grouping_columns)[0] => $to_group};
+ my @gcols = $self->_grouping_columns;
+
+ $self->throw_exception ('Single group supplied for a multi-column group identifier') if @gcols > 1;
+ $to_group = {$gcols[0] => $to_group};
}
my $position_column = $self->position_column;
- #my @grouping_columns = $self->_grouping_columns;
- return 0 if ( ! defined($to_group) );
return 0 if ( defined($to_position) and $to_position < 1 );
- return 0 if ( $self->_is_in_group($to_group)
- and ((not defined($to_position))
- or (defined($to_position) and $self->$position_column==$to_position)
- )
- );
+ if ($self->_is_in_group ($to_group) ) {
+ return 0 if not defined $to_position;
+ return $self->move_to ($to_position);
+ }
- # Move to end of current group and adjust siblings
- $self->move_last;
+ # FIXME this needs to be wrapped in a transaction
+ {
+ # Move to end of current group to adjust siblings
+ $self->move_last;
- $self->set_columns($to_group);
- my $new_group_count = $self->result_source->resultset->search({$self->_grouping_clause()})->count();
- if (!defined($to_position) or $to_position > $new_group_count) {
- $self->{_ORDERED_INTERNAL_UPDATE} = 1;
- $self->update({ $position_column => $new_group_count + 1 });
- }
- else {
- my @between = ($to_position, $new_group_count);
+ $self->set_inflated_columns({ %$to_group, $position_column => undef });
+ my $new_group_count = $self->_group_rs->count;
- my $rs = $self->result_source->resultset->search({
- $position_column => { -between => [ @between ] },
- $self->_grouping_clause(),
- });
- $rs->update({ $position_column => \"$position_column + 1" }); #"
- $self->{_ORDERED_INTERNAL_UPDATE} = 1;
- $self->update({ $position_column => $to_position });
+ if ( not defined($to_position) or $to_position > $new_group_count) {
+ $self->set_column(
+ $position_column => $new_group_count
+ ? $self->_next_position_value ( $self->last_sibling->get_column ($position_column) ) # FIXME - no need to inflate last_sibling
+ : $self->_initial_position_value
+ );
+ }
+ else {
+ my $bumped_pos_val = $self->_position_value ($to_position);
+ my @between = ($to_position, $new_group_count);
+ $self->_shift_siblings (1, @between); #shift right
+ $self->set_column( $position_column => $bumped_pos_val );
+ }
+
+ $self->_ordered_internal_update;
+
+ return 1;
}
-
- return 1;
}
=head2 insert
@@ -398,8 +446,17 @@
sub insert {
my $self = shift;
my $position_column = $self->position_column;
- $self->set_column( $position_column => $self->result_source->resultset->search( {$self->_grouping_clause()} )->count()+1 )
- if (!$self->get_column($position_column));
+
+ unless ($self->get_column($position_column)) {
+ my $lsib = $self->last_sibling; # FIXME - no need to inflate last_sibling
+ $self->set_column(
+ $position_column => ($lsib
+ ? $self->_next_position_value ( $lsib->get_column ($position_column) )
+ : $self->_initial_position_value
+ )
+ );
+ }
+
return $self->next::method( @_ );
}
@@ -416,63 +473,228 @@
sub update {
my $self = shift;
- if ($self->{_ORDERED_INTERNAL_UPDATE}) {
- delete $self->{_ORDERED_INTERNAL_UPDATE};
- return $self->next::method( @_ );
- }
+ # this is set by _ordered_internal_update()
+ return $self->next::method(@_) if $self->{_ORDERED_INTERNAL_UPDATE};
- $self->set_columns($_[0]) if @_ > 0;
+ my $upd = shift;
+ $self->set_inflated_columns($upd) if $upd;
my %changes = $self->get_dirty_columns;
$self->discard_changes;
- my $pos_col = $self->position_column;
+ my $position_column = $self->position_column;
- # if any of our grouping columns have been changed
- if (grep {$_} map {exists $changes{$_}} $self->_grouping_columns ) {
+ # if nothing group/position related changed - short circuit
+ if (not grep { exists $changes{$_} } ($self->_grouping_columns, $position_column) ) {
+ return $self->next::method( \%changes, @_ );
+ }
- # create new_group by taking the current group and inserting changes
- my $new_group = {$self->_grouping_clause};
- foreach my $col (keys %$new_group) {
- if (exists $changes{$col}) {
- $new_group->{$col} = $changes{$col};
- delete $changes{$col}; # don't want to pass this on to next::method
+ # FIXME this needs to be wrapped in a transaction
+ {
+ # if any of our grouping columns have been changed
+ if (grep { exists $changes{$_} } ($self->_grouping_columns) ) {
+
+ # create new_group by taking the current group and inserting changes
+ my $new_group = {$self->_grouping_clause};
+ foreach my $col (keys %$new_group) {
+ if (exists $changes{$col}) {
+ $new_group->{$col} = delete $changes{$col}; # don't want to pass this on to next::method
+ }
}
+
+ $self->move_to_group(
+ $new_group,
+ (exists $changes{$position_column}
+ # The FIXME bit contradicts the documentation: when changing groups without supplying explicit
+ # positions in move_to_group(), we push the item to the end of the group.
+ # However when I was rewriting this, the position from the old group was clearly passed to the new one
+ # Probably needs to go away (by ribasushi)
+ ? delete $changes{$position_column} # means there was a position change supplied with the update too
+ : $self->_position # FIXME!
+ ),
+ );
}
+ elsif (exists $changes{$position_column}) {
+ $self->move_to(delete $changes{$position_column});
+ }
- $self->move_to_group(
- $new_group,
- exists($changes{$pos_col}) ? delete($changes{$pos_col}) : $self->$pos_col
- );
+ return $self->next::method( \%changes, @_ );
}
- elsif (exists $changes{$pos_col}) {
- $self->move_to(delete $changes{$pos_col});
- }
- return $self->next::method( \%changes );
}
=head2 delete
Overrides the DBIC delete() method by first moving the object
-to the last position, then deleting it, thus ensuring the
+to the last position, then deleting it, thus ensuring the
integrity of the positions.
=cut
sub delete {
my $self = shift;
- $self->move_last;
- return $self->next::method( @_ );
+ # FIXME this needs to be wrapped in a transaction
+ {
+ $self->move_last;
+ return $self->next::method( @_ );
+ }
}
+=head1 Methods for extending Ordered
+
+You would want to override the methods below if you use sparse
+(non-linear) or non-numeric position values. This can be useful
+if you are working with preexisting non-normalised position data,
+or if you need to work with materialized path columns.
+
+=head2 _position
+
+ my $num_pos = $item->_position;
+
+Returns the absolute numeric position of the current object, with the
+first object being at position 1, its sibling at position 2 and so on.
+By default simply returns the value of L</position_column>.
+
+=cut
+sub _position {
+ my $self = shift;
+
+# #the right way to do this
+# return $self->previous_siblings->count + 1;
+
+ return $self->get_column ($self->position_column);
+}
+
+=head2 _position_value
+
+ my $pos_value = $item->_position_value ( $pos )
+
+Returns the value of L</position_column> of the object at numeric
+position C<$pos>. By default simply returns C<$pos>.
+
+=cut
+sub _position_value {
+ my ($self, $pos) = @_;
+
+# #the right way to do this (not optimized)
+# my $position_column = $self->position_column;
+# return $self -> _group_rs
+# -> search({}, { order_by => $position_column })
+# -> slice ( $pos - 1)
+# -> single
+# -> get_column ($position_column);
+
+ return $pos;
+}
+
+=head2 _initial_position_value
+
+ __PACKAGE__->_initial_position_value(0);
+
+This method specifies a value of L</position_column> which is assigned
+to the first inserted element of a group, if no value was supplied at
+insertion time. All subsequent values are derived from this one by
+L</_next_position_value> below. Defaults to 1.
+
+=cut
+
+__PACKAGE__->mk_classdata( '_initial_position_value' => 1 );
+
+=head2 _next_position_value
+
+ my $new_value = $item->_next_position_value ( $position_value )
+
+Returns a position value that would be considered C<next> with
+regards to C<$position_value>. Can be pretty much anything, given
+that C<< $position_value < $new_value >> where C<< < >> is the
+SQL comparison operator (usually works fine on strings). The
+default method expects C<$position_value> to be numeric, and
+returns C<$position_value + 1>
+
+=cut
+sub _next_position_value {
+ return $_[1] + 1;
+}
+
+=head2 _shift_siblings
+
+ $item->_shift_siblings ($direction, @between)
+
+Shifts all siblings with position in the range @between (inclusive)
+by one position as specified by $direction (left if < 0, right if > 0).
+By default simply increments/decrements each L<position_column> value
+by 1.
+
+=cut
+sub _shift_siblings {
+ my ($self, $direction, @between) = @_;
+ return 0 unless $direction;
+
+ my $position_column = $self->position_column;
+
+ my ($op, $ord);
+ if ($direction < 0) {
+ $op = '-';
+ $ord = 'asc';
+ }
+ else {
+ $op = '+';
+ $ord = 'desc';
+ }
+
+ my $shift_rs = $self->_group_rs-> search ({ $position_column => { -between => \@between } });
+
+ # some databases (sqlite) are dumb and can not do a blanket
+ # increment/decrement. So what we do here is check if the
+ # position column is part of a unique constraint, and do a
+ # one-by-one update if this is the case
+
+ my %uc = $self->result_source->unique_constraints;
+ if (grep { $_ eq $position_column } ( map { @$_ } (values %uc) ) ) {
+
+ my $rs = $shift_rs->search ({}, { order_by => { "-$ord", $position_column } } );
+ # FIXME - no need to inflate each row
+ while (my $r = $rs->next) {
+ $r->_ordered_internal_update ({ $position_column => \ "$position_column $op 1" } );
+ }
+ }
+ else {
+ $shift_rs->update ({ $position_column => \ "$position_column $op 1" } );
+ }
+}
+
=head1 PRIVATE METHODS
These methods are used internally. You should never have the
need to use them.
+=head2 _group_rs
+
+This method returns a resultset containing all memebers of the row
+group (including the row itself).
+
+=cut
+sub _group_rs {
+ my $self = shift;
+ return $self->result_source->resultset->search({$self->_grouping_clause()});
+}
+
+=head2 _siblings
+
+Returns an unordered resultset of all objects in the same group
+excluding the object you called this method on.
+
+=cut
+sub _siblings {
+ my $self = shift;
+ my $position_column = $self->position_column;
+ return $self->_group_rs->search(
+ { $position_column => { '!=' => $self->get_column($position_column) } },
+ );
+}
+
=head2 _grouping_clause
-This method returns one or more name=>value pairs for limiting a search
-by the grouping column(s). If the grouping column is not
+This method returns one or more name=>value pairs for limiting a search
+by the grouping column(s). If the grouping column is not
defined then this will return an empty list.
=cut
@@ -481,8 +703,6 @@
return map { $_ => $self->get_column($_) } $self->_grouping_columns();
}
-
-
=head2 _get_grouping_columns
Returns a list of the column names used for grouping, regardless of whether
@@ -502,55 +722,60 @@
}
}
+=head2 _is_in_group
-
-=head2 _is_in_group($other)
-
$item->_is_in_group( {user => 'fred', list => 'work'} )
Returns true if the object is in the group represented by hashref $other
+
=cut
sub _is_in_group {
my ($self, $other) = @_;
my $current = {$self->_grouping_clause};
- return 0 unless (ref $other eq 'HASH') and (keys %$current == keys %$other);
+
+ no warnings qw/uninitialized/;
+
+ return 0 if (
+ join ("\x00", sort keys %$current)
+ ne
+ join ("\x00", sort keys %$other)
+ );
for my $key (keys %$current) {
- return 0 unless exists $other->{$key};
return 0 if $current->{$key} ne $other->{$key};
}
return 1;
}
+sub _ordered_internal_update {
+ my $self = shift;
+ local $self->{_ORDERED_INTERNAL_UPDATE} = 1;
+ return $self->update (@_);
+}
1;
+
__END__
-=head1 BUGS
+=head1 CAVEATS
-=head2 Unique Constraints
-
-Unique indexes and constraints on the position column are not
-supported at this time. It would be make sense to support them,
-but there are some unexpected database issues that make this
-hard to do. The main problem from the author's view is that
-SQLite (the DB engine that we use for testing) does not support
-ORDER BY on updates.
-
=head2 Race Condition on Insert
If a position is not specified for an insert than a position
-will be chosen based on COUNT(*)+1. But, it first selects the
-count, and then inserts the record. The space of time between select
-and insert introduces a race condition. To fix this we need the
-ability to lock tables in DBIC. I've added an entry in the TODO
-about this.
+will be chosen based either on L</_initial_position_value> or
+L</_next_position_value>, depending if there are already some
+items in the current group. The space of time between the
+necessary selects and insert introduces a race condition.
+Having unique constraints on your position/group columns,
+and using transactions (see L<DBIx::Class::Storage/txn_do>)
+will prevent such race conditions going undetected.
=head2 Multiple Moves
Be careful when issueing move_* methods to multiple objects. If
you've pre-loaded the objects then when you move one of the objects
the position of the other object will not reflect their new value
-until you reload them from the database.
+until you reload them from the database - see
+L<DBIx::Class::Row/discard_changes>.
There are times when you will want to move objects as groups, such
as changeing the parent of several objects at once - this directly
Added: DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/ResultSource/View.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/ResultSource/View.pm (rev 0)
+++ DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/ResultSource/View.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -0,0 +1,123 @@
+package DBIx::Class::ResultSource::View;
+
+use strict;
+use warnings;
+
+use DBIx::Class::ResultSet;
+
+use base qw/DBIx::Class/;
+__PACKAGE__->load_components(qw/ResultSource/);
+__PACKAGE__->mk_group_accessors(
+ 'simple' => qw(is_virtual view_definition)
+);
+
+=head1 NAME
+
+DBIx::Class::ResultSource::View - ResultSource object representing a view
+
+=head1 SYNOPSIS
+
+ package MyDB::Schema::Year2000CDs;
+
+ use DBIx::Class::ResultSource::View;
+
+ __PACKAGE__->load_components('Core');
+ __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
+
+ __PACKAGE__->table('year2000cds');
+ __PACKAGE__->result_source_instance->is_virtual(1);
+ __PACKAGE__->result_source_instance->view_definition(
+ "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
+ );
+
+=head1 DESCRIPTION
+
+View object that inherits from L<DBIx::Class::ResultSource>
+
+This class extends ResultSource to add basic view support.
+
+A view has a L</view_definition>, which contains an SQL query. The
+query cannot have parameters. It may contain JOINs, sub selects and
+any other SQL your database supports.
+
+View definition SQL is deployed to your database on
+L<DBIx::Class::Schema/deploy> unless you set L</is_virtual> to true.
+
+Deploying the view does B<not> translate it between different database
+syntaxes, so be careful what you write in your view SQL.
+
+Virtual views (L</is_virtual> unset or false), are assumed to not
+exist in your database as a real view. The L</view_definition> in this
+case replaces the view name in a FROM clause in a subselect.
+
+=head1 SQL EXAMPLES
+
+=over
+
+=item is_virtual set to true
+
+ $schema->resultset('Year2000CDs')->all();
+
+ SELECT cdid, artist, title FROM year2000cds me
+
+=item is_virtual set to false
+
+ $schema->resultset('Year2000CDs')->all();
+
+ SELECT cdid, artist, title FROM
+ (SELECT cdid, artist, title FROM cd WHERE year ='2000') me
+
+=back
+
+=head1 METHODS
+
+=head2 is_virtual
+
+ __PACKAGE__->result_source_instance->is_virtual(1);
+
+Set to true for a virtual view, false or unset for a real
+database-based view.
+
+=head2 view_definition
+
+ __PACKAGE__->result_source_instance->view_definition(
+ "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
+ );
+
+An SQL query for your view. Will not be translated across database
+syntaxes.
+
+
+=head1 OVERRIDDEN METHODS
+
+=head2 from
+
+Returns the FROM entry for the table (i.e. the view name)
+or the SQL as a subselect if this is a virtual view.
+
+=cut
+
+sub from {
+ my $self = shift;
+ return \"(${\$self->view_definition})" if $self->is_virtual;
+ return $self->name;
+}
+
+1;
+
+=head1 AUTHORS
+
+Matt S. Trout <mst at shadowcatsystems.co.uk>
+
+With Contributions from:
+
+Guillermo Roditi E<lt>groditi at cpan.orgE<gt>
+
+Jess Robinson <castaway at desert-island.me.uk>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
Modified: DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/ResultSource.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/ResultSource.pm 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/ResultSource.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -29,6 +29,8 @@
A ResultSource is a component of a schema from which results can be directly
retrieved, most usually a table (see L<DBIx::Class::ResultSource::Table>)
+Basic view support also exists, see L<<DBIx::Class::ResultSource::View>.
+
=head1 METHODS
=pod
Modified: DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Row.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Row.pm 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Row.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -85,17 +85,20 @@
sub __new_related_find_or_new_helper {
my ($self, $relname, $data) = @_;
if ($self->__their_pk_needs_us($relname, $data)) {
+ MULTICREATE_DEBUG and warn "MC $self constructing $relname via new_result";
return $self->result_source
->related_source($relname)
->resultset
->new_result($data);
}
if ($self->result_source->pk_depends_on($relname, $data)) {
+ MULTICREATE_DEBUG and warn "MC $self constructing $relname via find_or_new";
return $self->result_source
->related_source($relname)
->resultset
- ->find_or_create($data);
+ ->find_or_new($data);
}
+ MULTICREATE_DEBUG and warn "MC $self constructing $relname via find_or_new_related";
return $self->find_or_new_related($relname, $data);
}
@@ -284,9 +287,14 @@
$relname, { $rel_obj->get_columns }
);
- MULTICREATE_DEBUG and warn "MC $self pre-inserting $relname $rel_obj\n";
+ MULTICREATE_DEBUG and warn "MC $self pre-reconstructing $relname $rel_obj\n";
- $rel_obj->insert();
+ my $them = { %{$rel_obj->{_relationship_data} || {} }, $rel_obj->get_inflated_columns };
+ my $re = $self->result_source
+ ->related_source($relname)
+ ->resultset
+ ->find_or_create($them);
+ %{$rel_obj} = %{$re};
$self->set_from_related($relname, $rel_obj);
delete $related_stuff{$relname};
}
@@ -346,7 +354,10 @@
MULTICREATE_DEBUG and warn "MC $self skipping post-insert on $relname";
} else {
MULTICREATE_DEBUG and warn "MC $self re-creating $relname $obj";
- my $re = $self->find_or_create_related($relname, $them);
+ my $re = $self->result_source
+ ->related_source($relname)
+ ->resultset
+ ->find_or_create($them);
%{$obj} = %{$re};
MULTICREATE_DEBUG and warn "MC $self new $relname $obj";
}
@@ -706,7 +717,7 @@
return map {
my $accessor = $self->column_info($_)->{'accessor'} || $_;
($_ => $self->$accessor);
- } $self->columns;
+ } grep $self->has_column_loaded($_), $self->columns;
}
=head2 set_column
Modified: DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Schema.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Schema.pm 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/lib/DBIx/Class/Schema.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -208,12 +208,16 @@
local *Class::C3::reinitialize = sub { };
use warnings 'redefine';
- foreach my $result (keys %results) {
+ # ensure classes are loaded and fetch properly sorted classes
+ $class->ensure_class_loaded($_) foreach(values %results);
+ my @subclass_last = sort { $results{$a}->isa($results{$b}) } keys(%results);
+
+ foreach my $result (@subclass_last) {
my $result_class = $results{$result};
- $class->ensure_class_loaded($result_class);
my $rs_class = delete $resultsets{$result};
my $rs_set = $result_class->resultset_class;
+
if($rs_set && $rs_set ne 'DBIx::Class::ResultSet') {
if($rs_class && $rs_class ne $rs_set) {
warn "We found ResultSet class '$rs_class' for '$result', but it seems "
Modified: DBIx-Class/0.08/branches/subquery/lib/SQL/Translator/Parser/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/lib/SQL/Translator/Parser/DBIx/Class.pm 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/lib/SQL/Translator/Parser/DBIx/Class.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -66,7 +66,18 @@
}
- foreach my $moniker (sort @monikers)
+ my(@table_monikers, @view_monikers);
+ for my $moniker (@monikers){
+ my $source = $dbicschema->source($moniker);
+ if ( $source->isa('DBIx::Class::ResultSource::Table') ) {
+ push(@table_monikers, $moniker);
+ } elsif( $source->isa('DBIx::Class::ResultSource::View') ){
+ next if $source->is_virtual;
+ push(@view_monikers, $moniker);
+ }
+ }
+
+ foreach my $moniker (sort @table_monikers)
{
my $source = $dbicschema->source($moniker);
@@ -218,6 +229,25 @@
$source->_invoke_sqlt_deploy_hook($table);
}
+ foreach my $moniker (sort @view_monikers)
+ {
+ my $source = $dbicschema->source($moniker);
+ # Skip custom query sources
+ next if ref($source->name);
+
+ # Its possible to have multiple DBIC source using same table
+ next if $seen_tables{$source->name}++;
+
+ my $view = $schema->add_view(
+ name => $source->name,
+ fields => [ $source->columns ],
+ $source->view_definition ? ( 'sql' => $source->view_definition ) : ()
+ );
+ if ($source->result_class->can('sqlt_deploy_hook')) {
+ $source->result_class->sqlt_deploy_hook($view);
+ }
+ }
+
if ($dbicschema->can('sqlt_deploy_hook')) {
$dbicschema->sqlt_deploy_hook($schema);
}
Added: DBIx-Class/0.08/branches/subquery/t/104view.t
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/104view.t (rev 0)
+++ DBIx-Class/0.08/branches/subquery/t/104view.t 2009-02-22 01:25:19 UTC (rev 5616)
@@ -0,0 +1,28 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+plan tests => 2;
+
+## Real view
+my $cds_rs_2000 = $schema->resultset('CD')->search( { year => 2000 });
+my $year2kcds_rs = $schema->resultset('Year2000CDs');
+
+is($cds_rs_2000->count, $year2kcds_rs->count, 'View Year2000CDs sees all CDs in year 2000');
+
+
+## Virtual view
+my $cds_rs_1999 = $schema->resultset('CD')->search( { year => 1999 });
+my $year1999cds_rs = $schema->resultset('Year1999CDs');
+
+is($cds_rs_1999->count, $year1999cds_rs->count, 'View Year1999CDs sees all CDs in year 1999');
+
+
+
+
Added: DBIx-Class/0.08/branches/subquery/t/39load_namespaces_rt41083.t
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/39load_namespaces_rt41083.t (rev 0)
+++ DBIx-Class/0.08/branches/subquery/t/39load_namespaces_rt41083.t 2009-02-22 01:25:19 UTC (rev 5616)
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More;
+
+use lib 't/lib';
+
+plan tests => 4;
+
+sub _chk_warning {
+ defined $_[0]?
+ $_[0] !~ qr/We found ResultSet class '([^']+)' for '([^']+)', but it seems that you had already set '([^']+)' to use '([^']+)' instead/ :
+ 1
+}
+
+my $warnings;
+eval {
+ local $SIG{__WARN__} = sub { $warnings .= shift };
+ package DBICNSTest::RtBug41083;
+ use base 'DBIx::Class::Schema';
+ __PACKAGE__->load_namespaces(
+ result_namespace => 'Schema_A',
+ resultset_namespace => 'ResultSet_A',
+ default_resultset_class => 'ResultSet'
+ );
+};
+ok(!$@) or diag $@;
+ok(_chk_warning($warnings), 'expected no complaint');
+
+eval {
+ local $SIG{__WARN__} = sub { $warnings .= shift };
+ package DBICNSTest::RtBug41083;
+ use base 'DBIx::Class::Schema';
+ __PACKAGE__->load_namespaces(
+ result_namespace => 'Schema',
+ resultset_namespace => 'ResultSet',
+ default_resultset_class => 'ResultSet'
+ );
+};
+ok(!$@) or diag $@;
+ok(_chk_warning($warnings), 'expected no complaint') or diag $warnings;
Modified: DBIx-Class/0.08/branches/subquery/t/60core.t
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/60core.t 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/t/60core.t 2009-02-22 01:25:19 UTC (rev 5616)
@@ -2,12 +2,13 @@
use warnings;
use Test::More;
+use Test::Exception;
use lib qw(t/lib);
use DBICTest;
my $schema = DBICTest->init_schema();
-plan tests => 88;
+plan tests => 90;
eval { require DateTime::Format::MySQL };
my $NO_DTFM = $@ ? 1 : 0;
@@ -71,7 +72,7 @@
cmp_ok($art[0]->artistid, '==', 3,'Correct artist too');
-$art->delete;
+lives_ok (sub { $art->delete }, 'Cascading delete on Ordered has_many works' ); # real test in ordered.t
@art = $schema->resultset("Artist")->search({ });
@@ -79,10 +80,8 @@
ok(!$art->in_storage, "It knows it's dead");
-eval { $art->delete; };
+dies_ok ( sub { $art->delete }, "Can't delete twice");
-ok($@, "Can't delete twice: $@");
-
is($art->name, 'We Are In Rehab', 'But the object is still live');
$art->insert;
@@ -183,7 +182,6 @@
$new = $schema->resultset("Track")->new( {
trackid => 100,
cd => 1,
- position => 4,
title => 'Insert or Update',
last_updated_on => '1973-07-19 12:01:02'
} );
@@ -191,9 +189,9 @@
ok($new->in_storage, 'update_or_insert insert ok');
# test in update mode
-$new->pos(5);
+$new->title('Insert or Update - updated');
$new->update_or_insert;
-is( $schema->resultset("Track")->find(100)->pos, 5, 'update_or_insert update ok');
+is( $schema->resultset("Track")->find(100)->title, 'Insert or Update - updated', 'update_or_insert update ok');
# get_inflated_columns w/relation and accessor alias
SKIP: {
@@ -204,8 +202,12 @@
is($tdata{'trackid'}, 100, 'got id');
isa_ok($tdata{'cd'}, 'DBICTest::CD', 'cd is CD object');
is($tdata{'cd'}->id, 1, 'cd object is id 1');
- is($tdata{'position'}, 5, 'got position from pos');
- is($tdata{'title'}, 'Insert or Update');
+ is(
+ $tdata{'position'},
+ $schema->resultset ('Track')->search ({cd => 1})->count,
+ 'Ordered assigned proper position',
+ );
+ is($tdata{'title'}, 'Insert or Update - updated');
is($tdata{'last_updated_on'}, '1973-07-19T12:01:02');
isa_ok($tdata{'last_updated_on'}, 'DateTime', 'inflated accessored column');
}
@@ -295,16 +297,12 @@
my $newbook = $schema->resultset( 'Bookmark' )->find(1);
-$@ = '';
-eval {
-my $newlink = $newbook->link;
-};
-ok(!$@, "stringify to false value doesn't cause error");
+lives_ok (sub { my $newlink = $newbook->link}, "stringify to false value doesn't cause error");
# test cascade_delete through many_to_many relations
{
my $art_del = $schema->resultset("Artist")->find({ artistid => 1 });
- $art_del->delete;
+ lives_ok (sub { $art_del->delete }, 'Cascading delete on Ordered has_many works' ); # real test in ordered.t
cmp_ok( $schema->resultset("CD")->search({artist => 1}), '==', 0, 'Cascading through has_many top level.');
cmp_ok( $schema->resultset("CD_to_Producer")->search({cd => 1}), '==', 0, 'Cascading through has_many children.');
}
@@ -375,7 +373,6 @@
# test resultsource->table return value when setting
{
my $class = $schema->class('Event');
- diag $class;
my $table = $class->table($class->table);
is($table, $class->table, '->table($table) returns $table');
}
Modified: DBIx-Class/0.08/branches/subquery/t/66relationship.t
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/66relationship.t 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/t/66relationship.t 2009-02-22 01:25:19 UTC (rev 5616)
@@ -92,12 +92,11 @@
$track = $schema->resultset("Track")->create( {
trackid => 2,
cd => 3,
- position => 99,
title => 'Hidden Track 2'
} );
$track->update_from_related( cd => $cd );
-my $t_cd = ($schema->resultset("Track")->search( cd => 4, position => 99 ))[0]->cd;
+my $t_cd = ($schema->resultset("Track")->search( cd => 4, title => 'Hidden Track 2' ))[0]->cd;
is( $t_cd->cdid, 4, 'update_from_related ok' );
Modified: DBIx-Class/0.08/branches/subquery/t/87ordered.t
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/87ordered.t 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/t/87ordered.t 2009-02-22 01:25:19 UTC (rev 5616)
@@ -10,7 +10,7 @@
my $schema = DBICTest->init_schema();
-plan tests => 879;
+plan tests => 1269;
my $employees = $schema->resultset('Employee');
$employees->delete();
@@ -43,6 +43,7 @@
my $to_group = 1;
my $to_pos = undef;
while (my $employee = $group_3->next) {
+ $employee->discard_changes; # since we are effective shift()ing the $rs
$employee->move_to_group($to_group, $to_pos);
$to_pos++;
$to_group = $to_group==1 ? 2 : 1;
@@ -97,20 +98,20 @@
);
# multicol tests begin here
-DBICTest::Employee->grouping_column(['group_id', 'group_id_2']);
+DBICTest::Employee->grouping_column(['group_id_2', 'group_id_3']);
$employees->delete();
-foreach my $group_id (1..4) {
- foreach my $group_id_2 (1..4) {
+foreach my $group_id_2 (1..4) {
+ foreach my $group_id_3 (1..4) {
foreach (1..4) {
- $employees->create({ name=>'temp', group_id=>$group_id, group_id_2=>$group_id_2 });
+ $employees->create({ name=>'temp', group_id_2=>$group_id_2, group_id_3=>$group_id_3 });
}
}
}
-$employees = $employees->search(undef,{order_by=>'group_id,group_id_2,position'});
+$employees = $employees->search(undef,{order_by=>[qw/group_id_2 group_id_3 position/]});
-foreach my $group_id (1..3) {
- foreach my $group_id_2 (1..3) {
- my $group_employees = $employees->search({group_id=>$group_id, group_id_2=>$group_id_2});
+foreach my $group_id_2 (1..3) {
+ foreach my $group_id_3 (1..3) {
+ my $group_employees = $employees->search({group_id_2=>$group_id_2, group_id_3=>$group_id_3});
$group_employees->all();
ok( check_rs($group_employees), "group intial positions" );
hammer_rs( $group_employees );
@@ -118,72 +119,72 @@
}
# move_to_group, specifying group by hash
-my $group_4 = $employees->search({group_id=>4});
+my $group_4 = $employees->search({group_id_2=>4});
$to_group = 1;
my $to_group_2_base = 7;
my $to_group_2 = 1;
$to_pos = undef;
while (my $employee = $group_4->next) {
- $employee->move_to_group({group_id=>$to_group, group_id_2=>$to_group_2}, $to_pos);
+ $employee->move_to_group({group_id_2=>$to_group, group_id_3=>$to_group_2}, $to_pos);
$to_pos++;
$to_group = ($to_group % 3) + 1;
$to_group_2_base++;
$to_group_2 = (ceil($to_group_2_base/3.0) %3) +1
}
-foreach my $group_id (1..4) {
- foreach my $group_id_2 (1..4) {
- my $group_employees = $employees->search({group_id=>$group_id,group_id_2=>$group_id_2});
+foreach my $group_id_2 (1..4) {
+ foreach my $group_id_3 (1..4) {
+ my $group_employees = $employees->search({group_id_2=>$group_id_2,group_id_3=>$group_id_3});
$group_employees->all();
ok( check_rs($group_employees), "group positions after move_to_group" );
}
}
$employees->delete();
-foreach my $group_id (1..4) {
- foreach my $group_id_2 (1..4) {
+foreach my $group_id_2 (1..4) {
+ foreach my $group_id_3 (1..4) {
foreach (1..4) {
- $employees->create({ name=>'temp', group_id=>$group_id, group_id_2=>$group_id_2 });
+ $employees->create({ name=>'temp', group_id_2=>$group_id_2, group_id_3=>$group_id_3 });
}
}
}
-$employees = $employees->search(undef,{order_by=>'group_id,group_id_2,position'});
+$employees = $employees->search(undef,{order_by=>[qw/group_id_2 group_id_3 position/]});
-$employee = $employees->search({group_id=>4, group_id_2=>1})->first;
-$employee->group_id(1);
+$employee = $employees->search({group_id_2=>4, group_id_3=>1})->first;
+$employee->group_id_2(1);
$employee->update;
ok(
- check_rs($employees->search_rs({group_id=>4, group_id_2=>1}))
- && check_rs($employees->search_rs({group_id=>1, group_id_2=>1})),
+ check_rs($employees->search_rs({group_id_2=>4, group_id_3=>1}))
+ && check_rs($employees->search_rs({group_id_2=>1, group_id_3=>1})),
"overloaded multicol update 1"
);
-$employee = $employees->search({group_id=>4, group_id_2=>1})->first;
-$employee->update({group_id=>2});
-ok( check_rs($employees->search_rs({group_id=>4, group_id_2=>1}))
- && check_rs($employees->search_rs({group_id=>2, group_id_2=>1})),
- "overloaded multicol update 2"
+$employee = $employees->search({group_id_2=>4, group_id_3=>1})->first;
+$employee->update({group_id_2=>2});
+ok( check_rs($employees->search_rs({group_id_2=>4, group_id_3=>1}))
+ && check_rs($employees->search_rs({group_id_2=>2, group_id_3=>1})),
+ "overloaded multicol update 2"
);
-$employee = $employees->search({group_id=>3, group_id_2=>1})->first;
-$employee->group_id(1);
-$employee->group_id_2(3);
+$employee = $employees->search({group_id_2=>3, group_id_3=>1})->first;
+$employee->group_id_2(1);
+$employee->group_id_3(3);
$employee->update();
-ok( check_rs($employees->search_rs({group_id=>3, group_id_2=>1}))
- && check_rs($employees->search_rs({group_id=>1, group_id_2=>3})),
+ok( check_rs($employees->search_rs({group_id_2=>3, group_id_3=>1}))
+ && check_rs($employees->search_rs({group_id_2=>1, group_id_3=>3})),
"overloaded multicol update 3"
);
-$employee = $employees->search({group_id=>3, group_id_2=>1})->first;
-$employee->update({group_id=>2, group_id_2=>3});
-ok( check_rs($employees->search_rs({group_id=>3, group_id_2=>1}))
- && check_rs($employees->search_rs({group_id=>2, group_id_2=>3})),
+$employee = $employees->search({group_id_2=>3, group_id_3=>1})->first;
+$employee->update({group_id_2=>2, group_id_3=>3});
+ok( check_rs($employees->search_rs({group_id_2=>3, group_id_3=>1}))
+ && check_rs($employees->search_rs({group_id_2=>2, group_id_3=>3})),
"overloaded multicol update 4"
);
-$employee = $employees->search({group_id=>3, group_id_2=>2})->first;
-$employee->update({group_id=>2, group_id_2=>4, position=>2});
-ok( check_rs($employees->search_rs({group_id=>3, group_id_2=>2}))
- && check_rs($employees->search_rs({group_id=>2, group_id_2=>4})),
+$employee = $employees->search({group_id_2=>3, group_id_3=>2})->first;
+$employee->update({group_id_2=>2, group_id_3=>4, position=>2});
+ok( check_rs($employees->search_rs({group_id_2=>3, group_id_3=>2}))
+ && check_rs($employees->search_rs({group_id_2=>2, group_id_3=>4})),
"overloaded multicol update 5"
);
@@ -218,22 +219,34 @@
ok( check_rs($rs), "move_to( $position => $to_position )" );
}
- ($row) = $rs->search({ position=>$position })->all();
+ $row = $rs->find({ position => $position });
if ($position==1) {
ok( !$row->previous_sibling(), 'no previous sibling' );
ok( !$row->first_sibling(), 'no first sibling' );
+ ok( $row->next_sibling->position > $position, 'next sibling position > than us');
+ is( $row->next_sibling->previous_sibling->position, $position, 'next-prev sibling is us');
+ ok( $row->last_sibling->position > $position, 'last sibling position > than us');
}
else {
ok( $row->previous_sibling(), 'previous sibling' );
ok( $row->first_sibling(), 'first sibling' );
+ ok( $row->previous_sibling->position < $position, 'prev sibling position < than us');
+ is( $row->previous_sibling->next_sibling->position, $position, 'prev-next sibling is us');
+ ok( $row->first_sibling->position < $position, 'first sibling position < than us');
}
if ($position==$count) {
ok( !$row->next_sibling(), 'no next sibling' );
ok( !$row->last_sibling(), 'no last sibling' );
+ ok( $row->previous_sibling->position < $position, 'prev sibling position < than us');
+ is( $row->previous_sibling->next_sibling->position, $position, 'prev-next sibling is us');
+ ok( $row->first_sibling->position < $position, 'first sibling position < than us');
}
else {
ok( $row->next_sibling(), 'next sibling' );
ok( $row->last_sibling(), 'last sibling' );
+ ok( $row->next_sibling->position > $row->position, 'next sibling position > than us');
+ is( $row->next_sibling->previous_sibling->position, $position, 'next-prev sibling is us');
+ ok( $row->last_sibling->position > $row->position, 'last sibling position > than us');
}
}
Modified: DBIx-Class/0.08/branches/subquery/t/96multi_create/cd_single.t
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/96multi_create/cd_single.t 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/t/96multi_create/cd_single.t 2009-02-22 01:25:19 UTC (rev 5616)
@@ -12,7 +12,6 @@
my $cd = $schema->resultset('CD')->first;
my $track = $schema->resultset('Track')->new_result({
cd => $cd,
- position => 77, # some day me might test this with Ordered
title => 'Multicreate rocks',
cd_single => {
artist => $cd->artist,
Added: DBIx-Class/0.08/branches/subquery/t/96multi_create/multilev_might_have_PKeqFK.t
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/96multi_create/multilev_might_have_PKeqFK.t (rev 0)
+++ DBIx-Class/0.08/branches/subquery/t/96multi_create/multilev_might_have_PKeqFK.t 2009-02-22 01:25:19 UTC (rev 5616)
@@ -0,0 +1,65 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+sub mc_diag { diag (@_) if $ENV{DBIC_MULTICREATE_DEBUG} };
+
+plan tests => 8;
+
+my $schema = DBICTest->init_schema();
+
+mc_diag (<<'DG');
+* Test a multilevel might-have with a PK == FK in the might_have/has_many table
+
+CD -> might have -> Artwork
+ \
+ \-> has_many \
+ --> Artwork_to_Artist
+ /-> has_many /
+ /
+ Artist
+DG
+
+lives_ok (sub {
+ my $someartist = $schema->resultset('Artist')->first;
+ my $cd = $schema->resultset('CD')->create ({
+ artist => $someartist,
+ title => 'Music to code by until the cows come home',
+ year => 2008,
+ artwork => {
+ artwork_to_artist => [
+ { artist => { name => 'cowboy joe' } },
+ { artist => { name => 'billy the kid' } },
+ ],
+ },
+ });
+
+ isa_ok ($cd, 'DBICTest::CD', 'Main CD object created');
+ is ($cd->title, 'Music to code by until the cows come home', 'Correct CD title');
+
+ my $art_obj = $cd->artwork;
+ ok ($art_obj->has_column_loaded ('cd_id'), 'PK/FK present on artwork object');
+ is ($art_obj->artists->count, 2, 'Correct artwork creator count via the new object');
+ is_deeply (
+ [ sort $art_obj->artists->get_column ('name')->all ],
+ [ 'billy the kid', 'cowboy joe' ],
+ 'Artists named correctly when queried via object',
+ );
+
+ my $artwork = $schema->resultset('Artwork')->search (
+ { 'cd.title' => 'Music to code by until the cows come home' },
+ { join => 'cd' },
+ )->single;
+ is ($artwork->artists->count, 2, 'Correct artwork creator count via a new search');
+ is_deeply (
+ [ sort $artwork->artists->get_column ('name')->all ],
+ [ 'billy the kid', 'cowboy joe' ],
+ 'Artists named correctly queried via a new search',
+ );
+}, 'multilevel might-have with a PK == FK in the might_have/has_many table ok');
+
+1;
Modified: DBIx-Class/0.08/branches/subquery/t/96multi_create.t
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/96multi_create.t 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/t/96multi_create.t 2009-02-22 01:25:19 UTC (rev 5616)
@@ -6,12 +6,11 @@
use lib qw(t/lib);
use DBICTest;
-plan tests => 77;
+plan tests => 93;
my $schema = DBICTest->init_schema();
-diag '* simple create + parent (the stuff $rs belongs_to)';
-eval {
+lives_ok ( sub {
my $cd = $schema->resultset('CD')->create({
artist => {
name => 'Fred Bloggs'
@@ -23,11 +22,9 @@
isa_ok($cd, 'DBICTest::CD', 'Created CD object');
isa_ok($cd->artist, 'DBICTest::Artist', 'Created related Artist');
is($cd->artist->name, 'Fred Bloggs', 'Artist created correctly');
-};
-diag $@ if $@;
+}, 'simple create + parent (the stuff $rs belongs_to) ok');
-diag '* same as above but the child and parent have no values, except for an explicit parent pk';
-eval {
+lives_ok ( sub {
my $bm_rs = $schema->resultset('Bookmark');
my $bookmark = $bm_rs->create({
link => {
@@ -45,11 +42,9 @@
1,
'Bookmark and link made it to the DB',
);
-};
-diag $@ if $@;
+}, 'simple create where the child and parent have no values, except for an explicit parent pk ok');
-diag '* create over > 1 levels of has_many create (A => { has_many => { B => has_many => C } } )';
-eval {
+lives_ok ( sub {
my $artist = $schema->resultset('Artist')->first;
my $cd = $artist->create_related (cds => {
title => 'Music to code by',
@@ -64,8 +59,7 @@
is($cd->tags->count, 1, 'One tag created for CD');
is($cd->tags->first->tag, 'rock', 'Tag created correctly');
-};
-diag $@ if $@;
+}, 'create over > 1 levels of has_many create (A => { has_many => { B => has_many => C } } )');
throws_ok (
sub {
@@ -82,8 +76,7 @@
'create via update of multi relationships throws an exception'
);
-diag '* Create m2m while originating in the linker table';
-eval {
+lives_ok ( sub {
my $artist = $schema->resultset('Artist')->first;
my $c2p = $schema->resultset('CD_to_Producer')->create ({
cd => {
@@ -91,9 +84,9 @@
title => 'Bad investment',
year => 2008,
tracks => [
- { position => 1, title => 'Just buy' },
- { position => 2, title => 'Why did we do it' },
- { position => 3, title => 'Burn baby burn' },
+ { title => 'Just buy' },
+ { title => 'Why did we do it' },
+ { title => 'Burn baby burn' },
],
},
producer => {
@@ -108,24 +101,17 @@
my $cd = $prod->cds->first;
is ($cd->title, 'Bad investment', 'CD created correctly');
is ($cd->tracks->count, 3, 'CD has 3 tracks');
+}, 'Create m2m while originating in the linker table');
-};
-diag $@ if $@;
-diag (<<'DG');
-* Create over > 1 levels of might_have with multiple has_many and multiple m2m
-but starting at a has_many level
-
-CD -> has_many -> Tracks -> might have -> Single -> has_many -> Tracks
- \
- \-> has_many \
- --> CD2Producer
- /-> has_many /
- /
- Producer
-DG
-
-eval {
+#CD -> has_many -> Tracks -> might have -> Single -> has_many -> Tracks
+# \
+# \-> has_many \
+# --> CD2Producer
+# /-> has_many /
+# /
+# Producer
+lives_ok ( sub {
my $artist = $schema->resultset('Artist')->first;
my $cd = $schema->resultset('CD')->create ({
artist => $artist,
@@ -133,19 +119,17 @@
year => 2008,
tracks => [
{
- position => 1, # some day me might test this with Ordered
title => 'Off by one again',
},
{
- position => 2,
title => 'The dereferencer',
cd_single => {
artist => $artist,
year => 2008,
title => 'Was that a null (Single)',
tracks => [
- { title => 'The dereferencer', position => 1 },
- { title => 'The dereferencer II', position => 2 },
+ { title => 'The dereferencer' },
+ { title => 'The dereferencer II' },
],
cd_to_producer => [
{
@@ -185,35 +169,28 @@
['Don Knuth', 'K&R'],
'Producers named correctly',
);
-};
-diag $@ if $@;
+}, 'Create over > 1 levels of might_have with multiple has_many and multiple m2m but starting at a has_many level');
-diag (<<'DG');
-* Same as above but starting at the might_have directly
-
-Track -> might have -> Single -> has_many -> Tracks
- \
- \-> has_many \
- --> CD2Producer
- /-> has_many /
- /
- Producer
-DG
-
-eval {
+#Track -> might have -> Single -> has_many -> Tracks
+# \
+# \-> has_many \
+# --> CD2Producer
+# /-> has_many /
+# /
+# Producer
+lives_ok ( sub {
my $cd = $schema->resultset('CD')->first;
my $track = $schema->resultset('Track')->create ({
cd => $cd,
- position => 77, # some day me might test this with Ordered
title => 'Multicreate rocks',
cd_single => {
artist => $cd->artist,
year => 2008,
title => 'Disemboweling MultiCreate',
tracks => [
- { title => 'Why does mst write this way', position => 1 },
- { title => 'Chainsaw celebration', position => 2 },
- { title => 'Purl cleans up', position => 3 },
+ { title => 'Why does mst write this way' },
+ { title => 'Chainsaw celebration' },
+ { title => 'Purl cleans up' },
],
cd_to_producer => [
{
@@ -251,11 +228,9 @@
['castaway', 'mst', 'theorbtwo'],
'Producers named correctly',
);
-};
-diag $@ if $@;
+}, 'Create over > 1 levels of might_have with multiple has_many and multiple m2m but starting at the might_have directly');
-diag '* Test might_have again but with a PK == FK in the middle (obviously not specified)';
-eval {
+lives_ok ( sub {
my $artist = $schema->resultset('Artist')->first;
my $cd = $schema->resultset('CD')->create ({
artist => $artist,
@@ -295,15 +270,12 @@
[ 'recursive descent', 'tail packing' ],
'Images named correctly after search',
);
-};
-diag $@ if $@;
+}, 'Test might_have again but with a PK == FK in the middle (obviously not specified)');
-diag '* Test might_have again but with just a PK and FK (neither specified) in the mid-table';
-eval {
+lives_ok ( sub {
my $cd = $schema->resultset('CD')->first;
my $track = $schema->resultset ('Track')->create ({
cd => $cd,
- position => 66,
title => 'Black',
lyrics => {
lyric_versions => [
@@ -341,62 +313,9 @@
[ 'The color black', 'The colour black' ],
'Lyrics text via search matches',
);
-};
-diag $@ if $@;
+}, 'Test might_have again but with just a PK and FK (neither specified) in the mid-table');
-diag (<<'DG');
-* Test a multilevel might-have with a PK == FK in the might_have/has_many table
-
-CD -> might have -> Artwork
- \
- \-> has_many \
- --> Artwork_to_Artist
- /-> has_many /
- /
- Artist
-DG
-
-eval {
- my $someartist = $schema->resultset('Artist')->first;
- my $cd = $schema->resultset('CD')->create ({
- artist => $someartist,
- title => 'Music to code by until the cows come home',
- year => 2008,
- artwork => {
- artwork_to_artist => [
- { artist => { name => 'cowboy joe' } },
- { artist => { name => 'billy the kid' } },
- ],
- },
- });
-
- isa_ok ($cd, 'DBICTest::CD', 'Main CD object created');
- is ($cd->title, 'Music to code by until the cows come home', 'Correct CD title');
-
- my $art_obj = $cd->artwork;
- ok ($art_obj->has_column_loaded ('cd_id'), 'PK/FK present on artwork object');
- is ($art_obj->artists->count, 2, 'Correct artwork creator count via the new object');
- is_deeply (
- [ sort $art_obj->artists->get_column ('name')->all ],
- [ 'billy the kid', 'cowboy joe' ],
- 'Artists named correctly when queried via object',
- );
-
- my $artwork = $schema->resultset('Artwork')->search (
- { 'cd.title' => 'Music to code by until the cows come home' },
- { join => 'cd' },
- )->single;
- is ($artwork->artists->count, 2, 'Correct artwork creator count via a new search');
- is_deeply (
- [ sort $artwork->artists->get_column ('name')->all ],
- [ 'billy the kid', 'cowboy joe' ],
- 'Artists named correctly queried via a new search',
- );
-};
-diag $@ if $@;
-
-diag '* Nested find_or_create';
-eval {
+lives_ok ( sub {
my $newartist2 = $schema->resultset('Artist')->find_or_create({
name => 'Fred 3',
cds => [
@@ -407,11 +326,9 @@
],
});
is($newartist2->name, 'Fred 3', 'Created new artist with cds via find_or_create');
-};
-diag $@ if $@;
+}, 'Nested find_or_create');
-diag '* Multiple same level has_many create';
-eval {
+lives_ok ( sub {
my $artist2 = $schema->resultset('Artist')->create({
name => 'Fred 4',
cds => [
@@ -429,11 +346,9 @@
});
is($artist2->in_storage, 1, 'artist with duplicate rels inserted okay');
-};
-diag $@ if $@;
+}, 'Multiple same level has_many create');
-diag '* First create_related pass';
-eval {
+lives_ok ( sub {
my $artist = $schema->resultset('Artist')->first;
my $cd_result = $artist->create_related('cds', {
@@ -441,13 +356,8 @@
title => 'TestOneCD1',
year => 2007,
tracks => [
-
- { position=>111,
- title => 'TrackOne',
- },
- { position=>112,
- title => 'TrackTwo',
- }
+ { title => 'TrackOne' },
+ { title => 'TrackTwo' },
],
});
@@ -463,11 +373,9 @@
{
ok( $track && ref $track eq 'DBICTest::Track', 'Got Expected Track Class');
}
-};
-diag $@ if $@;
+}, 'First create_related pass');
-diag '* second create_related with same arguments';
-eval {
+lives_ok ( sub {
my $artist = $schema->resultset('Artist')->first;
my $cd_result = $artist->create_related('cds', {
@@ -475,13 +383,8 @@
title => 'TestOneCD2',
year => 2007,
tracks => [
-
- { position=>111,
- title => 'TrackOne',
- },
- { position=>112,
- title => 'TrackTwo',
- }
+ { title => 'TrackOne' },
+ { title => 'TrackTwo' },
],
liner_notes => { notes => 'I can haz liner notes?' },
@@ -500,20 +403,17 @@
{
ok( $track && ref $track eq 'DBICTest::Track', 'Got Expected Track Class');
}
-};
-diag $@ if $@;
+}, 'second create_related with same arguments');
-diag '* create of parents of a record linker table';
-eval {
+lives_ok ( sub {
my $cdp = $schema->resultset('CD_to_Producer')->create({
cd => { artist => 1, title => 'foo', year => 2000 },
producer => { name => 'jorge' }
});
ok($cdp, 'join table record created ok');
-};
-diag $@ if $@;
+}, 'create of parents of a record linker table');
-eval {
+lives_ok ( sub {
my $kurt_cobain = { name => 'Kurt Cobain' };
my $in_utero = $schema->resultset('CD')->new({
@@ -530,32 +430,11 @@
is($a->name, 'Kurt Cobain', 'Artist insertion ok');
is($a->cds && $a->cds->first && $a->cds->first->title,
'In Utero', 'CD insertion ok');
-};
-diag $@ if $@;
+}, 'populate');
-=pod
-# This test case has been moved to t/96multi_create/cd_single.t
-eval {
- my $pink_floyd = { name => 'Pink Floyd' };
-
- my $the_wall = { title => 'The Wall', year => 1979 };
-
- $pink_floyd->{cds} = [ $the_wall ];
-
-
- $schema->resultset('Artist')->populate([ $pink_floyd ]); # %)
- $a = $schema->resultset('Artist')->find({name => 'Pink Floyd'});
-
- is($a->name, 'Pink Floyd', 'Artist insertion ok');
- is($a->cds && $a->cds->first->title, 'The Wall', 'CD insertion ok');
-};
-diag $@ if $@;
-=cut
-
-diag '* Create foreign key col obj including PK (See test 20 in 66relationships.t)';
## Create foreign key col obj including PK
## See test 20 in 66relationships.t
-eval {
+lives_ok ( sub {
my $new_cd_hashref = {
cdid => 27,
title => 'Boogie Woogie',
@@ -569,30 +448,25 @@
my $new_cd = $schema->resultset("CD")->create($new_cd_hashref);
is($new_cd->artist->id, 17, 'new id retained okay');
-};
-diag $@ if $@;
+}, 'Create foreign key col obj including PK');
-eval {
+lives_ok ( sub {
$schema->resultset("CD")->create({
cdid => 28,
title => 'Boogie Wiggle',
year => '2007',
artist => { artistid => 18, name => 'larry' }
});
-};
-is($@, '', 'new cd created without clash on related artist');
+}, 'new cd created without clash on related artist');
-diag '* Make sure exceptions from errors in created rels propogate';
-eval {
+throws_ok ( sub {
my $t = $schema->resultset("Track")->new({ cd => { artist => undef } });
#$t->cd($t->new_related('cd', { artist => undef } ) );
#$t->{_rel_in_storage} = 0;
$t->insert;
-};
-like($@, qr/cd.artist may not be NULL/, "Exception propogated properly");
+}, qr/cd.artist may not be NULL/, "Exception propogated properly");
-diag '* Test multi create over many_to_many';
-eval {
+lives_ok ( sub {
$schema->resultset('CD')->create ({
artist => {
name => 'larry', # should already exist
@@ -608,6 +482,6 @@
is ($m2m_cd->count, 1, 'One CD row created via M2M create');
is ($m2m_cd->first->producers->count, 1, 'CD row created with one producer');
is ($m2m_cd->first->producers->first->name, 'Cowboy Neal', 'Correct producer row created');
-};
+}, 'Test multi create over many_to_many');
1;
Modified: DBIx-Class/0.08/branches/subquery/t/96multi_create_new.t
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/96multi_create_new.t 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/t/96multi_create_new.t 2009-02-22 01:25:19 UTC (rev 5616)
@@ -6,7 +6,7 @@
use lib qw(t/lib);
use DBICTest;
-plan tests => 9;
+plan tests => 12;
my $schema = DBICTest->init_schema();
@@ -36,10 +36,21 @@
{
my $new_artist = $schema->resultset("Artist")->new_result({ 'name' => 'Depeche Mode' });
- my $new_related_cd = $new_artist->new_related('cds', { 'title' => 'Leave in Silence', 'year' => 1982});
+ my $new_related_cd = $new_artist->new_related('cds', { 'title' => 'Leave Slightly Noisily', 'year' => 1982});
eval {
$new_related_cd->insert;
};
+ is ($@, '', 'CD insertion survives by finding artist');
+ ok($new_artist->in_storage, 'artist inserted');
+ ok($new_related_cd->in_storage, 'new_related_cd inserted');
+}
+
+{
+ my $new_artist = $schema->resultset("Artist")->new_result({ 'name' => 'Depeche Mode 2: Insertion Boogaloo' });
+ my $new_related_cd = $new_artist->new_related('cds', { 'title' => 'Leave Loudly While Singing Off Key', 'year' => 1982});
+ eval {
+ $new_related_cd->insert;
+ };
is ($@, '', 'CD insertion survives by inserting artist');
ok($new_artist->in_storage, 'artist inserted');
ok($new_related_cd->in_storage, 'new_related_cd inserted');
Modified: DBIx-Class/0.08/branches/subquery/t/96multi_create_torture.t
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/96multi_create_torture.t 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/t/96multi_create_torture.t 2009-02-22 01:25:19 UTC (rev 5616)
@@ -6,7 +6,7 @@
use lib qw(t/lib);
use DBICTest;
-plan tests => 19;
+plan tests => 23;
# an insane multicreate
# (should work, despite the fact that no one will probably use it this way)
@@ -54,13 +54,7 @@
],
# This cd is created via artist so it doesn't know about producers
cd_to_producer => [
- # if we specify 'bob' here things bomb
- # as the producer attached to Greatest Hits 1 is
- # already created, but not yet inserted.
- # Maybe this can be fixed, but things are hairy
- # enough already.
- #
- #{ producer => { name => 'bob' } },
+ { producer => { name => 'bob' } },
{ producer => { name => 'paul' } },
{ producer => {
name => 'flemming',
@@ -161,7 +155,7 @@
);
is ($paul_prod->count, 1, 'Paul had 1 production');
my $pauls_cd = $paul_prod->single;
- is ($pauls_cd->cd_to_producer->count, 2, 'Paul had one co-producer');
+ is ($pauls_cd->cd_to_producer->count, 3, 'Paul had two co-producers');
is (
$pauls_cd->search_related ('cd_to_producer',
{ 'producer.name' => 'flemming'},
@@ -205,15 +199,19 @@
{ 'producer.name' => 'bob'},
{ join => 'producer' }
)->count,
- 2,
- 'Lars produced 2 CDs with bob',
+ 3,
+ 'Lars produced 3 CDs with bob',
);
my $bob_prod = $cd_rs->search (
{ 'producer.name' => 'bob'},
{ join => { cd_to_producer => 'producer' } }
);
- is ($bob_prod->count, 3, 'Bob produced a total of 3 CDs');
+ is ($bob_prod->count, 4, 'Bob produced a total of 4 CDs');
+ ok ($bob_prod->find ({ title => 'Greatest hits 1'}), '1st Bob production name correct');
+ ok ($bob_prod->find ({ title => 'Greatest hits 6'}), '2nd Bob production name correct');
+ ok ($bob_prod->find ({ title => 'Greatest hits 2'}), '3rd Bob production name correct');
+ ok ($bob_prod->find ({ title => 'Greatest hits 7'}), '4th Bob production name correct');
is (
$bob_prod->search ({ 'artist.name' => 'james' }, { join => 'artist' })->count,
Modified: DBIx-Class/0.08/branches/subquery/t/99dbic_sqlt_parser.t
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/99dbic_sqlt_parser.t 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/t/99dbic_sqlt_parser.t 2009-02-22 01:25:19 UTC (rev 5616)
@@ -14,7 +14,11 @@
}
my $schema = DBICTest->init_schema();
-my @sources = grep { $_ ne 'Dummy' } ($schema->sources); # Dummy was yanked out by the sqlt hook test
+# Dummy was yanked out by the sqlt hook test
+# YearXXXXCDs are views
+my @sources = grep { $_ ne 'Dummy' && $_ !~ /^Year\d{4}CDs$/ }
+ $schema->sources;
+
plan tests => ( @sources * 3);
{
Added: DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/ResultSet/Foo.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/ResultSet/Foo.pm (rev 0)
+++ DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/ResultSet/Foo.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -0,0 +1,8 @@
+package DBICNSTest::RtBug41083::ResultSet::Foo;
+use strict;
+use warnings;
+use base 'DBICNSTest::RtBug41083::ResultSet';
+
+sub fooBar { 1; }
+
+1;
Added: DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/ResultSet.pm (rev 0)
+++ DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/ResultSet.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -0,0 +1,5 @@
+package DBICNSTest::RtBug41083::ResultSet;
+use strict;
+use warnings;
+use base 'DBIx::Class::ResultSet';
+1;
Added: DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/ResultSet_A/A.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/ResultSet_A/A.pm (rev 0)
+++ DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/ResultSet_A/A.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -0,0 +1,7 @@
+package DBICNSTest::RtBug41083::ResultSet_A::A;
+use strict;
+use warnings;
+use base 'DBICNSTest::RtBug41083::ResultSet';
+
+sub fooBar { 1; }
+1;
Added: DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema/Foo/Sub.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema/Foo/Sub.pm (rev 0)
+++ DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema/Foo/Sub.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -0,0 +1,5 @@
+package DBICNSTest::RtBug41083::Schema::Foo::Sub;
+use strict;
+use warnings;
+use base 'DBICNSTest::RtBug41083::Schema::Foo';
+1;
Added: DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema/Foo.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema/Foo.pm (rev 0)
+++ DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema/Foo.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -0,0 +1,8 @@
+package DBICNSTest::RtBug41083::Schema::Foo;
+use strict;
+use warnings;
+use base 'DBIx::Class';
+__PACKAGE__->load_components('Core');
+__PACKAGE__->table('foo');
+__PACKAGE__->add_columns('foo');
+1;
Added: DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema_A/A/Sub.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema_A/A/Sub.pm (rev 0)
+++ DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema_A/A/Sub.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -0,0 +1,5 @@
+package DBICNSTest::RtBug41083::Schema_A::A::Sub;
+use strict;
+use warnings;
+use base 'DBICNSTest::RtBug41083::Schema_A::A';
+1;
Added: DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema_A/A.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema_A/A.pm (rev 0)
+++ DBIx-Class/0.08/branches/subquery/t/lib/DBICNSTest/RtBug41083/Schema_A/A.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -0,0 +1,8 @@
+package DBICNSTest::RtBug41083::Schema_A::A;
+use strict;
+use warnings;
+use base 'DBIx::Class';
+__PACKAGE__->load_components('Core');
+__PACKAGE__->table('a');
+__PACKAGE__->add_columns('a');
+1;
Modified: DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Employee.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Employee.pm 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Employee.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -23,6 +23,10 @@
data_type => 'integer',
is_nullable => 1,
},
+ group_id_3 => {
+ data_type => 'integer',
+ is_nullable => 1,
+ },
name => {
data_type => 'varchar',
size => 100,
Modified: DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Track.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Track.pm 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Track.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -2,7 +2,7 @@
DBICTest::Schema::Track;
use base 'DBIx::Class::Core';
-__PACKAGE__->load_components(qw/InflateColumn::DateTime/);
+__PACKAGE__->load_components(qw/InflateColumn::DateTime Ordered/);
__PACKAGE__->table('track');
__PACKAGE__->add_columns(
@@ -32,6 +32,10 @@
__PACKAGE__->add_unique_constraint([ qw/cd position/ ]);
__PACKAGE__->add_unique_constraint([ qw/cd title/ ]);
+__PACKAGE__->position_column ('position');
+__PACKAGE__->grouping_column ('cd');
+
+
__PACKAGE__->belongs_to( cd => 'DBICTest::Schema::CD' );
__PACKAGE__->belongs_to( disc => 'DBICTest::Schema::CD' => 'cd');
Added: DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Year1999CDs.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Year1999CDs.pm (rev 0)
+++ DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Year1999CDs.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -0,0 +1,32 @@
+package # hide from PAUSE
+ DBICTest::Schema::Year1999CDs;
+## Used in 104view.t
+
+use base 'DBIx::Class::Core';
+use DBIx::Class::ResultSource::View;
+
+__PACKAGE__->table_class('DBIx::Class::ResultSource::View');
+
+__PACKAGE__->table('year1999cds');
+__PACKAGE__->result_source_instance->is_virtual(1);
+__PACKAGE__->result_source_instance->view_definition(
+ "SELECT cdid, artist, title FROM cd WHERE year ='1999'"
+);
+__PACKAGE__->add_columns(
+ 'cdid' => {
+ data_type => 'integer',
+ is_auto_increment => 1,
+ },
+ 'artist' => {
+ data_type => 'integer',
+ },
+ 'title' => {
+ data_type => 'varchar',
+ size => 100,
+ },
+
+);
+__PACKAGE__->set_primary_key('cdid');
+__PACKAGE__->add_unique_constraint([ qw/artist title/ ]);
+
+1;
Added: DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Year2000CDs.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Year2000CDs.pm (rev 0)
+++ DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema/Year2000CDs.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -0,0 +1,31 @@
+package # hide from PAUSE
+ DBICTest::Schema::Year2000CDs;
+## Used in 104view.t
+
+use base 'DBIx::Class::Core';
+use DBIx::Class::ResultSource::View;
+
+__PACKAGE__->table_class('DBIx::Class::ResultSource::View');
+
+__PACKAGE__->table('year2000cds');
+__PACKAGE__->result_source_instance->view_definition(
+ "SELECT cdid, artist, title FROM cd WHERE year ='2000'"
+);
+__PACKAGE__->add_columns(
+ 'cdid' => {
+ data_type => 'integer',
+ is_auto_increment => 1,
+ },
+ 'artist' => {
+ data_type => 'integer',
+ },
+ 'title' => {
+ data_type => 'varchar',
+ size => 100,
+ },
+
+);
+__PACKAGE__->set_primary_key('cdid');
+__PACKAGE__->add_unique_constraint([ qw/artist title/ ]);
+
+1;
Modified: DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema.pm
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema.pm 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/t/lib/DBICTest/Schema.pm 2009-02-22 01:25:19 UTC (rev 5616)
@@ -18,6 +18,8 @@
#dummy
Track
Tag
+ Year2000CDs
+ Year1999CDs
/,
{ 'DBICTest::Schema' => [qw/
LinerNotes
Modified: DBIx-Class/0.08/branches/subquery/t/lib/sqlite.sql
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/lib/sqlite.sql 2009-02-22 00:56:47 UTC (rev 5615)
+++ DBIx-Class/0.08/branches/subquery/t/lib/sqlite.sql 2009-02-22 01:25:19 UTC (rev 5616)
@@ -1,10 +1,11 @@
--
-- Created by SQL::Translator::Producer::SQLite
--- Created on Sat Jan 24 19:42:15 2009
+-- Created on Sun Feb 22 00:15:06 2009
--
+
+
BEGIN TRANSACTION;
-
--
-- Table: artist
--
@@ -15,7 +16,6 @@
charfield char(10)
);
-
--
-- Table: artist_undirected_map
--
@@ -26,6 +26,7 @@
);
CREATE INDEX artist_undirected_map_idx_id1_ ON artist_undirected_map (id1);
+
CREATE INDEX artist_undirected_map_idx_id2_ ON artist_undirected_map (id2);
--
@@ -47,6 +48,7 @@
);
CREATE INDEX artwork_to_artist_idx_artist_id_artwork_to_arti ON artwork_to_artist (artist_id);
+
CREATE INDEX artwork_to_artist_idx_artwork_cd_id_artwork_to_ ON artwork_to_artist (artwork_cd_id);
--
@@ -59,7 +61,6 @@
clob clob
);
-
--
-- Table: bookmark
--
@@ -81,7 +82,6 @@
price integer
);
-
--
-- Table: cd
--
@@ -95,8 +95,11 @@
);
CREATE INDEX cd_idx_artist_cd ON cd (artist);
+
CREATE INDEX cd_idx_genreid_cd ON cd (genreid);
+
CREATE INDEX cd_idx_single_track_cd ON cd (single_track);
+
CREATE UNIQUE INDEX cd_artist_title_cd ON cd (artist, title);
--
@@ -109,6 +112,7 @@
);
CREATE INDEX cd_to_producer_idx_cd_cd_to_pr ON cd_to_producer (cd);
+
CREATE INDEX cd_to_producer_idx_producer_cd ON cd_to_producer (producer);
--
@@ -119,7 +123,6 @@
name varchar(100) NOT NULL
);
-
--
-- Table: collection_object
--
@@ -130,6 +133,7 @@
);
CREATE INDEX collection_object_idx_collection_collection_obj ON collection_object (collection);
+
CREATE INDEX collection_object_idx_object_c ON collection_object (object);
--
@@ -140,9 +144,17 @@
position integer NOT NULL,
group_id integer,
group_id_2 integer,
+ group_id_3 integer,
name varchar(100)
);
+--
+-- Table: encoded
+--
+CREATE TABLE encoded (
+ id INTEGER PRIMARY KEY NOT NULL,
+ encoded varchar(100)
+);
--
-- Table: event
@@ -156,7 +168,6 @@
skip_inflation datetime
);
-
--
-- Table: file_columns
--
@@ -165,7 +176,6 @@
file varchar(255) NOT NULL
);
-
--
-- Table: forceforeign
--
@@ -188,7 +198,6 @@
PRIMARY KEY (foo, bar, hello, goodbye)
);
-
--
-- Table: fourkeys_to_twokeys
--
@@ -204,6 +213,7 @@
);
CREATE INDEX fourkeys_to_twokeys_idx_f_foo_f_bar_f_hello_f_goodbye_ ON fourkeys_to_twokeys (f_foo, f_bar, f_hello, f_goodbye);
+
CREATE INDEX fourkeys_to_twokeys_idx_t_artist_t_cd_fourkeys_to ON fourkeys_to_twokeys (t_artist, t_cd);
--
@@ -247,7 +257,6 @@
title varchar(100)
);
-
--
-- Table: lyric_versions
--
@@ -289,7 +298,6 @@
cd integer NOT NULL
);
-
--
-- Table: owners
--
@@ -298,7 +306,6 @@
name varchar(100) NOT NULL
);
-
--
-- Table: producer
--
@@ -317,7 +324,6 @@
name varchar(100) NOT NULL
);
-
--
-- Table: self_ref_alias
--
@@ -328,6 +334,7 @@
);
CREATE INDEX self_ref_alias_idx_alias_self_ ON self_ref_alias (alias);
+
CREATE INDEX self_ref_alias_idx_self_ref_se ON self_ref_alias (self_ref);
--
@@ -341,7 +348,6 @@
PRIMARY KEY (pkid1, pkid2)
);
-
--
-- Table: serialized
--
@@ -350,7 +356,6 @@
serialized text NOT NULL
);
-
--
-- Table: tags
--
@@ -374,7 +379,9 @@
);
CREATE INDEX track_idx_cd_track ON track (cd);
+
CREATE UNIQUE INDEX track_cd_position_track ON track (cd, position);
+
CREATE UNIQUE INDEX track_cd_title_track ON track (cd, title);
--
@@ -401,6 +408,7 @@
);
CREATE INDEX twokeytreelike_idx_parent1_parent2_twokeytre ON twokeytreelike (parent1, parent2);
+
CREATE UNIQUE INDEX tktlnameunique_twokeytreelike ON twokeytreelike (name);
--
@@ -424,11 +432,9 @@
);
--
--- Table: encoded
+-- View: year2000cds
--
-CREATE TABLE encoded (
- id INTEGER PRIMARY KEY NOT NULL,
- encoded varchar(100) NOT NULL
-);
+CREATE VIEW year2000cds AS
+ SELECT cdid, artist, title FROM cd WHERE year ='2000';
COMMIT;
Added: DBIx-Class/0.08/branches/subquery/t/ordered/cascade_delete.t
===================================================================
--- DBIx-Class/0.08/branches/subquery/t/ordered/cascade_delete.t (rev 0)
+++ DBIx-Class/0.08/branches/subquery/t/ordered/cascade_delete.t 2009-02-22 01:25:19 UTC (rev 5616)
@@ -0,0 +1,31 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+use POSIX qw(ceil);
+
+my $schema = DBICTest->init_schema();
+
+plan tests => 1;
+
+{
+ my $artist = $schema->resultset ('Artist')->search ({}, { rows => 1})->single; # braindead sqlite
+ my $cd = $schema->resultset ('CD')->create ({
+ artist => $artist,
+ title => 'Get in order',
+ year => 2009,
+ tracks => [
+ { title => 'T1' },
+ { title => 'T2' },
+ { title => 'T3' },
+ ],
+ });
+
+ lives_ok (sub { $cd->delete}, "Cascade delete on ordered has_many doesn't bomb");
+}
+
+1;
Property changes on: DBIx-Class/0.08/branches/subquery/t/ordered/cascade_delete.t
___________________________________________________________________
Name: svn:mergeinfo
+
More information about the Bast-commits
mailing list