[Bast-commits] r8606 - in
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated:
. examples/Schema/MyDatabase/Main/Result lib/DBIx
lib/DBIx/Class lib/DBIx/Class/CDBICompat
lib/DBIx/Class/InflateColumn lib/DBIx/Class/Manual
lib/DBIx/Class/PK lib/DBIx/Class/Relationship
lib/DBIx/Class/ResultSource lib/DBIx/Class/SQLAHacks
lib/DBIx/Class/Schema lib/DBIx/Class/Storage
lib/DBIx/Class/Storage/DBI lib/DBIx/Class/Storage/DBI/ADO
lib/DBIx/Class/Storage/DBI/ODBC lib/DBIx/Class/Storage/DBI/Oracle
lib/DBIx/Class/Storage/DBI/Replicated
lib/DBIx/Class/Storage/DBI/Sybase
lib/DBIx/Class/Storage/DBI/Sybase/ASE
lib/SQL/Translator/Parser/DBIx maint t t/bind t/cdbi
t/cdbi/abstract t/cdbi/testlib t/count t/delete t/inflate
t/lib t/lib/DBICNSTest/Bogus t/lib/DBICNSTest/OtherRslt
t/lib/DBICNSTest/Result t/lib/DBICNSTest/Rslt
t/lib/DBICNSTest/RtBug41083/Schema
t/lib/DBICNSTest/RtBug41083/Schema_A t/lib/DBICTest
t/lib/DBICTest/ResultSetManager t/lib/DBICTest/Schema
t/multi_create t/prefetch t/relationship t/resultset t/schema
t/search t/sqlahacks t/sqlahacks/limit_dialects
t/sqlahacks/quotes t/sqlahacks/sql_maker t/storage
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Wed Feb 10 22:41:56 GMT 2010
Author: caelum
Date: 2010-02-10 22:41:54 +0000 (Wed, 10 Feb 2010)
New Revision: 8606
Added:
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ADO.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ADO/
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Informix.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC/SQL_Anywhere.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/ASE/
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/ASE/NoBindVars.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBIHacks.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/06notabs.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/07eol.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/747mssql_ado.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/748informix.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/749sybase_asa.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/count/search_related.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/delete/complex.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/datetime_sybase_asa.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/ComputedColumn.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersion_v1.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersion_v2.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersion_v3.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/one_to_many_to_one.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/as_subselect_rs.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/nulls_only.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/plus_select.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/schema/
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/schema/anon.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/schema/clone.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/search/related_strip_prefetch.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/limit_dialects/
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/limit_dialects/toplimit.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/quotes/
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/quotes/quotes.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/quotes/quotes_newstyle.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/sql_maker/
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/sql_maker/sql_maker.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/sql_maker/sql_maker_quote.t
Removed:
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/Common.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/19quotes.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/19quotes_newstyle.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/42toplimit.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/95sql_maker.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/95sql_maker_quote.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersionNew.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersionOrig.pm
Modified:
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/Changes
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/Makefile.PL
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/examples/Schema/MyDatabase/Main/Result/Artist.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/examples/Schema/MyDatabase/Main/Result/Cd.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/examples/Schema/MyDatabase/Main/Result/Track.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/AccessorGroup.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/CDBICompat/Constructor.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Componentised.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Core.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/InflateColumn.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/InflateColumn/DateTime.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/InflateColumn/File.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Component.pod
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Cookbook.pod
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Example.pod
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/FAQ.pod
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Intro.pod
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Joining.pod
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Troubleshooting.pod
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/PK/Auto.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/Base.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/CascadeActions.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/HasOne.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/ManyToMany.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSet.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSetColumn.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSource.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSource/View.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSourceProxy.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Row.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/SQLAHacks.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/SQLAHacks/MSSQL.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Schema.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Schema/Versioned.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/AmbiguousGlob.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/DB2.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/MSSQL.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Oracle.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Pg.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated/Introduction.pod
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/SQLite.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/mysql.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/UTF8Columns.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/SQL/Translator/Parser/DBIx/Class.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/maint/gen-schema.pl
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/maint/svn-log.perl
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/100populate.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/101populate_rs.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/104view.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/20setuperrors.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/26dumper.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/51threads.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/51threadtxn.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/52cycle.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/60core.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/71mysql.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/72pg.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/73oracle.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/745db2.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/746mssql.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/746sybase.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/74mssql.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/76joins.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/76select.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/79aliasing.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/80unique.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/81transactions.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/85utf8.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/86might_have.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/86sqlt.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/88result_set_column.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/93autocast.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/93single_accessor_object.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/94versioning.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/98savepoints.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/99dbic_sqlt_parser.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/bind/attribute.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/bind/bindtype_columns.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/01-columns.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/02-Film.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/03-subclassing.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/04-lazy.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/06-hasa.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/09-has_many.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/11-triggers.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/12-filter.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/14-might_have.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/15-accessor.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/18-has_a.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/19-set_sql.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/21-iterator.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/22-deflate_order.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/26-mutator.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/30-pager.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/98-failure.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/abstract/search_where.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Actor.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/ActorAlias.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Blurb.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Director.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Film.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Lazy.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Log.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyBase.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyFilm.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyFoo.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyStar.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyStarLink.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyStarLinkMCPK.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Order.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/OtherFilm.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/count/count_rs.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/count/prefetch.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/from_subquery.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/core.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/datetime_sybase.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/file_column.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/hri.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Bogus/A.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Bogus/B.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/OtherRslt/D.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Result/A.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Result/B.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Rslt/A.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Rslt/B.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/RtBug41083/Schema/Foo.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/RtBug41083/Schema_A/A.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/BaseResult.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/ResultSetManager/Foo.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Artist.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/CD.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Track.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Year1999CDs.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Year2000CDs.pm
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/sqlite.sql
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/multi_create/standard.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/diamond.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/double_prefetch.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/grouped.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/multiple_hasmany.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/standard.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/via_search_related.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/with_limit.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/relationship/core.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/as_query.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/is_paged.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/update_delete.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/search/preserve_original_rs.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/search/subquery.t
DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/storage/debug.t
Log:
r21097 at hlagh (orig r7843): ribasushi | 2009-11-04 04:55:51 -0500
r7817 at Thesaurus (orig r7805): rbuels | 2009-10-21 02:37:28 +0200
making a branch, here we go again with the pg_unqualified_schema
r7818 at Thesaurus (orig r7806): rbuels | 2009-10-21 02:38:59 +0200
more pg unqualified schema tests, which expose a gap in the coverage
r7819 at Thesaurus (orig r7807): rbuels | 2009-10-21 03:10:38 +0200
gutted Pg storage driver's sequence discovery to just rely on DBD::Pg's last_insert_id. this needs testing with older versions of DBD::Pg
r7821 at Thesaurus (orig r7809): rbuels | 2009-10-21 04:00:39 +0200
more coverage in Pg sequence-discovery tests. i think this shows why last_insert_id cannot be used.
r7822 at Thesaurus (orig r7810): rbuels | 2009-10-21 04:07:05 +0200
reverted [7807], and just changed code to use the custom pg_catalog query, which is the only thing that works in the pathological case where DBIC is told a different primary key from the primary key that is set on the table in the DB ([7809] added testing for this)
r7852 at Thesaurus (orig r7840): rbuels | 2009-11-03 18:47:05 +0100
added Changes line mentioning tweak to Pg auto-inc fix
r7854 at Thesaurus (orig r7842): ribasushi | 2009-11-04 10:55:35 +0100
Cleanup exceptions
r21100 at hlagh (orig r7846): caelum | 2009-11-06 10:01:30 -0500
transactions for MSSQL over DBD::Sybase
r21103 at hlagh (orig r7849): caelum | 2009-11-10 07:16:18 -0500
made commit/rollback when disconnected an exception
r21104 at hlagh (orig r7850): robkinyon | 2009-11-10 11:19:57 -0500
Added a note about select
r21105 at hlagh (orig r7851): ribasushi | 2009-11-10 12:23:10 -0500
Changes
r21109 at hlagh (orig r7855): frew | 2009-11-11 15:56:37 -0500
RT50874
r21110 at hlagh (orig r7856): frew | 2009-11-11 17:50:43 -0500
RT50828
r21111 at hlagh (orig r7857): frew | 2009-11-11 17:54:15 -0500
clearer test message
r21112 at hlagh (orig r7858): frew | 2009-11-11 18:37:27 -0500
some cleanup for $rs->populate
r21114 at hlagh (orig r7860): ribasushi | 2009-11-11 19:35:36 -0500
Fix find on resultset with custom result_class
r21115 at hlagh (orig r7861): ribasushi | 2009-11-11 19:40:14 -0500
Fix return value of in_storage
r21116 at hlagh (orig r7862): ribasushi | 2009-11-11 19:43:48 -0500
Extra FAQ entry
r21117 at hlagh (orig r7863): ribasushi | 2009-11-11 20:11:25 -0500
Sanify _determine_driver handling in ::Storage::DBI
r21118 at hlagh (orig r7864): ribasushi | 2009-11-11 20:14:37 -0500
Add mysql determine_driver test by Pedro Melo
r21123 at hlagh (orig r7869): ribasushi | 2009-11-12 05:10:04 -0500
_cond_for_update_delete is hopelessly broken attempting to introspect SQLA1. Replace with a horrific but effective hack
r21124 at hlagh (orig r7870): ribasushi | 2009-11-12 05:15:12 -0500
Clarifying comment
r21126 at hlagh (orig r7872): ribasushi | 2009-11-12 18:13:40 -0500
The real fix for the non-introspectable condition bug, mst++
r21127 at hlagh (orig r7873): ribasushi | 2009-11-12 18:24:56 -0500
Some cleanup
r21129 at hlagh (orig r7875): frew | 2009-11-13 04:01:37 -0500
fix subtle bug with Sybase database type determination
r21134 at hlagh (orig r7880): frew | 2009-11-13 18:53:29 -0500
release woo!
r21136 at hlagh (orig r7882): caelum | 2009-11-13 21:57:52 -0500
fix oracle dep in Makefile.PL
r21137 at hlagh (orig r7883): caelum | 2009-11-13 22:20:53 -0500
skip Oracle BLOB tests on DBD::Oracle == 1.23
r21139 at hlagh (orig r7885): caelum | 2009-11-14 03:40:01 -0500
r7357 at pentium (orig r7355): caelum | 2009-08-20 17:58:23 -0400
branch to support MSSQL over ADO
r7358 at pentium (orig r7356): caelum | 2009-08-21 00:32:14 -0400
something apparently working
r7359 at pentium (orig r7357): caelum | 2009-08-21 00:53:53 -0400
slightly better mars test, still passes
r21141 at hlagh (orig r7887): caelum | 2009-11-14 03:41:54 -0500
r7888 at pentium (orig r7886): caelum | 2009-11-14 03:41:25 -0500
add TODO test for large column list in select
r21143 at hlagh (orig r7889): caelum | 2009-11-14 03:47:16 -0500
add ADO/MSSQL to Changes
r21144 at hlagh (orig r7890): caelum | 2009-11-14 04:27:29 -0500
fix the large column list test for ADO/MSSQL, now passes
r21146 at hlagh (orig r7892): caelum | 2009-11-14 06:20:58 -0500
fix Changes (ADO change in wrong release)
r21147 at hlagh (orig r7893): ribasushi | 2009-11-14 13:23:23 -0500
Release 0.08114
r21149 at hlagh (orig r7895): ribasushi | 2009-11-15 06:09:17 -0500
Failing test to highlight mssql autoconnect regression
r21150 at hlagh (orig r7896): ribasushi | 2009-11-15 06:20:25 -0500
Fix plan
r21155 at hlagh (orig r7901): ribasushi | 2009-11-15 07:11:38 -0500
r7773 at Thesaurus (orig r7761): norbi | 2009-10-05 14:49:06 +0200
Created branch 'prefetch_bug-unqualified_column_in_search_related_cond': A bug that manifests when a prefetched table's column is referenced without the table name in the condition of a search_related() on an M:N relationship.
r7878 at Thesaurus (orig r7866): ribasushi | 2009-11-12 02:36:08 +0100
Factor some code out
r7879 at Thesaurus (orig r7867): ribasushi | 2009-11-12 09:11:03 +0100
Factor out more stuff
r7880 at Thesaurus (orig r7868): ribasushi | 2009-11-12 09:21:04 +0100
Saner naming/comments
r7910 at Thesaurus (orig r7898): ribasushi | 2009-11-15 12:39:29 +0100
Move more code to DBIHacks, put back the update/delete rs check, just in case
r7911 at Thesaurus (orig r7899): ribasushi | 2009-11-15 13:01:34 +0100
TODOify test until we get an AST
r7912 at Thesaurus (orig r7900): ribasushi | 2009-11-15 13:10:15 +0100
Hide from pause
r21163 at hlagh (orig r7909): ribasushi | 2009-11-15 08:17:48 -0500
r7871 at Thesaurus (orig r7859): ribasushi | 2009-11-12 00:46:07 +0100
Branches to test some ideas
r7889 at Thesaurus (orig r7877): abraxxa | 2009-11-13 12:05:50 +0100
added rels to view result classes in test schema
r7890 at Thesaurus (orig r7878): abraxxa | 2009-11-13 13:05:45 +0100
seems I found the bugger
r7917 at Thesaurus (orig r7905): ribasushi | 2009-11-15 13:29:23 +0100
FK constraints towards a view don't quite work
r7918 at Thesaurus (orig r7906): ribasushi | 2009-11-15 14:10:10 +0100
Turn into a straight-inheritance view class
r7919 at Thesaurus (orig r7907): ribasushi | 2009-11-15 14:11:03 +0100
Extensive test of virtual and classic view relationships
r7920 at Thesaurus (orig r7908): ribasushi | 2009-11-15 14:17:23 +0100
Fix non-sqlt schema file
r21165 at hlagh (orig r7911): caelum | 2009-11-15 12:31:37 -0500
fix MSSQL via DBD::Sybase regression
r21172 at hlagh (orig r7918): ribasushi | 2009-11-16 13:15:45 -0500
r7864 at Thesaurus (orig r7852): edenc | 2009-11-10 20:15:15 +0100
branching for fixes related to prefetch, distinct and group by
r7865 at Thesaurus (orig r7853): edenc | 2009-11-10 20:21:38 +0100
added test case for ensuring a column mentioned in the order by clause is also included in the group by clause
r7926 at Thesaurus (orig r7914): ribasushi | 2009-11-16 08:09:30 +0100
Make _resolve_column_info function without supplying column names
r7927 at Thesaurus (orig r7915): ribasushi | 2009-11-16 08:11:17 +0100
Fix order_by/distinct bug
r21179 at hlagh (orig r7925): ribasushi | 2009-11-19 06:04:21 -0500
Bail out eary in Versioned if no versioning checks are requested
r21180 at hlagh (orig r7926): ribasushi | 2009-11-19 06:06:13 -0500
POD fixes
r21182 at hlagh (orig r7928): caelum | 2009-11-22 05:03:33 -0500
fix connection setup for Sybase
r21185 at hlagh (orig r7931): caelum | 2009-11-22 07:27:43 -0500
override _run_connection_actions for internal connection setup in sybase stuff, much cleaner this way
r21189 at hlagh (orig r7935): ribasushi | 2009-11-22 19:18:28 -0500
Whoops
r21190 at hlagh (orig r7936): ribasushi | 2009-11-22 19:28:50 -0500
Fix ::Versioned regression introduced in r7925
r21193 at hlagh (orig r7939): caelum | 2009-11-23 06:32:10 -0500
add subname to rdbms_specific_methods wrapper
r21195 at hlagh (orig r7941): caelum | 2009-11-23 07:23:14 -0500
r21187 at hlagh (orig r7933): ribasushi | 2009-11-22 18:38:34 -0500
New sybase refactor branch
r21188 at hlagh (orig r7934): ribasushi | 2009-11-22 19:06:48 -0500
refactor part1
r21192 at hlagh (orig r7938): ribasushi | 2009-11-22 19:30:05 -0500
refactor part 2
r21194 at hlagh (orig r7940): caelum | 2009-11-23 07:06:46 -0500
fix test
r21584 at hlagh (orig r7943): ribasushi | 2009-11-23 10:30:13 -0500
Add missing Sub::Name invocations and improve the SQLA Carp overrides
r21586 at hlagh (orig r7945): ribasushi | 2009-11-24 04:12:49 -0500
r7749 at Thesaurus (orig r7738): norbi | 2009-09-28 22:01:39 +0200
Created branch 'void_populate_resultset_cond': Fixing a bug: $rs->populate in void context does not use the conditions from $rs.
r7751 at Thesaurus (orig r7740): norbi | 2009-09-28 23:26:06 +0200
r7935 at vger: mendel | 2009-09-28 23:25:52 +0200
Undid the previous tweaks to the already existing tests and added new tests instead.
r7928 at Thesaurus (orig r7916): ribasushi | 2009-11-16 08:48:42 +0100
Change plan
r7956 at Thesaurus (orig r7944): ribasushi | 2009-11-24 10:10:49 +0100
Better naming and a bit leaner implementation. Main idea remains the same
r21588 at hlagh (orig r7947): ribasushi | 2009-11-24 04:39:52 -0500
Changes and prevent a spurious todo-pass
r21591 at hlagh (orig r7950): ribasushi | 2009-11-24 13:43:42 -0500
Extra sqla quoting test
r21592 at hlagh (orig r7951): ribasushi | 2009-11-24 13:48:01 -0500
Extra sqla quoting test(2)
r21593 at hlagh (orig r7952): ribasushi | 2009-11-25 15:24:10 -0500
wtf
r21596 at hlagh (orig r7955): ribasushi | 2009-11-26 05:07:06 -0500
cleanups
r21597 at hlagh (orig r7956): ribasushi | 2009-11-26 06:11:21 -0500
Sanify search_related chaining code (no functional changes)
r21598 at hlagh (orig r7957): ribasushi | 2009-11-26 06:52:05 -0500
Another count() quirk down
r21599 at hlagh (orig r7958): ribasushi | 2009-11-26 08:23:28 -0500
Add a no-accessor column to generally test handling
r21601 at hlagh (orig r7960): ribasushi | 2009-11-26 09:32:17 -0500
Whoops, wrong accessor (things still work though)
r21606 at hlagh (orig r7965): ribasushi | 2009-11-26 10:43:21 -0500
r7971 at Thesaurus (orig r7959): ribasushi | 2009-11-26 14:54:17 +0100
New branch for get_inflated_column bugfix
r7974 at Thesaurus (orig r7962): ribasushi | 2009-11-26 15:56:20 +0100
Fix for rt46953
r7975 at Thesaurus (orig r7963): ribasushi | 2009-11-26 16:05:17 +0100
Make Test::More happy
r7976 at Thesaurus (orig r7964): ribasushi | 2009-11-26 16:43:09 +0100
Changes
r21609 at hlagh (orig r7968): ribasushi | 2009-11-26 19:38:11 -0500
Fix search_related wrt grouped resultsets (distinct is currently passed to the new resultset, this is probably wrong)
r21616 at hlagh (orig r7975): ribasushi | 2009-11-28 10:54:23 -0500
Cleanup the s.c.o. index
r21617 at hlagh (orig r7976): ribasushi | 2009-11-28 10:57:04 -0500
Test based on http://lists.scsys.co.uk/pipermail/dbix-class/2009-November/008599.html
r21714 at hlagh (orig r7995): castaway | 2009-11-30 10:20:19 -0500
Remove over-emphasis on +select/+as. Add docs on prefetch and other ways to get related data, with caveats etc.
r21716 at hlagh (orig r7997): dew | 2009-11-30 13:37:00 -0500
Alter the docs for has_many relationships to make them a little easier to grok
r21793 at hlagh (orig r8009): castaway | 2009-12-02 08:19:40 -0500
Added note about prefetch and has_many related objects
r21891 at hlagh (orig r8017): ribasushi | 2009-12-03 07:24:04 -0500
Source sanity check on subqueried update/delete
r21892 at hlagh (orig r8018): ribasushi | 2009-12-03 08:39:37 -0500
Sanify populate arg handling
r21902 at hlagh (orig r8028): ribasushi | 2009-12-03 20:46:20 -0500
r7935 at Thesaurus (orig r7923): ribasushi | 2009-11-19 11:05:04 +0100
Branches for RTs
r7965 at Thesaurus (orig r7953): ribasushi | 2009-11-26 00:19:21 +0100
Test and fix scalarref in an inflatable slot corner-case
r7966 at Thesaurus (orig r7954): ribasushi | 2009-11-26 00:24:23 +0100
Looks like we nailed a todo
r8038 at Thesaurus (orig r8026): ribasushi | 2009-12-04 02:45:40 +0100
Changes
r8039 at Thesaurus (orig r8027): ribasushi | 2009-12-04 02:46:08 +0100
Changes(2)
r21917 at hlagh (orig r8043): ribasushi | 2009-12-07 09:11:25 -0500
Forgotten auto-savepoint example patch
r21953 at hlagh (orig r8045): ribasushi | 2009-12-08 08:13:38 -0500
Weird test case
r21954 at hlagh (orig r8046): ribasushi | 2009-12-08 08:23:31 -0500
Fix the test - code is correct
r21959 at hlagh (orig r8051): ribasushi | 2009-12-08 20:33:30 -0500
It's almost 2010 - load_components ('Core') is like ewwww
r21968 at hlagh (orig r8055): caelum | 2009-12-09 12:13:33 -0500
workaround for evil ADO bug
r21969 at hlagh (orig r8056): ribasushi | 2009-12-09 17:13:59 -0500
r8022 at Thesaurus (orig r8010): frew | 2009-12-02 17:57:17 +0100
branch for replacing TOP with RNO in MSSQL
r8027 at Thesaurus (orig r8015): frew | 2009-12-03 02:48:36 +0100
Switch to RowNumberOver for MSSQL
r8028 at Thesaurus (orig r8016): ribasushi | 2009-12-03 10:03:18 +0100
The correct top100 mssql solution and test
r8031 at Thesaurus (orig r8019): frew | 2009-12-03 15:56:35 +0100
fix RNO for MSSQL to not use a kludgy regexp
r8032 at Thesaurus (orig r8020): frew | 2009-12-04 01:33:28 +0100
initial (broken) version of 42rno.t
r8033 at Thesaurus (orig r8021): frew | 2009-12-04 01:37:06 +0100
first shot at moving stuff around
r8034 at Thesaurus (orig r8022): frew | 2009-12-04 01:45:42 +0100
rename files to get rid of numbers and use folders
r8035 at Thesaurus (orig r8023): frew | 2009-12-04 01:48:00 +0100
missed toplimit
r8036 at Thesaurus (orig r8024): frew | 2009-12-04 01:52:44 +0100
still broken rno test, but now it actually tests mssql
r8042 at Thesaurus (orig r8030): ribasushi | 2009-12-04 09:34:56 +0100
Variable clash
r8043 at Thesaurus (orig r8031): ribasushi | 2009-12-04 11:44:47 +0100
The complex prefetch rewrite actually takes care of this as cleanly as possible
r8044 at Thesaurus (orig r8032): ribasushi | 2009-12-04 11:47:22 +0100
Smarter implementation of the select top 100pct subselect handling
r8045 at Thesaurus (orig r8033): ribasushi | 2009-12-04 12:07:05 +0100
Add support for unordered limited resultsets
Rename the limit helper to signify it is MS specific
Make sure we don't lose group_by/having clauses
r8046 at Thesaurus (orig r8034): ribasushi | 2009-12-04 12:07:56 +0100
Un-todoify mssql limit tests - no changes necessary (throw away the obsolete generated sql checks)
r8047 at Thesaurus (orig r8035): ribasushi | 2009-12-04 12:24:13 +0100
Tests for bindvar propagation and Changes
r8049 at Thesaurus (orig r8037): ribasushi | 2009-12-04 15:01:32 +0100
KISS - a select(1) makes perfect ordering criteria
r8050 at Thesaurus (orig r8038): ribasushi | 2009-12-04 15:06:11 +0100
Unify the MSSQL and DB2 RNO implementations - they are the same
r8051 at Thesaurus (orig r8039): ribasushi | 2009-12-05 10:29:50 +0100
Wrap mssql selects in yet another subquery to make limited right-ordered join resultsets possible
r8052 at Thesaurus (orig r8040): ribasushi | 2009-12-05 10:46:41 +0100
Better not touch Top - it's too complex at this point
r8053 at Thesaurus (orig r8041): ribasushi | 2009-12-05 11:03:00 +0100
Extend test just a bit more
r8054 at Thesaurus (orig r8042): ribasushi | 2009-12-05 11:44:25 +0100
DB2 and MSSQL have different default order syntaxes
r8056 at Thesaurus (orig r8044): frew | 2009-12-08 02:10:06 +0100
add version check for mssql 2005 and greater
r8059 at Thesaurus (orig r8047): frew | 2009-12-08 16:15:50 +0100
real exception instead of die
r8061 at Thesaurus (orig r8049): ribasushi | 2009-12-09 00:19:49 +0100
Test for immediate connection with known storage type
r8062 at Thesaurus (orig r8050): frew | 2009-12-09 01:24:45 +0100
fix mssql version check so it's lazier
r8064 at Thesaurus (orig r8052): ribasushi | 2009-12-09 02:40:51 +0100
Fix comment
r8066 at Thesaurus (orig r8054): caelum | 2009-12-09 16:12:56 +0100
fix _get_mssql_version for ODBC
r21972 at hlagh (orig r8059): frew | 2009-12-09 18:32:55 -0500
fail nicely if user doesn't have perms for xp_msver
r21974 at hlagh (orig r8061): ribasushi | 2009-12-10 03:36:21 -0500
Changes
r21975 at hlagh (orig r8062): ribasushi | 2009-12-10 03:53:38 -0500
First half of distinct cleanup
r21976 at hlagh (orig r8063): frew | 2009-12-10 10:04:37 -0500
release 0.08115
r22042 at hlagh (orig r8064): ribasushi | 2009-12-12 06:31:12 -0500
Even clearer unloaded FK exception
r22044 at hlagh (orig r8066): ribasushi | 2009-12-12 08:27:18 -0500
As clear as it gets
r22135 at hlagh (orig r8129): ovid | 2009-12-16 11:40:50 -0500
Have has_one/might_have warn if set on nullable columns.
r22194 at hlagh (orig r8131): caelum | 2009-12-17 07:30:10 -0500
somewhat better fix for ADO
r22195 at hlagh (orig r8132): caelum | 2009-12-17 07:34:20 -0500
minor changes
r22238 at hlagh (orig r8134): caelum | 2009-12-17 11:44:34 -0500
cleanup source_bind_attributes for ADO
r22239 at hlagh (orig r8135): caelum | 2009-12-17 12:09:55 -0500
more types for ADO fix, and documentation
r22240 at hlagh (orig r8136): abraxxa | 2009-12-17 13:54:55 -0500
Cookbook POD fix for add_drop_table instead of add_drop_tables
r22250 at hlagh (orig r8146): ribasushi | 2009-12-18 08:55:53 -0500
r8150 at Thesaurus (orig r8138): abraxxa | 2009-12-17 23:22:07 +0100
Views without a view_definition won't be added to the SQL::Translator::Schema by the parser + tests
r8151 at Thesaurus (orig r8139): abraxxa | 2009-12-17 23:23:33 +0100
test cleanups
r8153 at Thesaurus (orig r8141): abraxxa | 2009-12-18 14:34:14 +0100
throw_exception if view_definition is missing instead of silent skipping + test changes
r8154 at Thesaurus (orig r8142): abraxxa | 2009-12-18 14:40:32 +0100
use Test::Exception
r8155 at Thesaurus (orig r8143): abraxxa | 2009-12-18 14:42:00 +0100
fixed Changes
r8156 at Thesaurus (orig r8144): abraxxa | 2009-12-18 14:44:52 +0100
test cleanups
r8157 at Thesaurus (orig r8145): ribasushi | 2009-12-18 14:46:26 +0100
Another bitr
r22252 at hlagh (orig r8148): ribasushi | 2009-12-18 09:04:34 -0500
Fix no_index entries
r22254 at hlagh (orig r8150): abraxxa | 2009-12-18 09:59:58 -0500
Schema POD inprovement for dclone
r22255 at hlagh (orig r8151): abraxxa | 2009-12-18 10:07:27 -0500
link to DBIx::Class::Row
r22256 at hlagh (orig r8152): abraxxa | 2009-12-18 10:08:56 -0500
fixed typo in Changes
r22257 at hlagh (orig r8153): abraxxa | 2009-12-18 10:14:47 -0500
dclone pod take #2
r22261 at hlagh (orig r8157): ribasushi | 2009-12-19 12:47:42 -0500
detabify
r22262 at hlagh (orig r8158): ribasushi | 2009-12-19 13:41:42 -0500
Fix RT52812
r22263 at hlagh (orig r8159): caelum | 2009-12-23 01:16:29 -0500
minor POD fixes
r22274 at hlagh (orig r8163): ribasushi | 2009-12-24 03:59:52 -0500
Fix deployment_statements context sensitivity regression
r22275 at hlagh (orig r8164): ribasushi | 2009-12-24 04:13:37 -0500
Don't call the PK setter if no PK
r22319 at hlagh (orig r8192): caelum | 2009-12-30 16:58:47 -0500
bump CAG dep
r22346 at hlagh (orig r8219): matthewt | 2010-01-01 19:41:12 -0500
fix typo in variable name
r22377 at hlagh (orig r8226): rafl | 2010-01-02 12:46:40 -0500
Merge branch 'native_traits'
* native_traits:
Port replicated storage from MXAH to native traits.
Create branch native_traits
r22405 at hlagh (orig r8232): caelum | 2010-01-03 18:30:51 -0500
fix _rebless into sybase/mssql/nobindvars
r22420 at hlagh (orig r8235): caelum | 2010-01-05 07:54:56 -0500
r22328 at hlagh (orig r8201): caelum | 2009-12-31 12:29:51 -0500
new branch to fix table aliases in queries over the 30char limit
r22329 at hlagh (orig r8202): caelum | 2009-12-31 12:55:50 -0500
failing test
r22330 at hlagh (orig r8203): caelum | 2009-12-31 13:00:35 -0500
switch oracle tests to done_testing()
r22331 at hlagh (orig r8204): caelum | 2009-12-31 15:02:50 -0500
got something working
r22332 at hlagh (orig r8205): caelum | 2009-12-31 15:08:30 -0500
POD touchups
r22343 at hlagh (orig r8216): caelum | 2010-01-01 07:42:03 -0500
fix uninitialized warning and a bug in ResultSet
r22419 at hlagh (orig r8234): caelum | 2010-01-05 07:53:18 -0500
append half of a base64 MD5 to shortened table aliases for Oracle
r22422 at hlagh (orig r8237): caelum | 2010-01-05 09:27:40 -0500
minor change: use more of the hash if possible for oracle table alias shortening
r22424 at hlagh (orig r8239): caelum | 2010-01-05 20:20:17 -0500
bump perl_version to 5.8.1
r22425 at hlagh (orig r8240): caelum | 2010-01-05 20:21:41 -0500
remove alignment mark on base64 md5
r22459 at hlagh (orig r8248): ribasushi | 2010-01-07 05:21:55 -0500
5.8.1 is minimum required perl
r22460 at hlagh (orig r8249): ribasushi | 2010-01-07 05:22:42 -0500
Minor optimization
r22461 at hlagh (orig r8250): ribasushi | 2010-01-07 05:23:35 -0500
Wrong title
r22464 at hlagh (orig r8253): ribasushi | 2010-01-08 11:48:50 -0500
Resolve problem reported by http://lists.scsys.co.uk/pipermail/dbix-class/2009-December/008699.html
r22465 at hlagh (orig r8254): ribasushi | 2010-01-08 11:52:01 -0500
Put utf8columns in line with the store_column fix
r22466 at hlagh (orig r8255): ribasushi | 2010-01-08 13:03:26 -0500
Tests while hunting for something else
r22467 at hlagh (orig r8256): ribasushi | 2010-01-08 13:14:42 -0500
Make test look even more like http://lists.scsys.co.uk/pipermail/dbix-class/2009-November/008599.html
r22476 at hlagh (orig r8265): ribasushi | 2010-01-08 20:16:14 -0500
r8263 at Thesaurus (orig r8251): ribasushi | 2010-01-08 15:43:38 +0100
New branch to find a leak
r8264 at Thesaurus (orig r8252): ribasushi | 2010-01-08 15:52:46 +0100
Weird test failures
r8272 at Thesaurus (orig r8260): ribasushi | 2010-01-09 01:24:56 +0100
Proper invocation
r8273 at Thesaurus (orig r8261): ribasushi | 2010-01-09 01:35:34 +0100
Test for the real leak reason
r8274 at Thesaurus (orig r8262): ribasushi | 2010-01-09 01:37:33 +0100
Void ctx as it should be
r8275 at Thesaurus (orig r8263): ribasushi | 2010-01-09 02:10:13 +0100
A "fix" for sqlt-related schema leaks
r8276 at Thesaurus (orig r8264): ribasushi | 2010-01-09 02:15:53 +0100
Changes
r22496 at hlagh (orig r8275): caelum | 2010-01-10 05:29:06 -0500
r22483 at hlagh (orig r8272): caelum | 2010-01-09 05:52:15 -0500
new branch to add "normalize_connect_info" class method to Storage::DBI
r22495 at hlagh (orig r8274): caelum | 2010-01-10 05:27:42 -0500
split connect_info parser out into private _normalize_connect_info
r22498 at hlagh (orig r8277): caelum | 2010-01-10 06:04:52 -0500
fix connection details in ::DBI::Replicated docs
r22545 at hlagh (orig r8279): ribasushi | 2010-01-11 03:50:21 -0500
r8077 at Thesaurus (orig r8065): ribasushi | 2009-12-12 14:24:30 +0100
Branch for yet another mssql ordered prefetch problem
r8079 at Thesaurus (orig r8067): ribasushi | 2009-12-12 14:37:48 +0100
prefetch does not get disassembled properly
r8112 at Thesaurus (orig r8100): ribasushi | 2009-12-13 00:07:00 +0100
Extra test to highlight search_related inefficiency
r8113 at Thesaurus (orig r8101): ribasushi | 2009-12-13 00:17:44 +0100
Real test for search_related and prefetch
r8114 at Thesaurus (orig r8102): ribasushi | 2009-12-13 00:19:57 +0100
Fix corner case regression on search_related on a prefetching rs
r8115 at Thesaurus (orig r8103): ribasushi | 2009-12-13 00:21:05 +0100
Isolate prefetch heads using RNO with a subquery
r8116 at Thesaurus (orig r8104): ribasushi | 2009-12-13 00:23:46 +0100
Changes
r8125 at Thesaurus (orig r8113): ribasushi | 2009-12-15 13:06:26 +0100
Extend mssql limited prefetch tests
r8126 at Thesaurus (orig r8114): ribasushi | 2009-12-15 13:08:56 +0100
Add extra test to prove Alan wrong :)
r8132 at Thesaurus (orig r8120): ribasushi | 2009-12-16 00:38:04 +0100
Do not realias tables in the RNO subqueries
r8133 at Thesaurus (orig r8121): ribasushi | 2009-12-16 00:50:52 +0100
Deliberately disturb alphabetical order
r8134 at Thesaurus (orig r8122): ribasushi | 2009-12-16 10:26:43 +0100
Got a failing test
r8135 at Thesaurus (orig r8123): ribasushi | 2009-12-16 10:49:10 +0100
Cleanup
r8136 at Thesaurus (orig r8124): ribasushi | 2009-12-16 10:51:58 +0100
More moving around
r8137 at Thesaurus (orig r8125): ribasushi | 2009-12-16 11:25:37 +0100
The real mssql problem - it's... bad
r8138 at Thesaurus (orig r8126): ribasushi | 2009-12-16 11:29:20 +0100
Clearer debug
r8139 at Thesaurus (orig r8127): ribasushi | 2009-12-16 11:47:48 +0100
This is horrific but the tests pass... maybe someone will figure out something better
r8140 at Thesaurus (orig r8128): ribasushi | 2009-12-16 16:45:47 +0100
cleanup tests
r8187 at Thesaurus (orig r8175): ribasushi | 2009-12-24 16:22:30 +0100
Ordered subqueries do not work in mssql after all
r8271 at Thesaurus (orig r8259): ribasushi | 2010-01-08 23:58:13 +0100
Cleaner RNO sql
r8279 at Thesaurus (orig r8267): ribasushi | 2010-01-09 10:13:16 +0100
Subqueries no longer experimental
r8280 at Thesaurus (orig r8268): ribasushi | 2010-01-09 11:26:46 +0100
Close the book on mssql ordered subqueries
r8281 at Thesaurus (orig r8269): ribasushi | 2010-01-09 11:36:36 +0100
Changes and typos
r8283 at Thesaurus (orig r8271): ribasushi | 2010-01-09 11:42:21 +0100
Highlight the real problem
r8285 at Thesaurus (orig r8273): ribasushi | 2010-01-10 10:07:10 +0100
Rename subquery to subselect and rewrite POD (per castaway)
r8290 at Thesaurus (orig r8278): ribasushi | 2010-01-10 17:01:24 +0100
rename as per mst
r22549 at hlagh (orig r8283): caelum | 2010-01-11 17:42:30 -0500
make a public ::Schema::unregister_source
r22552 at hlagh (orig r8286): abraxxa | 2010-01-12 12:04:18 -0500
fixed a typo in Changes
more detailed explanation for the warning about has_one/might_have rels on nullable columns
r22561 at hlagh (orig r8295): abraxxa | 2010-01-13 11:28:05 -0500
added the sources parser arg to the example code
r22642 at hlagh (orig r8315): ribasushi | 2010-01-14 19:25:39 -0500
r8167 at Thesaurus (orig r8155): ribasushi | 2009-12-19 12:50:13 +0100
New branch for null-only-result fix
r8168 at Thesaurus (orig r8156): ribasushi | 2009-12-19 12:51:21 +0100
Failing test
r8322 at Thesaurus (orig r8310): ribasushi | 2010-01-15 00:48:09 +0100
Correct test order
r8323 at Thesaurus (orig r8311): ribasushi | 2010-01-15 01:15:33 +0100
Generalize the to-node inner-join-er to apply to all related_resultset calls, not just counts
r8324 at Thesaurus (orig r8312): ribasushi | 2010-01-15 01:16:05 +0100
Adjust sql-emitter tests
r8326 at Thesaurus (orig r8314): ribasushi | 2010-01-15 01:25:10 +0100
One more sql-test fix and changes
r22643 at hlagh (orig r8316): ribasushi | 2010-01-14 19:31:58 -0500
Strict mysql bugfix
r22644 at hlagh (orig r8317): ribasushi | 2010-01-14 19:38:53 -0500
Better description of mysql strict option
r22646 at hlagh (orig r8319): ribasushi | 2010-01-14 21:12:13 -0500
Update troubleshooting doc
r22652 at hlagh (orig r8325): ribasushi | 2010-01-15 11:13:28 -0500
RT52674
r22661 at hlagh (orig r8334): ribasushi | 2010-01-17 03:41:49 -0500
No method aliasing in OO code, *ever*
r22687 at hlagh (orig r8360): ribasushi | 2010-01-18 05:54:51 -0500
Adjust my email
r22701 at hlagh (orig r8374): ribasushi | 2010-01-19 07:07:07 -0500
r8340 at Thesaurus (orig r8328): abraxxa | 2010-01-15 19:21:20 +0100
added branch no_duplicate_indexes_for_pk_cols with test and fix
r8343 at Thesaurus (orig r8331): abraxxa | 2010-01-15 19:32:16 +0100
don't use eq_set in test
r8344 at Thesaurus (orig r8332): abraxxa | 2010-01-15 19:44:04 +0100
don't sort the primary columns because order matters for indexes
r8345 at Thesaurus (orig r8333): abraxxa | 2010-01-15 19:56:46 +0100
don't sort the key columns because the order of columns is important for indexes
r8372 at Thesaurus (orig r8359): abraxxa | 2010-01-18 10:22:09 +0100
don't sort the columns in the tests either
r8378 at Thesaurus (orig r8365): abraxxa | 2010-01-18 15:39:28 +0100
added pod section for parser args
r8379 at Thesaurus (orig r8366): abraxxa | 2010-01-18 15:53:08 +0100
better pod thanks to ribasushi
r8380 at Thesaurus (orig r8367): abraxxa | 2010-01-18 16:04:34 +0100
test and pod fixes
r8383 at Thesaurus (orig r8370): abraxxa | 2010-01-19 12:38:44 +0100
fixed Authors section
added License section
fixed t/86sqlt.t tests
r8384 at Thesaurus (orig r8371): ribasushi | 2010-01-19 12:59:52 +0100
Regenaretd under new parser
r8385 at Thesaurus (orig r8372): ribasushi | 2010-01-19 13:03:51 +0100
Minor style change and white space trim
r8386 at Thesaurus (orig r8373): ribasushi | 2010-01-19 13:06:54 +0100
Changes abraxxa++
r22704 at hlagh (orig r8377): ribasushi | 2010-01-19 07:41:03 -0500
Some minor test refactor and tab cleanups
r22708 at hlagh (orig r8381): frew | 2010-01-19 11:34:10 -0500
add test to ensure no tabs in perl files
r22711 at hlagh (orig r8384): frew | 2010-01-19 12:00:12 -0500
fix test to be an author dep
r22712 at hlagh (orig r8385): ribasushi | 2010-01-19 12:19:40 -0500
First round of detabification
r22713 at hlagh (orig r8386): frew | 2010-01-19 17:42:50 -0500
Add EOL test
r22715 at hlagh (orig r8388): ribasushi | 2010-01-20 02:32:39 -0500
Fix minor RSC bug
r22716 at hlagh (orig r8389): roman | 2010-01-20 09:47:26 -0500
Added a FAQ entry titled: How do I override a run time method (e.g. a relationship accessor)?
r22717 at hlagh (orig r8390): roman | 2010-01-20 10:31:41 -0500
Added myself as a contributor.
r22722 at hlagh (orig r8395): jhannah | 2010-01-21 00:48:14 -0500
Added FAQ: Custom methods in Result classes
r22727 at hlagh (orig r8400): frew | 2010-01-21 22:17:20 -0500
add _is_numeric to ::Row
r22732 at hlagh (orig r8405): ribasushi | 2010-01-22 05:00:05 -0500
Generalize autoinc/count test
r22734 at hlagh (orig r8407): ribasushi | 2010-01-22 05:11:49 -0500
Final round of detabify
r22735 at hlagh (orig r8408): ribasushi | 2010-01-22 05:12:54 -0500
Temporarily disable whitespace checkers
r22740 at hlagh (orig r8413): ribasushi | 2010-01-22 05:35:15 -0500
Moev failing regression test away from trunk
r22745 at hlagh (orig r8418): frew | 2010-01-22 11:05:12 -0500
fix name of _is_numeric to _is_column_numeric
r22751 at hlagh (orig r8424): ribasushi | 2010-01-26 03:33:42 -0500
Switch to Test::Exception
r22752 at hlagh (orig r8425): ribasushi | 2010-01-26 03:48:30 -0500
Test txn_scope_guard regression
r22753 at hlagh (orig r8426): ribasushi | 2010-01-26 04:10:11 -0500
Fix txn_begin on external non-AC coderef regression
r22757 at hlagh (orig r8430): ribasushi | 2010-01-26 08:19:50 -0500
r8304 at Thesaurus (orig r8292): nigel | 2010-01-13 16:05:48 +0100
Branch to extend ::Schema::Versioned to handle series of upgrades
r8320 at Thesaurus (orig r8308): nigel | 2010-01-14 16:52:50 +0100
Changes to support multiple step schema version updates
r8321 at Thesaurus (orig r8309): nigel | 2010-01-14 17:05:21 +0100
Changelog for Changes to support multiple step schema version updates
r8393 at Thesaurus (orig r8380): ribasushi | 2010-01-19 13:59:51 +0100
Botched merge (tests still fail)
r8395 at Thesaurus (orig r8382): ribasushi | 2010-01-19 17:37:07 +0100
More cleanup
r8396 at Thesaurus (orig r8383): ribasushi | 2010-01-19 17:48:09 +0100
Fix last pieces of retardation and UNtodo the quick cycle
r8442 at Thesaurus (orig r8429): ribasushi | 2010-01-26 14:18:53 +0100
No need for 2 statements to get the version
r22759 at hlagh (orig r8432): ribasushi | 2010-01-26 08:22:16 -0500
r8161 at Thesaurus (orig r8149): ovid | 2009-12-18 15:59:56 +0100
Prefetch queries make inefficient SQL when combined with a pager. This branch
is to try to isolate some of the join conditions and figure out if we can fix
this.
r8166 at Thesaurus (orig r8154): ovid | 2009-12-18 18:17:55 +0100
Refactor internals to expose some join logic. Awful method and args :(
r8319 at Thesaurus (orig r8307): ovid | 2010-01-14 15:37:35 +0100
Attempt to factor our alias handling has mostly failed.
r8330 at Thesaurus (orig r8318): ribasushi | 2010-01-15 03:02:21 +0100
Better refactor
r8332 at Thesaurus (orig r8320): ribasushi | 2010-01-15 03:14:39 +0100
Better varnames
r8347 at Thesaurus (orig r8335): ribasushi | 2010-01-17 11:33:55 +0100
More mangling
r8348 at Thesaurus (orig r8336): ribasushi | 2010-01-17 13:44:00 +0100
Getting warmer
r8349 at Thesaurus (orig r8337): ribasushi | 2010-01-17 14:00:20 +0100
That was tricky :)
r8352 at Thesaurus (orig r8340): ribasushi | 2010-01-17 15:57:06 +0100
Turned out to be much trickier
r8354 at Thesaurus (orig r8342): ribasushi | 2010-01-17 16:29:20 +0100
This is made out of awesome
r8355 at Thesaurus (orig r8343): ribasushi | 2010-01-17 16:46:02 +0100
Changes
r8400 at Thesaurus (orig r8387): ribasushi | 2010-01-20 08:17:44 +0100
Whoops - need to dsable quoting
r22773 at hlagh (orig r8446): ribasushi | 2010-01-27 05:56:15 -0500
Clean up some stuff
r22777 at hlagh (orig r8450): ribasushi | 2010-01-27 06:08:04 -0500
Merge some cleanups from the prefetch branch
r22780 at hlagh (orig r8453): ribasushi | 2010-01-27 06:33:33 -0500
DSNs can not be empty
r22880 at hlagh (orig r8458): frew | 2010-01-27 15:38:42 -0500
fix silly multipk bug
r22881 at hlagh (orig r8459): ribasushi | 2010-01-28 05:13:16 -0500
Consolidate insert_bulk guards (and make them show up correctly in the trace)
r22882 at hlagh (orig r8460): ribasushi | 2010-01-28 05:28:30 -0500
Fix bogus test DDL
r22889 at hlagh (orig r8467): ribasushi | 2010-01-28 16:11:59 -0500
r8381 at Thesaurus (orig r8368): moses | 2010-01-18 16:41:38 +0100
Test commit
r8425 at Thesaurus (orig r8412): ribasushi | 2010-01-22 11:25:01 +0100
Informix test + cleanups
r8428 at Thesaurus (orig r8415): ribasushi | 2010-01-22 11:59:25 +0100
Initial informix support
r22891 at hlagh (orig r8469): ribasushi | 2010-01-28 16:19:23 -0500
Informix changes
r22892 at hlagh (orig r8470): ribasushi | 2010-01-29 06:01:41 -0500
Require non-warning-spewing MooseX::Types
r22893 at hlagh (orig r8471): ribasushi | 2010-01-29 06:15:15 -0500
Enhance warning test a bit (seems to fail on 5.8)
r22894 at hlagh (orig r8472): ribasushi | 2010-01-29 07:00:54 -0500
Fugly 5.8 workaround
r22903 at hlagh (orig r8481): frew | 2010-01-31 00:47:42 -0500
cleanup (3 arg open, 1 grep instead of 3)
r22905 at hlagh (orig r8483): ribasushi | 2010-01-31 04:04:43 -0500
better skip message
r22919 at hlagh (orig r8497): caelum | 2010-02-01 06:07:13 -0500
throw exception on attempt to insert a blob with DBD::Oracle == 1.23
r22920 at hlagh (orig r8498): caelum | 2010-02-01 06:12:48 -0500
add RT link for Oracle blob bug in DBD::Oracle == 1.23
r22980 at hlagh (orig r8514): caelum | 2010-02-02 17:20:17 -0500
r22968 at hlagh (orig r8502): caelum | 2010-02-02 05:30:47 -0500
branch to support Sybase SQL Anywhere
r22971 at hlagh (orig r8505): caelum | 2010-02-02 07:21:13 -0500
ASA last_insert_id and limit support, still needs BLOB support
r22972 at hlagh (orig r8506): caelum | 2010-02-02 08:33:57 -0500
deref table name if needed, check all columns for identity column not just PK
r22973 at hlagh (orig r8507): caelum | 2010-02-02 08:48:11 -0500
test blobs, they work, didn't have to do anything
r22974 at hlagh (orig r8508): caelum | 2010-02-02 09:15:44 -0500
fix stupid identity bug, test empty insert (works), test DTs (not working yet)
r22976 at hlagh (orig r8510): caelum | 2010-02-02 14:31:00 -0500
rename ::Sybase::ASA to ::SQLAnywhere, per mst
r22978 at hlagh (orig r8512): caelum | 2010-02-02 17:02:29 -0500
DT inflation now works
r22979 at hlagh (orig r8513): caelum | 2010-02-02 17:18:06 -0500
minor POD update
r22981 at hlagh (orig r8515): caelum | 2010-02-02 17:23:26 -0500
r22895 at hlagh (orig r8473): caelum | 2010-01-30 03:57:26 -0500
branch to fix computed columns in Sybase ASE
r22911 at hlagh (orig r8489): caelum | 2010-01-31 07:18:33 -0500
empty insert into a Sybase table with computed columns and either data_type => undef or default_value => SCALARREF works now
r22912 at hlagh (orig r8490): caelum | 2010-01-31 07:39:32 -0500
add POD about computed columns and timestamps for Sybase
r22918 at hlagh (orig r8496): caelum | 2010-02-01 05:09:07 -0500
update POD about Schema::Loader for Sybase
r22984 at hlagh (orig r8518): ribasushi | 2010-02-02 17:57:27 -0500
r8512 at Thesaurus (orig r8499): boghead | 2010-02-01 23:38:13 +0100
- Creating a branch for adding _post_inflate_datetime and _pre_deflate_datetime to
InflateColumn::DateTime
r8513 at Thesaurus (orig r8500): boghead | 2010-02-01 23:42:14 +0100
- Add _post_inflate_datetime and _pre_deflate_datetime to InflateColumn::DateTime to allow
for modifying DateTime objects after inflation or before deflation.
r8524 at Thesaurus (orig r8511): boghead | 2010-02-02 22:59:28 +0100
- Simplify by allowing moving column_info depreciated {extra}{timezone} data to
{timezone} (and the same with locale)
r22986 at hlagh (orig r8520): caelum | 2010-02-02 23:19:59 -0500
support for Sybase SQL Anywhere through ODBC
r22989 at hlagh (orig r8523): ribasushi | 2010-02-03 02:27:54 -0500
Changes
r22990 at hlagh (orig r8524): ribasushi | 2010-02-03 02:31:20 -0500
Quote fail
r22991 at hlagh (orig r8525): caelum | 2010-02-03 07:21:37 -0500
test DT inflation for Sybase SQL Anywhere over ODBC too
r22992 at hlagh (orig r8526): caelum | 2010-02-03 11:36:39 -0500
minor code cleanup for SQL Anywhere last_insert_id
r23001 at hlagh (orig r8527): ribasushi | 2010-02-04 05:28:33 -0500
Fix bug reported by tommyt
r23009 at hlagh (orig r8535): ribasushi | 2010-02-04 08:34:45 -0500
Prepare for new SQLA release
r23021 at hlagh (orig r8547): ribasushi | 2010-02-05 02:59:04 -0500
Refactor some evil code
r23029 at hlagh (orig r8552): ribasushi | 2010-02-05 11:00:12 -0500
Looks like RSC is finally (halfway) fixed
r23030 at hlagh (orig r8553): ribasushi | 2010-02-05 11:07:13 -0500
RSC subquery can not include the prefetch
r23031 at hlagh (orig r8554): ribasushi | 2010-02-05 11:10:29 -0500
Fix typo and borked test
r23033 at hlagh (orig r8556): ribasushi | 2010-02-05 11:33:12 -0500
Release 0.08116
r23035 at hlagh (orig r8558): ribasushi | 2010-02-05 12:01:33 -0500
No idea how I missed all these fails...
r23036 at hlagh (orig r8559): ribasushi | 2010-02-05 12:13:34 -0500
Release 0.08117
r23038 at hlagh (orig r8561): ribasushi | 2010-02-05 12:51:12 -0500
Try to distinguish trunk from official versions
r23044 at hlagh (orig r8567): gshank | 2010-02-05 16:29:24 -0500
add doc on 'where' attribute
r23071 at hlagh (orig r8574): frew | 2010-02-07 15:07:03 -0500
add as_subselect_rs
r23072 at hlagh (orig r8575): frew | 2010-02-07 15:13:04 -0500
fix longstanding unmentioned bug ("me")
r23073 at hlagh (orig r8576): frew | 2010-02-08 00:17:43 -0500
another example of as_subselect_rs
r23074 at hlagh (orig r8577): frew | 2010-02-08 00:23:58 -0500
fix bug in UTF8Columns
r23075 at hlagh (orig r8578): ribasushi | 2010-02-08 03:31:01 -0500
Extend utf8columns test to trap fixed bug
r23076 at hlagh (orig r8579): ribasushi | 2010-02-08 06:03:23 -0500
Cleanup rel accessor type handling
r23077 at hlagh (orig r8580): ribasushi | 2010-02-08 06:20:47 -0500
Fix some fallout
r23079 at hlagh (orig r8582): ribasushi | 2010-02-08 06:38:19 -0500
Merge some obsolete code cleanup from the prefetch branch
r23080 at hlagh (orig r8583): ribasushi | 2010-02-08 06:42:09 -0500
Merge fix of RT54039 from prefetch branch
r23082 at hlagh (orig r8585): ribasushi | 2010-02-08 06:48:31 -0500
Release 0.08118
r23084 at hlagh (orig r8587): ribasushi | 2010-02-08 06:52:33 -0500
Bump trunk version
r23090 at hlagh (orig r8593): ribasushi | 2010-02-08 10:16:44 -0500
cheaper lookup
r23114 at hlagh (orig r8596): ribasushi | 2010-02-10 06:40:37 -0500
Consolidate last_insert_id handling with a fallback-attempt on DBI::last_insert_id
r23119 at hlagh (orig r8601): caelum | 2010-02-10 15:29:51 -0500
workaround for Moose bug affecting Replicated storage
r23120 at hlagh (orig r8602): caelum | 2010-02-10 15:40:07 -0500
revert Moose bug workaround, bump Moose dep for Replicated to 0.98
r23121 at hlagh (orig r8603): caelum | 2010-02-10 16:48:34 -0500
add a couple proxy methods to Replicated so it can run
Property changes on: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated
___________________________________________________________________
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/cookbook_fixes:7657
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/branches/resultsetcolumn_custom_columns:5160
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/branches/sqla_1.50_compat:5414
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/trunk:7982
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class:32260
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class-CDBICompat:54993
9c88509d-e914-0410-b01c-b9530614cbfe:/vendor/DBIx-Class:31122
ab17426e-7cd3-4704-a2a2-80b7c0a611bb:/local/dbic_column_attr:10946
ab17426e-7cd3-4704-a2a2-80b7c0a611bb:/local/dbic_trunk:11788
bd5ac9a7-f185-4d95-9186-dbb8b392a572:/local/os/bast/DBIx-Class/0.08/trunk:2798
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/_abandoned_but_possibly_useful/table_name_ref:7266
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/autocast:7418
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/belongs_to_null_col_fix:5244
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/cdbicompat_integration:4160
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/column_attr:5074
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/complex_join_rels:4589
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/connect_info_hash:7435
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/cookbook_fixes:7479
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/count_distinct:6218
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/count_rs:6741
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/diamond_relationships:6310
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/discard_changes_replication_fix:7252
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/file_column:3920
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/fix-update-and-delete-as_query:6162
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/grouped_has_many_join:7382
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/grouped_prefetch:6885
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/is_resultset_paginated:7769
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/joined_count:6323
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mc_fixes:6645
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_money_type:7096
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_storage_minor_refactor:7210
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_top_fixes:6971
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/multi_stuff:5565
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/multicreate_fixes:7275
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mysql_ansi:7175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mystery_join:6589
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/new_replication_transaction_fixup:7058
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_connect_call:6854
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle-tweaks:6222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle_sequence:4173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/order_by_refactor:6475
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/parser_fk_index:4485
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/pg_unqualified_schema:7566
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch:5699
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch_limit:6724
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch_redux:7206
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/reduce_pings:7261
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/replication_dedux:4600
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/rsrc_in_storage:6577
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/rt_bug_41083:5437
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/savepoints:4223
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/search_related_prefetch:6818
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sqla_1.50_compat:5321
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-ms-access:4142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-tweaks:6262
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/subclassed_rsset:5930
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/subquery:5617
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/syb_connected:6919
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase:7682
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_bulk_insert:7679
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_bulkinsert_support:7796
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_mssql:6125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_support:7797
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/table_name_ref:7132
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/top_limit_altfix:6429
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/type_aware_update:6619
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/unresolvable_prefetch:6949
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioned_enhancements:4125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioning:4578
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/views:5585
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/tags/0.08108_prerelease_please_do_not_pull_into_it:7008
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/tags/pre_0.08109_please_do_not_merge:7336
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-C3:318
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-current:2222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-joins:173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:570
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/datetime:1716
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_compat:1855
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/find_unique_query_fixes:2142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/inflate:1988
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/many_to_many:2025
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/re_refactor_bugfix:1944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/reorganize_tests:1827
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset-new-refactor:1766
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_2_electric_boogaloo:2175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/resultset_cleanup:2102
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class/sqlt_tests_refactor:2043
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/trunk/DBIx-Class:3606
fe160bb6-dc1c-0410-9f2b-d64a711b54a5:/local/DBIC-trunk-0.08:10510
+ 168d5346-440b-0410-b799-f706be625ff1:/DBIx-Class-current:2207
462d4d0c-b505-0410-bf8e-ce8f877b3390:/local/bast/DBIx-Class:3159
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/branches/cookbook_fixes:7657
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/branches/prefetch_bug-unqualified_column_in_search_related_cond:7959
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/branches/void_populate_resultset_cond:7935
4d5fae46-8e6a-4e08-abee-817e9fb894a2:/local/bast/DBIx-Class/0.08/trunk:7982
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class:32260
9c88509d-e914-0410-b01c-b9530614cbfe:/local/DBIx-Class-CDBICompat:54993
9c88509d-e914-0410-b01c-b9530614cbfe:/vendor/DBIx-Class:31122
ab17426e-7cd3-4704-a2a2-80b7c0a611bb:/local/dbic_column_attr:10946
ab17426e-7cd3-4704-a2a2-80b7c0a611bb:/local/dbic_trunk:11788
bd5ac9a7-f185-4d95-9186-dbb8b392a572:/local/os/bast/DBIx-Class/0.08/trunk:2798
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/_abandoned_but_possibly_useful/table_name_ref:7266
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/ado_mssql:7886
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/autocast:7418
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/belongs_to_null_col_fix:5244
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/cdbicompat_integration:4160
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/column_attr:5074
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/complex_join_rels:4589
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/connect_info_hash:7435
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/connected_schema_leak:8264
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/cookbook_fixes:7479
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/count_distinct:6218
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/count_rs:6741
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/create_scalarref_rt51559:8027
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/diamond_relationships:6310
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/discard_changes_replication_fix:7252
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/file_column:3920
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/fix-update-and-delete-as_query:6162
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/get_inflated_columns_rt46953:7964
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/grouped_has_many_join:7382
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/grouped_prefetch:6885
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/ic_dt_post_inflate:8517
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/informix:8434
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/is_resultset_paginated:7769
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/joined_count:6323
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mc_fixes:6645
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_limit_regression:8278
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_money_type:7096
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_rno_pagination:8054
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_storage_minor_refactor:7210
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mssql_top_fixes:6971
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/multi_stuff:5565
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/multicreate_fixes:7275
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/multiple_version_upgrade:8429
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mysql_ansi:7175
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/mystery_join:6589
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/new_replication_transaction_fixup:7058
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/no_duplicate_indexes_for_pk_cols:8373
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/normalize_connect_info:8274
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/null_column_regression:8314
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_connect_call:6854
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/on_disconnect_do:3694
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle-tweaks:6222
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle_sequence:4173
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/oracle_shorten_aliases:8234
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/order_by_refactor:6475
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/parser_fk_index:4485
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/pg_unqualified_schema:7842
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch:5699
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch-group_by:7917
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch_bug-unqualified_column_in_search_related_cond:7900
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch_limit:6724
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch_pager:8431
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/prefetch_redux:7206
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/reduce_pings:7261
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/replication_dedux:4600
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/rsrc_in_storage:6577
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/rt_bug_41083:5437
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/savepoints:4223
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/search_related_prefetch:6818
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sqla_1.50_compat:5321
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sqlt_parser_view:8145
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-ms-access:4142
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/storage-tweaks:6262
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/subclassed_rsset:5930
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/subquery:5617
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/syb_connected:6919
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase:7682
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_asa:8513
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_bulk_insert:7679
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_bulkinsert_support:7796
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_computed_columns:8496
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_mssql:6125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_refactor:7940
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/sybase_support:7797
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/table_name_ref:7132
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/top_limit_altfix:6429
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/type_aware_update:6619
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/unresolvable_prefetch:6949
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioned_enhancements:4125
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/versioning:4578
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/view_rels:7908
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/views:5585
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/branches/void_populate_resultset_cond:7944
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/tags/0.08108_prerelease_please_do_not_pull_into_it:7008
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/tags/pre_0.08109_please_do_not_merge:7336
bd8105ee-0ff8-0310-8827-fb3f25b6796d:/DBIx-Class/0.08/trunk:8603
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/handle_all_storage_methods_in_replicated/Changes
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/Changes 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/Changes 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,6 +1,78 @@
Revision history for DBIx::Class
+0.08118 2010-02-08 11:53:00 (UTC)
+ - Fix a bug causing UTF8 columns not to be decoded (RT#54395)
+ - Fix bug in One->Many->One prefetch-collapse handling (RT#54039)
+ - Cleanup handling of relationship accessor types
+0.08117 2010-02-05 17:10:00 (UTC)
+ - Perl 5.8.1 is now the minimum supported version
+ - Massive optimization of the join resolution code - now joins
+ will be removed from the resulting SQL if DBIC can prove they
+ are not referenced by anything
+ - Subqueries no longer marked experimental
+ - Support for Informix RDBMS (limit/offset and auto-inc columns)
+ - Support for Sybase SQLAnywhere, both native and via ODBC
+ - might_have/has_one now warn if applied calling class's column
+ has is_nullable set to true.
+ - Fixed regression in deploy() with a {sources} table limit applied
+ (RT#52812)
+ - Views without a view_definition will throw an exception when
+ parsed by SQL::Translator::Parser::DBIx::Class
+ - Stop the SQLT parser from auto-adding indexes identical to the
+ Primary Key
+ - InflateColumn::DateTime refactoring to allow fine grained method
+ overloads
+ - Fix ResultSetColumn improperly selecting more than the requested
+ column when +columns/+select is present
+ - Fix failure when update/delete of resultsets with complex WHERE
+ SQLA structures
+ - Fix regression in context sensitiveness of deployment_statements
+ - Fix regression resulting in overcomplicated query on
+ search_related from prefetching resultsets
+ - Fix regression on all-null returning searches (properly switch
+ LEFT JOIN to JOIN in order to distinguish between both cases)
+ - Fix regression in groupedresultset count() used on strict-mode
+ MySQL connections
+ - Better isolation of RNO-limited queries from the rest of a
+ prefetching resultset
+ - New MSSQL specific resultset attribute to allow hacky ordered
+ subquery support
+ - Fix nasty schema/dbhandle leak due to SQL::Translator
+ - Initial implementation of a mechanism for Schema::Version to
+ apply multiple step upgrades
+ - Fix regression on externally supplied $dbh with AutoCommit=0
+ - FAQ "Custom methods in Result classes"
+ - Cookbook POD fix for add_drop_table instead of add_drop_tables
+ - Schema POD improvement for dclone
+
+0.08115 2009-12-10 09:02:00 (CST)
+ - Real limit/offset support for MSSQL server (via Row_Number)
+ - Fix distinct => 1 with non-selecting order_by (the columns
+ in order_by also need to be aded to the resulting group_by)
+ - Do not attempt to deploy FK constraints pointing to a View
+ - Fix count/objects from search_related on limited resultset
+ - Stop propagating distinct => 1 over search_related chains
+ - Make sure populate() inherits the resultset conditions just
+ like create() does
+ - Make get_inflated_columns behave identically to get_columns
+ wrt +select/+as (RT#46953)
+ - Fix problems with scalarrefs under InflateColumn (RT#51559)
+ - Throw exception on delete/update of PK-less resultsets
+ - Refactored Sybase storage driver into a central ::DBI::Sybase
+ dispatcher, and a sybase-specific ::DBI::Sybase::ASE
+ - Fixed an atrocious DBD::ADO bind-value bug
+ - Cookbook/Intro POD improvements
+
+0.08114 2009-11-14 17:45:00 (UTC)
+ - Preliminary support for MSSQL via DBD::ADO
+ - Fix botched 0.08113 release (invalid tarball)
+
+0.08113 2009-11-13 23:13:00 (UTC)
+ - Fix populate with has_many bug
+ (RT #50828)
+ - Fix Oracle autoincrement broken for Resultsets with scalar refs
+ (RT #50874)
- Complete Sybase RDBMS support including:
- Support for TEXT/IMAGE columns
- Support for the 'money' datatype
@@ -13,6 +85,7 @@
- Support for interpolated variables with proper quoting when
connecting to an older Sybase and/or via FreeTDS
- bulk API support for populate()
+ - Transaction support for MSSQL via DBD::Sybase
- Add is_paged method to DBIx::Class::ResultSet so that we can
check that if we want a pager
- Skip versioning test on really old perls lacking Time::HiRes
@@ -20,6 +93,19 @@
- Fixed on_connect_do/call regression when used with a coderef
connector (RT #50003)
- A couple of fixes to Ordered to remedy subclassing issues
+ - Fixed another lingering problem with PostgreSQL
+ auto-increment support and its interaction with multiple
+ schemas
+ - Remove some IN workarounds, and require a recent version of
+ SQLA instead
+ - Improvements to populate's handling of mixed scalarref values
+ - Fixed regression losing result_class after $rs->find (introduced
+ in 0.08108)
+ - Fix in_storage() to return 1|0 as per existing documentation
+ - Centralize handling of _determine_driver calls prior to certain
+ ::Storage::DBI methods
+ - Fix update/delete arbitrary condition handling (RT#51409)
+ - POD improvements
0.08112 2009-09-21 10:57:00 (UTC)
- Remove the recommends from Makefile.PL, DBIx::Class is not
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/Makefile.PL
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/Makefile.PL 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/Makefile.PL 2010-02-10 22:41:54 UTC (rev 8606)
@@ -3,12 +3,12 @@
use warnings;
use POSIX ();
-use 5.006001; # delete this line if you want to send patches for earlier.
+use 5.008001;
# ****** DO NOT ADD OPTIONAL DEPENDENCIES. EVER. --mst ******
name 'DBIx-Class';
-perl_version '5.006001';
+perl_version '5.008001';
all_from 'lib/DBIx/Class.pm';
@@ -26,31 +26,27 @@
requires 'Scalar::Util' => '0';
requires 'Storable' => '0';
-# Perl 5.8.0 doesn't have utf8::is_utf8()
-requires 'Encode' => '0' if ($] <= 5.008000);
-
# Dependencies (keep in alphabetical order)
requires 'Carp::Clan' => '6.0';
-requires 'Class::Accessor::Grouped' => '0.09000';
+requires 'Class::Accessor::Grouped' => '0.09002';
requires 'Class::C3::Componentised' => '1.0005';
requires 'Class::Inspector' => '1.24';
requires 'Data::Page' => '2.00';
requires 'DBD::SQLite' => '1.25';
-requires 'DBI' => '1.605';
+requires 'DBI' => '1.609';
requires 'JSON::Any' => '1.18';
requires 'MRO::Compat' => '0.09';
requires 'Module::Find' => '0.06';
requires 'Path::Class' => '0.16';
requires 'Scope::Guard' => '0.03';
-requires 'SQL::Abstract' => '1.60';
+requires 'SQL::Abstract' => '1.61';
requires 'SQL::Abstract::Limit' => '0.13';
requires 'Sub::Name' => '0.04';
requires 'Data::Dumper::Concise' => '1.000';
my %replication_requires = (
- 'Moose', => '0.87',
- 'MooseX::AttributeHelpers' => '0.21',
- 'MooseX::Types', => '0.16',
+ 'Moose', => '0.90',
+ 'MooseX::Types', => '0.21',
'namespace::clean' => '0.11',
'Hash::Merge', => '0.11',
);
@@ -71,6 +67,12 @@
# when changing also adjust version in t/02pod.t
'Test::Pod' => '1.26',
+ # when changing also adjust version in t/06notabs.t
+# 'Test::NoTabs' => '0.9',
+
+ # when changing also adjust version in t/07eol.t
+# 'Test::EOL' => '0.6',
+
# when changing also adjust version in t/03podcoverage.t
'Test::Pod::Coverage' => '1.08',
'Pod::Coverage' => '0.20',
@@ -110,7 +112,7 @@
) : ()
,
- $ENV{DBICTEST_ORACLE_DSN}
+ $ENV{DBICTEST_ORA_DSN}
? (
'DateTime::Format::Oracle' => '0',
) : ()
@@ -121,6 +123,11 @@
'DateTime::Format::Sybase' => 0,
) : ()
,
+ grep $_, @ENV{qw/DBICTEST_SYBASE_ASA_DSN DBICTEST_SYBASE_ASA_ODBC_DSN/}
+ ? (
+ 'DateTime::Format::Strptime' => 0,
+ ) : ()
+ ,
);
#************************************************************************#
# Make ABSOLUTELY SURE that nothing on the list above is a real require, #
@@ -142,12 +149,15 @@
resources 'repository' => 'http://dev.catalyst.perl.org/repos/bast/DBIx-Class/';
resources 'MailingList' => 'http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class';
-no_index 'DBIx::Class::Storage::DBI::Sybase::Common';
-no_index 'DBIx::Class::SQLAHacks';
-no_index 'DBIx::Class::SQLAHacks::MSSQL';
-no_index 'DBIx::Class::Storage::DBI::AmbiguousGlob';
-no_index 'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server';
-no_index 'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars';
+# Deprecated/internal modules need no exposure
+no_index directory => $_ for (qw|
+ lib/DBIx/Class/SQLAHacks
+ lib/DBIx/Class/PK/Auto
+|);
+no_index package => $_ for (qw/
+ DBIx::Class::Storage::DBI::AmbiguousGlob
+ DBIx::Class::SQLAHacks DBIx::Class::Storage::DBIHacks
+/);
# re-build README and require extra modules for testing if we're in a checkout
@@ -186,7 +196,7 @@
# Re-write META.yml to _exclude_ all forced requires (we do not want to ship this)
if ($Module::Install::AUTHOR) {
- Meta->{values}{build_requires} = [ grep
+ Meta->{values}{build_requires} = [ grep
{ not exists $force_requires_if_author{$_->[0]} }
( @{Meta->{values}{build_requires}} )
];
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/examples/Schema/MyDatabase/Main/Result/Artist.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/examples/Schema/MyDatabase/Main/Result/Artist.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/examples/Schema/MyDatabase/Main/Result/Artist.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,9 +1,16 @@
package MyDatabase::Main::Result::Artist;
-use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/PK::Auto Core/);
+
+use warnings;
+use strict;
+
+use base qw/DBIx::Class::Core/;
+
__PACKAGE__->table('artist');
+
__PACKAGE__->add_columns(qw/ artistid name /);
+
__PACKAGE__->set_primary_key('artistid');
+
__PACKAGE__->has_many('cds' => 'MyDatabase::Main::Result::Cd');
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/examples/Schema/MyDatabase/Main/Result/Cd.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/examples/Schema/MyDatabase/Main/Result/Cd.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/examples/Schema/MyDatabase/Main/Result/Cd.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,9 +1,16 @@
package MyDatabase::Main::Result::Cd;
-use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/PK::Auto Core/);
+
+use warnings;
+use strict;
+
+use base qw/DBIx::Class::Core/;
+
__PACKAGE__->table('cd');
+
__PACKAGE__->add_columns(qw/ cdid artist title/);
+
__PACKAGE__->set_primary_key('cdid');
+
__PACKAGE__->belongs_to('artist' => 'MyDatabase::Main::Result::Artist');
__PACKAGE__->has_many('tracks' => 'MyDatabase::Main::Result::Track');
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/examples/Schema/MyDatabase/Main/Result/Track.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/examples/Schema/MyDatabase/Main/Result/Track.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/examples/Schema/MyDatabase/Main/Result/Track.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,9 +1,16 @@
package MyDatabase::Main::Result::Track;
-use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/PK::Auto Core/);
+
+use warnings;
+use strict;
+
+use base qw/DBIx::Class::Core/;
+
__PACKAGE__->table('track');
+
__PACKAGE__->add_columns(qw/ trackid cd title/);
+
__PACKAGE__->set_primary_key('trackid');
+
__PACKAGE__->belongs_to('cd' => 'MyDatabase::Main::Result::Cd');
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/AccessorGroup.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/AccessorGroup.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/AccessorGroup.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -17,8 +17,6 @@
This class now exists in its own right on CPAN as Class::Accessor::Grouped
-1;
-
=head1 AUTHORS
Matt S. Trout <mst at shadowcatsystems.co.uk>
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/CDBICompat/Constructor.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/CDBICompat/Constructor.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/CDBICompat/Constructor.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -3,6 +3,8 @@
use base qw(DBIx::Class::CDBICompat::ImaDBI);
+use Sub::Name();
+
use strict;
use warnings;
@@ -22,7 +24,7 @@
return carp("$method already exists in $class")
if *$meth{CODE};
- *$meth = sub {
+ *$meth = Sub::Name::subname $meth => sub {
my $self = shift;
$self->sth_to_objects($self->sql_Retrieve($fragment), \@_);
};
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Componentised.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Componentised.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Componentised.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -4,10 +4,40 @@
use strict;
use warnings;
-###
-# Keep this class for backwards compatibility
-###
-
use base 'Class::C3::Componentised';
+use Carp::Clan qw/^DBIx::Class|^Class::C3::Componentised/;
+use mro 'c3';
+# this warns of subtle bugs introduced by UTF8Columns hacky handling of store_column
+sub inject_base {
+ my $class = shift;
+ my $target = shift;
+
+ my @present_components = (@{mro::get_linear_isa ($target)||[]});
+
+ no strict 'refs';
+ for my $comp (reverse @_) {
+
+ if ($comp->isa ('DBIx::Class::UTF8Columns') ) {
+ require B;
+ my @broken;
+
+ for (@present_components) {
+ my $cref = $_->can ('store_column')
+ or next;
+ push @broken, $_ if B::svref_2object($cref)->STASH->NAME ne 'DBIx::Class::Row';
+ }
+
+ carp "Incorrect loading order of $comp by ${target} will affect other components overriding store_column ("
+ . join (', ', @broken)
+ .'). Refer to the documentation of DBIx::Class::UTF8Columns for more info'
+ if @broken;
+ }
+
+ unshift @present_components, $comp;
+ }
+
+ $class->next::method($target, @_);
+}
+
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Core.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Core.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Core.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -2,7 +2,6 @@
use strict;
use warnings;
-no warnings 'qw';
use base qw/DBIx::Class/;
@@ -12,7 +11,8 @@
PK::Auto
PK
Row
- ResultSourceProxy::Table/);
+ ResultSourceProxy::Table
+/);
1;
@@ -22,8 +22,8 @@
=head1 SYNOPSIS
- # In your table classes
- __PACKAGE__->load_components(qw/Core/);
+ # In your result (table) classes
+ use base 'DBIx::Class::Core';
=head1 DESCRIPTION
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/InflateColumn/DateTime.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/InflateColumn/DateTime.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/InflateColumn/DateTime.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -15,15 +15,14 @@
columns to be of the datetime, timestamp or date datatype.
package Event;
- __PACKAGE__->load_components(qw/InflateColumn::DateTime Core/);
+ use base 'DBIx::Class::Core';
+
+ __PACKAGE__->load_components(qw/InflateColumn::DateTime/);
__PACKAGE__->add_columns(
starts_when => { data_type => 'datetime' }
create_date => { data_type => 'date' }
);
-NOTE: You B<must> load C<InflateColumn::DateTime> B<before> C<Core>. See
-L<DBIx::Class::Manual::Component> for details.
-
Then you can treat the specified column as a L<DateTime> object.
print "This event starts the month of ".
@@ -137,23 +136,18 @@
}
}
- my $timezone;
if ( defined $info->{extra}{timezone} ) {
carp "Putting timezone into extra => { timezone => '...' } has been deprecated, ".
"please put it directly into the '$column' column definition.";
- $timezone = $info->{extra}{timezone};
+ $info->{timezone} = $info->{extra}{timezone} unless defined $info->{timezone};
}
- my $locale;
if ( defined $info->{extra}{locale} ) {
carp "Putting locale into extra => { locale => '...' } has been deprecated, ".
"please put it directly into the '$column' column definition.";
- $locale = $info->{extra}{locale};
+ $info->{locale} = $info->{extra}{locale} unless defined $info->{locale};
}
- $locale = $info->{locale} if defined $info->{locale};
- $timezone = $info->{timezone} if defined $info->{timezone};
-
my $undef_if_invalid = $info->{datetime_undef_if_invalid};
if ($type eq 'datetime' || $type eq 'date' || $type eq 'timestamp') {
@@ -179,21 +173,12 @@
$self->throw_exception ("Error while inflating ${value} for ${column} on ${self}: $err");
}
- $dt->set_time_zone($timezone) if $timezone;
- $dt->set_locale($locale) if $locale;
- return $dt;
+ return $obj->_post_inflate_datetime( $dt, \%info );
},
deflate => sub {
my ($value, $obj) = @_;
- if ($timezone) {
- carp "You're using a floating timezone, please see the documentation of"
- . " DBIx::Class::InflateColumn::DateTime for an explanation"
- if ref( $value->time_zone ) eq 'DateTime::TimeZone::Floating'
- and not $info{floating_tz_ok}
- and not $ENV{DBIC_FLOATING_TZ_OK};
- $value->set_time_zone($timezone);
- $value->set_locale($locale) if $locale;
- }
+
+ $value = $obj->_pre_deflate_datetime( $value, \%info );
$obj->_deflate_from_datetime( $value, \%info );
},
}
@@ -225,6 +210,33 @@
shift->result_source->storage->datetime_parser (@_);
}
+sub _post_inflate_datetime {
+ my( $self, $dt, $info ) = @_;
+
+ $dt->set_time_zone($info->{timezone}) if defined $info->{timezone};
+ $dt->set_locale($info->{locale}) if defined $info->{locale};
+
+ return $dt;
+}
+
+sub _pre_deflate_datetime {
+ my( $self, $dt, $info ) = @_;
+
+ if (defined $info->{timezone}) {
+ carp "You're using a floating timezone, please see the documentation of"
+ . " DBIx::Class::InflateColumn::DateTime for an explanation"
+ if ref( $dt->time_zone ) eq 'DateTime::TimeZone::Floating'
+ and not $info->{floating_tz_ok}
+ and not $ENV{DBIC_FLOATING_TZ_OK};
+
+ $dt->set_time_zone($info->{timezone});
+ }
+
+ $dt->set_locale($info->{locale}) if defined $info->{locale};
+
+ return $dt;
+}
+
1;
__END__
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/InflateColumn/File.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/InflateColumn/File.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/InflateColumn/File.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -113,8 +113,10 @@
In your L<DBIx::Class> table class:
- __PACKAGE__->load_components( "PK::Auto", "InflateColumn::File", "Core" );
+ use base 'DBIx::Class::Core';
+ __PACKAGE__->load_components(qw/InflateColumn::File/);
+
# define your columns
__PACKAGE__->add_columns(
"id",
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/InflateColumn.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/InflateColumn.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/InflateColumn.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -79,7 +79,8 @@
$self->throw_exception("inflate_column needs attr hashref")
unless ref $attrs eq 'HASH';
$self->column_info($col)->{_inflate_info} = $attrs;
- $self->mk_group_accessors('inflated_column' => [$self->column_info($col)->{accessor} || $col, $col]);
+ my $acc = $self->column_info($col)->{accessor};
+ $self->mk_group_accessors('inflated_column' => [ (defined $acc ? $acc : $col), $col]);
return 1;
}
@@ -124,8 +125,11 @@
unless exists $self->column_info($col)->{_inflate_info};
return $self->{_inflated_column}{$col}
if exists $self->{_inflated_column}{$col};
- return $self->{_inflated_column}{$col} =
- $self->_inflated_column($col, $self->get_column($col));
+
+ my $val = $self->get_column($col);
+ return $val if ref $val eq 'SCALAR'; #that would be a not-yet-reloaded sclarref update
+
+ return $self->{_inflated_column}{$col} = $self->_inflated_column($col, $val);
}
=head2 set_inflated_column
@@ -175,7 +179,7 @@
=over 4
=item L<DBIx::Class::Core> - This component is loaded as part of the
- "core" L<DBIx::Class> components; generally there is no need to
+ C<core> L<DBIx::Class> components; generally there is no need to
load it directly
=back
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Component.pod
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Component.pod 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Component.pod 2010-02-10 22:41:54 UTC (rev 8606)
@@ -12,31 +12,29 @@
=head1 USING
-Components are loaded using the load_components() method within your
+Components are loaded using the load_components() method within your
DBIx::Class classes.
package My::Thing;
- use base qw( DBIx::Class );
- __PACKAGE__->load_components(qw/ PK::Auto Core /);
+ use base qw( DBIx::Class::Core );
+ __PACKAGE__->load_components(qw/InflateColumn::DateTime TimeStamp/);
-Generally you do not want to specify the full package name
-of a component, instead take off the DBIx::Class:: part of
-it and just include the rest. If you do want to load a
-component outside of the normal namespace you can do so
+Generally you do not want to specify the full package name
+of a component, instead take off the DBIx::Class:: part of
+it and just include the rest. If you do want to load a
+component outside of the normal namespace you can do so
by prepending the component name with a +.
__PACKAGE__->load_components(qw/ +My::Component /);
-Once a component is loaded all of it's methods, or otherwise,
+Once a component is loaded all of it's methods, or otherwise,
that it provides will be available in your class.
-The order in which is you load the components may be
-very important, depending on the component. The general
-rule of thumb is to first load extra components and then
-load core ones last. If you are not sure, then read the
-docs for the components you are using and see if they
-mention anything about the order in which you should load
-them.
+The order in which is you load the components may be very
+important, depending on the component. If you are not sure,
+then read the docs for the components you are using and see
+if they mention anything about the order in which you should
+load them.
=head1 CREATING COMPONENTS
@@ -47,11 +45,11 @@
# Create methods, accessors, load other components, etc.
1;
-When a component is loaded it is included in the calling
-class' inheritance chain using L<Class::C3>. As well as
-providing custom utility methods, a component may also
-override methods provided by other core components, like
-L<DBIx::Class::Row> and others. For example, you
+When a component is loaded it is included in the calling
+class' inheritance chain using L<Class::C3>. As well as
+providing custom utility methods, a component may also
+override methods provided by other core components, like
+L<DBIx::Class::Row> and others. For example, you
could override the insert and delete methods.
sub insert {
@@ -108,22 +106,22 @@
=head2 Experimental
-These components are under development, there interfaces may
-change, they may not work, etc. So, use them if you want, but
+These components are under development, there interfaces may
+change, they may not work, etc. So, use them if you want, but
be warned.
L<DBIx::Class::Validation> - Validate all data before submitting to your database.
=head2 Core
-These are the components that all, or nearly all, people will use
-without even knowing it. These components provide most of
+These are the components that all, or nearly all, people will use
+without even knowing it. These components provide most of
DBIx::Class' functionality.
-L<DBIx::Class::AccessorGroup> - Lets you build groups of accessors.
-
L<DBIx::Class::Core> - Loads various components that "most people" would want.
+L<DBIx::Class::AccessorGroup> - Lets you build groups of accessors.
+
L<DBIx::Class::DB> - Non-recommended classdata schema component.
L<DBIx::Class::InflateColumn> - Automatically create objects from column data.
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Cookbook.pod
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Cookbook.pod 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Cookbook.pod 2010-02-10 22:41:54 UTC (rev 8606)
@@ -113,9 +113,8 @@
package My::Schema::Result::UserFriendsComplex;
use strict;
use warnings;
- use base qw/DBIx::Class/;
+ use base qw/DBIx::Class::Core/;
- __PACKAGE__->load_components('Core');
__PACKAGE__->table_class('DBIx::Class::ResultSource::View');
# ->table, ->add_columns, etc.
@@ -318,7 +317,7 @@
are in any way unsure about the use of the attributes above (C< join
>, C< select >, C< as > and C< group_by >).
-=head2 Subqueries (EXPERIMENTAL)
+=head2 Subqueries
You can write subqueries relatively easily in DBIC.
@@ -366,10 +365,6 @@
WHERE artist_id = me.artist_id
)
-=head3 EXPERIMENTAL
-
-Please note that subqueries are considered an experimental feature.
-
=head2 Predefined searches
You can write your own L<DBIx::Class::ResultSet> class by inheriting from it
@@ -391,11 +386,16 @@
1;
-To use your resultset, first tell DBIx::Class to create an instance of it
-for you, in your My::DBIC::Schema::CD class:
+If you're using L<DBIx::Class::Schema/load_namespaces>, simply place the file
+into the C<ResultSet> directory next to your C<Result> directory, and it will
+be automatically loaded.
+If however you are still using L<DBIx::Class::Schema/load_classes>, first tell
+DBIx::Class to create an instance of the ResultSet class for you, in your
+My::DBIC::Schema::CD class:
+
# class definition as normal
- __PACKAGE__->load_components(qw/ Core /);
+ use base 'DBIx::Class::Core';
__PACKAGE__->table('cd');
# tell DBIC to use the custom ResultSet class
@@ -842,13 +842,11 @@
use strict;
use warnings;
- use base qw/DBIx::Class/;
+ use base qw/DBIx::Class::Core/;
### Define what our admin class is, for ensure_class_loaded()
my $admin_class = __PACKAGE__ . '::Admin';
- __PACKAGE__->load_components(qw/Core/);
-
__PACKAGE__->table('users');
__PACKAGE__->add_columns(qw/user_id email password
@@ -1090,8 +1088,7 @@
This is straightforward using L<ManyToMany|DBIx::Class::Relationship/many_to_many>:
package My::User;
- use base 'DBIx::Class';
- __PACKAGE__->load_components('Core');
+ use base 'DBIx::Class::Core';
__PACKAGE__->table('user');
__PACKAGE__->add_columns(qw/id name/);
__PACKAGE__->set_primary_key('id');
@@ -1099,8 +1096,7 @@
__PACKAGE__->many_to_many('addresses' => 'user_address', 'address');
package My::UserAddress;
- use base 'DBIx::Class';
- __PACKAGE__->load_components('Core');
+ use base 'DBIx::Class::Core';
__PACKAGE__->table('user_address');
__PACKAGE__->add_columns(qw/user address/);
__PACKAGE__->set_primary_key(qw/user address/);
@@ -1108,8 +1104,7 @@
__PACKAGE__->belongs_to('address' => 'My::Address');
package My::Address;
- use base 'DBIx::Class';
- __PACKAGE__->load_components('Core');
+ use base 'DBIx::Class::Core';
__PACKAGE__->table('address');
__PACKAGE__->add_columns(qw/id street town area_code country/);
__PACKAGE__->set_primary_key('id');
@@ -1140,8 +1135,7 @@
declaration, like so...
package MyDatabase::Main::Artist;
- use base qw/DBIx::Class/;
- __PACKAGE__->load_components(qw/PK::Auto Core/);
+ use base qw/DBIx::Class::Core/;
__PACKAGE__->table('database1.artist'); # will use "database1.artist" in FROM clause
@@ -1257,10 +1251,102 @@
Nested transactions will work as expected. That is, only the outermost
transaction will actually issue a commit to the $dbh, and a rollback
at any level of any transaction will cause the entire nested
-transaction to fail. Support for savepoints and for true nested
-transactions (for databases that support them) will hopefully be added
-in the future.
+transaction to fail.
+
+=head2 Nested transactions and auto-savepoints
+If savepoints are supported by your RDBMS, it is possible to achieve true
+nested transactions with minimal effort. To enable auto-savepoints via nested
+transactions, supply the C<< auto_savepoint = 1 >> connection attribute.
+
+Here is an example of true nested transactions. In the example, we start a big
+task which will create several rows. Generation of data for each row is a
+fragile operation and might fail. If we fail creating something, depending on
+the type of failure, we want to abort the whole task, or only skip the failed
+row.
+
+ my $schema = MySchema->connect("dbi:Pg:dbname=my_db");
+
+ # Start a transaction. Every database change from here on will only be
+ # commited into the database if the eval block succeeds.
+ eval {
+ $schema->txn_do(sub {
+ # SQL: BEGIN WORK;
+
+ my $job = $schema->resultset('Job')->create({ name=> 'big job' });
+ # SQL: INSERT INTO job ( name) VALUES ( 'big job' );
+
+ for (1..10) {
+
+ # Start a nested transaction, which in fact sets a savepoint.
+ eval {
+ $schema->txn_do(sub {
+ # SQL: SAVEPOINT savepoint_0;
+
+ my $thing = $schema->resultset('Thing')->create({ job=>$job->id });
+ # SQL: INSERT INTO thing ( job) VALUES ( 1 );
+
+ if (rand > 0.8) {
+ # This will generate an error, thus setting $@
+
+ $thing->update({force_fail=>'foo'});
+ # SQL: UPDATE thing SET force_fail = 'foo'
+ # WHERE ( id = 42 );
+ }
+ });
+ };
+ if ($@) {
+ # SQL: ROLLBACK TO SAVEPOINT savepoint_0;
+
+ # There was an error while creating a $thing. Depending on the error
+ # we want to abort the whole transaction, or only rollback the
+ # changes related to the creation of this $thing
+
+ # Abort the whole job
+ if ($@ =~ /horrible_problem/) {
+ print "something horrible happend, aborting job!";
+ die $@; # rethrow error
+ }
+
+ # Ignore this $thing, report the error, and continue with the
+ # next $thing
+ print "Cannot create thing: $@";
+ }
+ # There was no error, so save all changes since the last
+ # savepoint.
+
+ # SQL: RELEASE SAVEPOINT savepoint_0;
+ }
+ });
+ };
+ if ($@) {
+ # There was an error while handling the $job. Rollback all changes
+ # since the transaction started, including the already commited
+ # ('released') savepoints. There will be neither a new $job nor any
+ # $thing entry in the database.
+
+ # SQL: ROLLBACK;
+
+ print "ERROR: $@\n";
+ }
+ else {
+ # There was no error while handling the $job. Commit all changes.
+ # Only now other connections can see the newly created $job and
+ # @things.
+
+ # SQL: COMMIT;
+
+ print "Ok\n";
+ }
+
+In this example it might be hard to see where the rollbacks, releases and
+commits are happening, but it works just the same as for plain L<<txn_do>>: If
+the C<eval>-block around C<txn_do> fails, a rollback is issued. If the C<eval>
+succeeds, the transaction is committed (or the savepoint released).
+
+While you can get more fine-grained controll using C<svp_begin>, C<svp_release>
+and C<svp_rollback>, it is strongly recommended to use C<txn_do> with coderefs.
+
=head1 SQL
=head2 Creating Schemas From An Existing Database
@@ -1296,7 +1382,7 @@
To create a new database using the schema:
my $schema = My::Schema->connect($dsn);
- $schema->deploy({ add_drop_tables => 1});
+ $schema->deploy({ add_drop_table => 1});
To import created .sql files using the mysql client:
@@ -1334,8 +1420,7 @@
package MyAppDB::Dual;
use strict;
use warnings;
- use base 'DBIx::Class';
- __PACKAGE__->load_components("Core");
+ use base 'DBIx::Class::Core';
__PACKAGE__->table("Dual");
__PACKAGE__->add_columns(
"dummy",
@@ -1920,15 +2005,15 @@
Typically L<DBIx::Class> result classes start off with
- use base qw/DBIx::Class/;
- __PACKAGE__->load_components(qw/InflateColumn::DateTime Core/);
+ use base qw/DBIx::Class::Core/;
+ __PACKAGE__->load_components(qw/InflateColumn::DateTime/);
If this preamble is moved into a common base class:-
package MyDBICbase;
- use base qw/DBIx::Class/;
- __PACKAGE__->load_components(qw/InflateColumn::DateTime Core/);
+ use base qw/DBIx::Class::Core/;
+ __PACKAGE__->load_components(qw/InflateColumn::DateTime/);
1;
and each result class then uses this as a base:-
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Example.pod
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Example.pod 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Example.pod 2010-02-10 22:41:54 UTC (rev 8606)
@@ -89,8 +89,7 @@
MyDatabase/Main/Result/Artist.pm:
package MyDatabase::Main::Result::Artist;
- use base qw/DBIx::Class/;
- __PACKAGE__->load_components(qw/Core/);
+ use base qw/DBIx::Class::Core/;
__PACKAGE__->table('artist');
__PACKAGE__->add_columns(qw/ artistid name /);
__PACKAGE__->set_primary_key('artistid');
@@ -102,8 +101,8 @@
MyDatabase/Main/Result/Cd.pm:
package MyDatabase::Main::Result::Cd;
- use base qw/DBIx::Class/;
- __PACKAGE__->load_components(qw/Core/);
+ use base qw/DBIx::Class::Core/;
+ __PACKAGE__->load_components(qw/InflateColumn::DateTime/);
__PACKAGE__->table('cd');
__PACKAGE__->add_columns(qw/ cdid artist title/);
__PACKAGE__->set_primary_key('cdid');
@@ -116,10 +115,9 @@
MyDatabase/Main/Result/Track.pm:
package MyDatabase::Main::Result::Track;
- use base qw/DBIx::Class/;
- __PACKAGE__->load_components(qw/Core/);
+ use base qw/DBIx::Class::Core/;
__PACKAGE__->table('track');
- __PACKAGE__->add_columns(qw/ trackid cd title/);
+ __PACKAGE__->add_columns(qw/ trackid cd title /);
__PACKAGE__->set_primary_key('trackid');
__PACKAGE__->belongs_to('cd' => 'MyDatabase::Main::Result::Cd');
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/FAQ.pod
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/FAQ.pod 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/FAQ.pod 2010-02-10 22:41:54 UTC (rev 8606)
@@ -371,6 +371,9 @@
=item .. insert many rows of data efficiently?
+The C<populate> method in L<DBIx::Class::ResultSet> provides
+efficient bulk inserts.
+
=item .. update a collection of rows at the same time?
Create a resultset using a search, to filter the rows of data you
@@ -430,6 +433,38 @@
=back
+=head2 Custom methods in Result classes
+
+You can add custom methods that do arbitrary things, even to unrelated tables.
+For example, to provide a C<< $book->foo() >> method which searches the
+cd table, you'd could add this to Book.pm:
+
+ sub foo {
+ my ($self, $col_data) = @_;
+ return $self->result_source->schema->resultset('cd')->search($col_data);
+ }
+
+And invoke that on any Book Result object like so:
+
+ my $rs = $book->foo({ title => 'Down to Earth' });
+
+When two tables ARE related, L<DBIx::Class::Relationship::Base> provides many
+methods to find or create data in related tables for you. But if you want to
+write your own methods, you can.
+
+For example, to provide a C<< $book->foo() >> method to manually implement
+what create_related() from L<DBIx::Class::Relationship::Base> does, you could
+add this to Book.pm:
+
+ sub foo {
+ my ($self, $relname, $col_data) = @_;
+ return $self->related_resultset($relname)->create($col_data);
+ }
+
+Invoked like this:
+
+ my $author = $book->foo('author', { name => 'Fred' });
+
=head2 Misc
=over 4
@@ -517,6 +552,65 @@
using the tips in L<DBIx::Class::Manual::Cookbook/"Skip row object creation for faster results">
and L<DBIx::Class::Manual::Cookbook/"Get raw data for blindingly fast results">
+=item How do I override a run time method (e.g. a relationship accessor)?
+
+If you need access to the original accessor, then you must "wrap around" the original method.
+You can do that either with L<Moose::Manual::MethodModifiers> or L<Class::Method::Modifiers>.
+The code example works for both modules:
+
+ package Your::Schema::Group;
+ use Class::Method::Modifiers;
+
+ # ... declare columns ...
+
+ __PACKAGE__->has_many('group_servers', 'Your::Schema::GroupServer', 'group_id');
+ __PACKAGE__->many_to_many('servers', 'group_servers', 'server');
+
+ # if the server group is a "super group", then return all servers
+ # otherwise return only servers that belongs to the given group
+ around 'servers' => sub {
+ my $orig = shift;
+ my $self = shift;
+
+ return $self->$orig(@_) unless $self->is_super_group;
+ return $self->result_source->schema->resultset('Server')->all;
+ };
+
+If you just want to override the original method, and don't care about the data
+from the original accessor, then you have two options. Either use
+L<Method::Signatures::Simple> that does most of the work for you, or do
+it the "dirty way".
+
+L<Method::Signatures::Simple> way:
+
+ package Your::Schema::Group;
+ use Method::Signatures::Simple;
+
+ # ... declare columns ...
+
+ __PACKAGE__->has_many('group_servers', 'Your::Schema::GroupServer', 'group_id');
+ __PACKAGE__->many_to_many('servers', 'group_servers', 'server');
+
+ # The method keyword automatically injects the annoying my $self = shift; for you.
+ method servers {
+ return $self->result_source->schema->resultset('Server')->search({ ... });
+ }
+
+The dirty way:
+
+ package Your::Schema::Group;
+ use Sub::Name;
+
+ # ... declare columns ...
+
+ __PACKAGE__->has_many('group_servers', 'Your::Schema::GroupServer', 'group_id');
+ __PACKAGE__->many_to_many('servers', 'group_servers', 'server');
+
+ *servers = subname servers => sub {
+ my $self = shift;
+ return $self->result_source->schema->resultset('Server')->search({ ... });
+ };
+
=back
=head2 Notes for CDBI users
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Intro.pod
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Intro.pod 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Intro.pod 2010-02-10 22:41:54 UTC (rev 8606)
@@ -105,13 +105,14 @@
Next, create each of the classes you want to load as specified above:
package My::Schema::Result::Album;
- use base qw/DBIx::Class/;
+ use base qw/DBIx::Class::Core/;
-Load any components required by each class with the load_components() method.
-This should consist of "Core" plus any additional components you want to use.
-For example, if you want to force columns to use UTF-8 encoding:
+Load any additional components you may need with the load_components() method,
+and provide component configuration if required. For example, if you want
+automatic row ordering:
- __PACKAGE__->load_components(qw/ ForceUTF8 Core /);
+ __PACKAGE__->load_components(qw/ Ordered /);
+ __PACKAGE__->position_column('rank');
Set the table for your class:
@@ -119,7 +120,7 @@
Add columns to your class:
- __PACKAGE__->add_columns(qw/ albumid artist title /);
+ __PACKAGE__->add_columns(qw/ albumid artist title rank /);
Each column can also be set up with its own accessor, data_type and other pieces
of information that it may be useful to have -- just pass C<add_columns> a hash:
@@ -145,13 +146,20 @@
is_nullable => 0,
is_auto_increment => 0,
default_value => '',
+ },
+ rank =>
+ { data_type => 'integer',
+ size => 16,
+ is_nullable => 0,
+ is_auto_increment => 0,
+ default_value => '',
}
);
DBIx::Class doesn't directly use most of this data yet, but various related
modules such as L<DBIx::Class::WebForm> make use of it. Also it allows you to
create your database tables from your Schema, instead of the other way around.
-See L<SQL::Translator> for details.
+See L<DBIx::Class::Schema/deploy> for details.
See L<DBIx::Class::ResultSource> for more details of the possible column
attributes.
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Joining.pod
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Joining.pod 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Joining.pod 2010-02-10 22:41:54 UTC (rev 8606)
@@ -17,7 +17,7 @@
But I'll explain anyway. Assuming you have created your database in a
more or less sensible way, you will end up with several tables that
contain C<related> information. For example, you may have a table
-containing information about C<CDs>, containing the CD title and it's
+containing information about C<CD>s, containing the CD title and it's
year of publication, and another table containing all the C<Track>s
for the CDs, one track per row.
@@ -34,7 +34,8 @@
So, joins are a way of extending simple select statements to include
fields from other, related, tables. There are various types of joins,
depending on which combination of the data you wish to retrieve, see
-MySQL's doc on JOINs: L<http://dev.mysql.com/doc/refman/5.0/en/join.html>.
+MySQL's doc on JOINs:
+L<http://dev.mysql.com/doc/refman/5.0/en/join.html>.
=head1 DEFINING JOINS AND RELATIONSHIPS
@@ -42,7 +43,7 @@
be defined in the L<ResultSource|DBIx::Class::Manual::Glossary/ResultSource> for the
table. If the relationship needs to be accessed in both directions
(i.e. Fetch all tracks of a CD, and fetch the CD data for a Track),
-then it needs to be defined in both tables.
+then it needs to be defined for both tables.
For the CDs/Tracks example, that means writing, in C<MySchema::CD>:
@@ -68,14 +69,15 @@
When performing either a L<search|DBIx::Class::ResultSet/search> or a
L<find|DBIx::Class::ResultSet/find> operation, you can specify which
-C<relations> to also fetch data from (or sort by), using the
+C<relations> to also refine your results based on, using the
L<join|DBIx::Class::ResultSet/join> attribute, like this:
$schema->resultset('CD')->search(
- { 'Title' => 'Funky CD' },
+ { 'Title' => 'Funky CD',
+ 'tracks.Name' => { like => 'T%' }
+ },
{ join => 'tracks',
- '+select' => [ 'tracks.Name', 'tracks.Artist' ],
- '+as' => [ 'TrackName', 'ArtistName' ]
+ order_by => ['tracks.id'],
}
);
@@ -84,18 +86,125 @@
L<DBIx::Class::ResultSet/ATTRIBUTES>, but here's a quick break down:
The first argument to search is a hashref of the WHERE attributes, in
-this case a simple restriction on the Title column. The second
-argument is a hashref of attributes to the search, '+select' adds
-extra columns to the select (from the joined table(s) or from
-calculations), and '+as' gives aliases to those fields.
+this case a restriction on the Title column in the CD table, and a
+restriction on the name of the track in the Tracks table, but ONLY for
+tracks actually related to the chosen CD(s). The second argument is a
+hashref of attributes to the search, the results will be returned
+sorted by the C<id> of the related tracks.
-'join' specifies which C<relationships> to include in the query. The
-distinction between C<relationships> and C<tables> is important here,
-only the C<relationship> names are valid.
+The special 'join' attribute specifies which C<relationships> to
+include in the query. The distinction between C<relationships> and
+C<tables> is important here, only the C<relationship> names are valid.
-This example should magically produce SQL like the second select in
-L</WHAT ARE JOINS> above.
+This slightly nonsense example will produce SQL similar to:
+ SELECT cd.ID, cd.Title, cd.Year FROM CD cd JOIN Tracks tracks ON cd.ID = tracks.CDID WHERE cd.Title = 'Funky CD' AND tracks.Name LIKE 'T%' ORDER BY 'tracks.id';
+
+=head1 FETCHING RELATED DATA
+
+Another common use for joining to related tables, is to fetch the data
+from both tables in one query, preventing extra round-trips to the
+database. See the example above in L</WHAT ARE JOINS>.
+
+Three techniques are described here. Of the three, only the
+C<prefetch> technique will deal sanely with fetching related objects
+over a C<has_many> relation. The others work fine for 1 to 1 type
+relationships.
+
+=head2 Whole related objects
+
+To fetch entire related objects, eg CDs and all Track data, use the
+'prefetch' attribute:
+
+ $schema->resultset('CD')->search(
+ { 'Title' => 'Funky CD',
+ },
+ { prefetch => 'tracks',
+ order_by => ['tracks.id'],
+ }
+ );
+
+This will produce SQL similar to the following:
+
+ SELECT cd.ID, cd.Title, cd.Year, tracks.id, tracks.Name, tracks.Artist FROM CD JOIN Tracks ON CD.ID = tracks.CDID WHERE cd.Title = 'Funky CD' ORDER BY 'tracks.id';
+
+The syntax of 'prefetch' is the same as 'join' and implies the
+joining, so no need to use both together.
+
+=head2 Subset of related fields
+
+To fetch a subset or the related fields, the '+select' and '+as'
+attributes can be used. For example, if the CD data is required and
+just the track name from the Tracks table:
+
+ $schema->resultset('CD')->search(
+ { 'Title' => 'Funky CD',
+ },
+ { join => 'tracks',
+ '+select' => ['tracks.Name'],
+ '+as' => ['track_name'],
+ order_by => ['tracks.id'],
+ }
+ );
+
+Which will produce the query:
+
+ SELECT cd.ID, cd.Title, cd.Year, tracks.Name FROM CD JOIN Tracks ON CD.ID = tracks.CDID WHERE cd.Title = 'Funky CD' ORDER BY 'tracks.id';
+
+Note that the '+as' does not produce an SQL 'AS' keyword in the
+output, see the L<DBIx::Class::Manual::FAQ> for an explanation.
+
+This type of column restriction has a downside, the resulting $row
+object will have no 'track_name' accessor:
+
+ while(my $row = $search_rs->next) {
+ print $row->track_name; ## ERROR
+ }
+
+Instead C<get_column> must be used:
+
+ while(my $row = $search_rs->next) {
+ print $row->get_colum('track_name'); ## WORKS
+ }
+
+=head2 Incomplete related objects
+
+In rare circumstances, you may also wish to fetch related data as
+incomplete objects. The usual reason to do is when the related table
+has a very large field you don't need for the current data
+output. This is better solved by storing that field in a separate
+table which you only join to when needed.
+
+To fetch an incomplete related object, supply the dotted notation to the '+as' attribute:
+
+ $schema->resultset('CD')->search(
+ { 'Title' => 'Funky CD',
+ },
+ { join => 'tracks',
+ '+select' => ['tracks.Name'],
+ '+as' => ['tracks.Name'],
+ order_by => ['tracks.id'],
+ }
+ );
+
+Which will produce same query as above;
+
+ SELECT cd.ID, cd.Title, cd.Year, tracks.Name FROM CD JOIN Tracks ON CD.ID = tracks.CDID WHERE cd.Title = 'Funky CD' ORDER BY 'tracks.id';
+
+Now you can access the result using the relationship accessor:
+
+ while(my $row = $search_rs->next) {
+ print $row->tracks->name; ## WORKS
+ }
+
+However, this will produce broken objects. If the tracks id column is
+not fetched, the object will not be usable for any operation other
+than reading its data. Use the L</Whole related objects> method as
+much as possible to avoid confusion in your code later.
+
+Broken means: Update will not work. Fetching other related objects
+will not work. Deleting the object will not work.
+
=head1 COMPLEX JOINS AND STUFF
=head2 Across multiple relations
@@ -114,14 +223,12 @@
$schema->resultset('CD')->search(
{ 'Title' => 'Funky CD' },
{ join => { 'tracks' => 'artist' },
- '+select' => [ 'tracks.Name', 'artist.Artist' ],
- '+as' => [ 'TrackName', 'ArtistName' ]
}
);
Which is:
- SELECT me.ID, me.Title, me.Year, tracks.Name, artist.Artist FROM CD me JOIN Tracks tracks ON CD.ID = tracks.CDID JOIN Artists artist ON tracks.ArtistID = artist.ID WHERE me.Title = 'Funky CD';
+ SELECT me.ID, me.Title, me.Year FROM CD me JOIN Tracks tracks ON CD.ID = tracks.CDID JOIN Artists artist ON tracks.ArtistID = artist.ID WHERE me.Title = 'Funky CD';
To perform joins using relations of the tables you are joining to, use
a hashref to indicate the join depth. This can theoretically go as
@@ -147,12 +254,10 @@
{ 'Title' => 'Funky CD' },
{ join => { 'tracks' => 'artist' },
order_by => [ 'tracks.Name', 'artist.Artist' ],
- '+select' => [ 'tracks.Name', 'artist.Artist' ],
- '+as' => [ 'TrackName', 'ArtistName' ]
}
);
- SELECT me.ID, me.Title, me.Year, tracks.Name, artist.Artist FROM CD me JOIN Tracks tracks ON CD.ID = tracks.CDID JOIN Artists artist ON tracks.ArtistID = artist.ID WHERE me.Title = 'Funky CD' ORDER BY tracks.Name, artist.Artist;
+ SELECT me.ID, me.Title, me.Year FROM CD me JOIN Tracks tracks ON CD.ID = tracks.CDID JOIN Artists artist ON tracks.ArtistID = artist.ID WHERE me.Title = 'Funky CD' ORDER BY tracks.Name, artist.Artist;
This is essential if any of your tables have columns with the same names.
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Troubleshooting.pod
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Troubleshooting.pod 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Manual/Troubleshooting.pod 2010-02-10 22:41:54 UTC (rev 8606)
@@ -100,29 +100,21 @@
L<DBIx::Class::Manual::Cookbook/Setting_quoting_for_the_generated_SQL> for
details.
-Note that quoting may lead to problems with C<order_by> clauses, see
-L<... column "foo DESC" does not exist ...> for info on avoiding those.
-
=head2 column "foo DESC" does not exist ...
-This can happen if you've turned on quoting and then done something like
-this:
+This can happen if you are still using the obsolete order hack, and also
+happen to turn on sql-quoting.
$rs->search( {}, { order_by => [ 'name DESC' ] } );
-This results in SQL like this:
+Since L<DBIx::Class> >= 0.08100 and L<SQL::Abstract> >= 1.50 the above
+should be written as:
- ... ORDER BY "name DESC"
+ $rs->search( {}, { order_by => { -desc => 'name' } } );
-The solution is to pass your order_by items as scalar references to avoid
-quoting:
+For more ways to express order clauses refer to
+L<SQL::Abstract/ORDER_BY_CLAUSES>
- $rs->search( {}, { order_by => [ \'name DESC' ] } );
-
-Now you'll get SQL like this:
-
- ... ORDER BY name DESC
-
=head2 Perl Performance Issues on Red Hat Systems
There is a problem with slow performance of certain DBIx::Class
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/PK/Auto.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/PK/Auto.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/PK/Auto.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -11,7 +11,7 @@
=head1 SYNOPSIS
-__PACKAGE__->load_components(qw/Core/);
+use base 'DBIx::Class::Core';
__PACKAGE__->set_primary_key('id');
=head1 DESCRIPTION
@@ -19,8 +19,6 @@
This class overrides the insert method to get automatically incremented primary
keys.
- __PACKAGE__->load_components(qw/Core/);
-
PK::Auto is now part of Core.
See L<DBIx::Class::Manual::Component> for details of component interactions.
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/Base.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/Base.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/Base.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -30,6 +30,8 @@
__PACKAGE__->add_relationship('relname', 'Foreign::Class', $cond, $attrs);
+=head3 condition
+
The condition needs to be an L<SQL::Abstract>-style representation of the
join between the tables. When resolving the condition for use in a C<JOIN>,
keys using the pseudo-table C<foreign> are resolved to mean "the Table on the
@@ -67,10 +69,19 @@
To add an C<OR>ed condition, use an arrayref of hashrefs. See the
L<SQL::Abstract> documentation for more details.
-In addition to the
-L<standard ResultSet attributes|DBIx::Class::ResultSet/ATTRIBUTES>,
-the following attributes are also valid:
+=head3 attributes
+The L<standard ResultSet attributes|DBIx::Class::ResultSet/ATTRIBUTES> may
+be used as relationship attributes. In particular, the 'where' attribute is
+useful for filtering relationships:
+
+ __PACKAGE__->has_many( 'valid_users', 'MyApp::Schema::User',
+ { 'foreign.user_id' => 'self.user_id' },
+ { where => { valid => 1 } }
+ );
+
+The following attributes are also valid:
+
=over 4
=item join_type
@@ -195,7 +206,7 @@
if ($cond eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
my $reverse = $source->reverse_relationship_info($rel);
foreach my $rev_rel (keys %$reverse) {
- if ($reverse->{$rev_rel}{attrs}{accessor} eq 'multi') {
+ if ($reverse->{$rev_rel}{attrs}{accessor} && $reverse->{$rev_rel}{attrs}{accessor} eq 'multi') {
$attrs->{related_objects}{$rev_rel} = [ $self ];
Scalar::Util::weaken($attrs->{related_object}{$rev_rel}[0]);
} else {
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/CascadeActions.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/CascadeActions.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/CascadeActions.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -39,8 +39,11 @@
my @cascade = grep { $rels{$_}{attrs}{cascade_update} } keys %rels;
foreach my $rel (@cascade) {
next if (
+ $rels{$rel}{attrs}{accessor}
+ &&
$rels{$rel}{attrs}{accessor} eq 'single'
- && !exists($self->{_relationship_data}{$rel})
+ &&
+ !exists($self->{_relationship_data}{$rel})
);
$_->update for grep defined, $self->$rel;
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/HasOne.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/HasOne.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/HasOne.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -3,6 +3,7 @@
use strict;
use warnings;
+use Carp::Clan qw/^DBIx::Class/;
our %_pod_inherit_config =
(
@@ -21,20 +22,16 @@
my ($class, $join_type, $rel, $f_class, $cond, $attrs) = @_;
unless (ref $cond) {
$class->ensure_class_loaded($f_class);
- my ($pri, $too_many) = $class->primary_columns;
+ my $pri = $class->_get_primary_key;
+
$class->throw_exception(
- "might_have/has_one can only infer join for a single primary key; ".
- "${class} has more"
- ) if $too_many;
-
- $class->throw_exception(
"might_have/has_one needs a primary key to infer a join; ".
"${class} has none"
) if !defined $pri && (!defined $cond || !length $cond);
my $f_class_loaded = eval { $f_class->columns };
- my ($f_key,$guess);
+ my ($f_key,$too_many,$guess);
if (defined $cond && length $cond) {
$f_key = $cond;
$guess = "caller specified foreign key '$f_key'";
@@ -42,11 +39,7 @@
$f_key = $rel;
$guess = "using given relationship '$rel' for foreign key";
} else {
- ($f_key, $too_many) = $f_class->primary_columns;
- $class->throw_exception(
- "might_have/has_one can only infer join for a single primary key; ".
- "${f_class} has more"
- ) if $too_many;
+ $f_key = $class->_get_primary_key($f_class);
$guess = "using primary key of foreign class for foreign key";
}
$class->throw_exception(
@@ -54,6 +47,7 @@
) if $f_class_loaded && !$f_class->has_column($f_key);
$cond = { "foreign.${f_key}" => "self.${pri}" };
}
+ $class->_validate_cond($cond);
$class->add_relationship($rel, $f_class,
$cond,
{ accessor => 'single',
@@ -63,4 +57,34 @@
1;
}
+sub _get_primary_key {
+ my ( $class, $target_class ) = @_;
+ $target_class ||= $class;
+ my ($pri, $too_many) = $target_class->primary_columns;
+ $class->throw_exception(
+ "might_have/has_one can only infer join for a single primary key; ".
+ "${class} has more"
+ ) if $too_many;
+ return $pri;
+}
+
+sub _validate_cond {
+ my ($class, $cond ) = @_;
+
+ return if $ENV{DBIC_DONT_VALIDATE_RELS};
+ return unless 'HASH' eq ref $cond;
+ foreach my $foreign_id ( keys %$cond ) {
+ my $self_id = $cond->{$foreign_id};
+
+ # we can ignore a bad $self_id because add_relationship handles this
+ # warning
+ return unless $self_id =~ /^self\.(.*)$/;
+ my $key = $1;
+ my $column_info = $class->column_info($key);
+ if ( $column_info->{is_nullable} ) {
+ carp(qq'"might_have/has_one" must not be on columns with is_nullable set to true ($class/$key). This might indicate an incorrect use of those relationship helpers instead of belongs_to.');
+ }
+ }
+}
+
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/ManyToMany.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/ManyToMany.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship/ManyToMany.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -64,15 +64,15 @@
my $rs = $self->search_related($rel)->search_related(
$f_rel, @_ > 0 ? @_ : undef, { %{$rel_attrs||{}}, %$attrs }
);
- return $rs;
+ return $rs;
};
my $meth_name = join '::', $class, $meth;
*$meth_name = Sub::Name::subname $meth_name, sub {
- my $self = shift;
- my $rs = $self->$rs_meth( @_ );
- return (wantarray ? $rs->all : $rs);
- };
+ my $self = shift;
+ my $rs = $self->$rs_meth( @_ );
+ return (wantarray ? $rs->all : $rs);
+ };
my $add_meth_name = join '::', $class, $add_meth;
*$add_meth_name = Sub::Name::subname $add_meth_name, sub {
@@ -102,7 +102,7 @@
my $link = $self->search_related($rel)->new_result($link_vals);
$link->set_from_related($f_rel, $obj);
$link->insert();
- return $obj;
+ return $obj;
};
my $set_meth_name = join '::', $class, $set_meth;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Relationship.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -232,13 +232,13 @@
=back
-Creates a one-to-many relationship, where the corresponding elements
-of the foreign class store the calling class's primary key in one (or
-more) of the foreign class columns. This relationship defaults to using
-the end of this classes namespace as the foreign key in C<$related_class>
-to resolve the join, unless C<$their_fk_column> specifies the foreign
-key column in C<$related_class> or C<cond> specifies a reference to a
-join condition hash.
+Creates a one-to-many relationship where the foreign class refers to
+this class's primary key. This relationship refers to zero or more
+records in the foreign table (ie, a C<LEFT JOIN>). This relationship
+defaults to using the end of this classes namespace as the foreign key
+in C<$related_class> to resolve the join, unless C<$their_fk_column>
+specifies the foreign key column in C<$related_class> or C<cond>
+specifies a reference to a join condition hash.
=over
@@ -441,6 +441,17 @@
for a L<list of standard resultset attributes|DBIx::Class::ResultSet/ATTRIBUTES>
which can be assigned to relationships as well.
+Note that if you supply a condition on which to join, if the column in the
+current table allows nulls (i.e., has the C<is_nullable> attribute set to a
+true value), than C<might_have> will warn about this because it's naughty and
+you shouldn't do that.
+
+ "might_have/has_one" must not be on columns with is_nullable set to true (MySchema::SomeClass/key)
+
+If you must be naughty, you can suppress the warning by setting
+C<DBIC_DONT_VALIDATE_RELS> environment variable to a true value. Otherwise,
+you probably just want to use C<DBIx::Class::Relationship/belongs_to>.
+
=head2 has_one
=over 4
@@ -528,6 +539,11 @@
for a L<list of standard resultset attributes|DBIx::Class::ResultSet/ATTRIBUTES>
which can be assigned to relationships as well.
+Note that if you supply a condition on which to join, if the column in the
+current table allows nulls (i.e., has the C<is_nullable> attribute set to a
+true value), than warnings might apply just as with
+L<DBIx::Class::Relationship/might_have>.
+
=head2 many_to_many
=over 4
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSet.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSet.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -357,9 +357,9 @@
}
my $rs = (ref $self)->new($self->result_source, $new_attrs);
- if ($rows) {
- $rs->set_cache($rows);
- }
+
+ $rs->set_cache($rows) if ($rows);
+
return $rs;
}
@@ -530,7 +530,7 @@
}
# Run the query
- my $rs = $self->search ($query, $attrs);
+ my $rs = $self->search ($query, {result_class => $self->result_class, %$attrs});
if (keys %{$rs->_resolved_attrs->{collapse}}) {
my $row = $rs->next;
carp "Query returned more than one row" if $rs->next;
@@ -974,19 +974,6 @@
sub _collapse_result {
my ($self, $as_proto, $row) = @_;
- # if the first row that ever came in is totally empty - this means we got
- # hit by a smooth^Wempty left-joined resultset. Just noop in that case
- # instead of producing a {}
- #
- my $has_def;
- for (@$row) {
- if (defined $_) {
- $has_def++;
- last;
- }
- }
- return undef unless $has_def;
-
my @copy = @$row;
# 'foo' => [ undef, 'foo' ]
@@ -1247,11 +1234,6 @@
$tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $tmp_attrs);
$tmp_attrs->{as} = 'count';
- # read the comment on top of the actual function to see what this does
- $tmp_attrs->{from} = $self->_switch_to_inner_join_if_needed (
- $tmp_attrs->{from}, $tmp_attrs->{alias}
- );
-
my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count');
return $tmp_rs;
@@ -1271,20 +1253,16 @@
# extra selectors do not go in the subquery and there is no point of ordering it
delete $sub_attrs->{$_} for qw/collapse select _prefetch_select as order_by/;
- # if we prefetch, we group_by primary keys only as this is what we would get out
- # of the rs via ->next/->all. We DO WANT to clobber old group_by regardless
- if ( keys %{$attrs->{collapse}} ) {
+ # if we multi-prefetch we group_by primary keys only as this is what we would
+ # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless
+ if ( keys %{$attrs->{collapse}} ) {
$sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->primary_columns) ]
}
$sub_attrs->{select} = $rsrc->storage->_subq_count_select ($rsrc, $sub_attrs);
- # read the comment on top of the actual function to see what this does
- $sub_attrs->{from} = $self->_switch_to_inner_join_if_needed (
- $sub_attrs->{from}, $sub_attrs->{alias}
- );
-
- # this is so that ordering can be thrown away in things like Top limit
+ # this is so that the query can be simplified e.g.
+ # * ordering can be thrown away in things like Top limit
$sub_attrs->{-for_count_only} = 1;
my $sub_rs = $rsrc->resultset_class->new ($rsrc, $sub_attrs);
@@ -1301,77 +1279,6 @@
return $self->_count_rs ($attrs);
}
-
-# The DBIC relationship chaining implementation is pretty simple - every
-# new related_relationship is pushed onto the {from} stack, and the {select}
-# window simply slides further in. This means that when we count somewhere
-# in the middle, we got to make sure that everything in the join chain is an
-# actual inner join, otherwise the count will come back with unpredictable
-# results (a resultset may be generated with _some_ rows regardless of if
-# the relation which the $rs currently selects has rows or not). E.g.
-# $artist_rs->cds->count - normally generates:
-# SELECT COUNT( * ) FROM artist me LEFT JOIN cd cds ON cds.artist = me.artistid
-# which actually returns the number of artists * (number of cds || 1)
-#
-# So what we do here is crawl {from}, determine if the current alias is at
-# the top of the stack, and if not - make sure the chain is inner-joined down
-# to the root.
-#
-sub _switch_to_inner_join_if_needed {
- my ($self, $from, $alias) = @_;
-
- # subqueries and other oddness is naturally not supported
- return $from if (
- ref $from ne 'ARRAY'
- ||
- @$from <= 1
- ||
- ref $from->[0] ne 'HASH'
- ||
- ! $from->[0]{-alias}
- ||
- $from->[0]{-alias} eq $alias
- );
-
- my $switch_branch;
- JOINSCAN:
- for my $j (@{$from}[1 .. $#$from]) {
- if ($j->[0]{-alias} eq $alias) {
- $switch_branch = $j->[0]{-join_path};
- last JOINSCAN;
- }
- }
-
- # something else went wrong
- return $from unless $switch_branch;
-
- # So it looks like we will have to switch some stuff around.
- # local() is useless here as we will be leaving the scope
- # anyway, and deep cloning is just too fucking expensive
- # So replace the inner hashref manually
- my @new_from = ($from->[0]);
- my $sw_idx = { map { $_ => 1 } @$switch_branch };
-
- for my $j (@{$from}[1 .. $#$from]) {
- my $jalias = $j->[0]{-alias};
-
- if ($sw_idx->{$jalias}) {
- my %attrs = %{$j->[0]};
- delete $attrs{-join_type};
- push @new_from, [
- \%attrs,
- @{$j}[ 1 .. $#$j ],
- ];
- }
- else {
- push @new_from, $j;
- }
- }
-
- return \@new_from;
-}
-
-
sub _bool {
return 1;
}
@@ -1495,8 +1402,12 @@
my $rsrc = $self->result_source;
+ # if a condition exists we need to strip all table qualifiers
+ # if this is not possible we'll force a subquery below
+ my $cond = $rsrc->schema->storage->_strip_cond_qualifiers ($self->{cond});
+
my $needs_group_by_subq = $self->_has_resolved_attr (qw/collapse group_by -join/);
- my $needs_subq = $self->_has_resolved_attr (qw/row offset/);
+ my $needs_subq = $needs_group_by_subq || (not defined $cond) || $self->_has_resolved_attr(qw/row offset/);
if ($needs_group_by_subq or $needs_subq) {
@@ -1544,70 +1455,11 @@
return $rsrc->storage->$op(
$rsrc,
$op eq 'update' ? $values : (),
- $self->_cond_for_update_delete,
+ $cond,
);
}
}
-
-# _cond_for_update_delete
-#
-# update/delete require the condition to be modified to handle
-# the differing SQL syntax available. This transforms the $self->{cond}
-# appropriately, returning the new condition.
-
-sub _cond_for_update_delete {
- my ($self, $full_cond) = @_;
- my $cond = {};
-
- $full_cond ||= $self->{cond};
- # No-op. No condition, we're updating/deleting everything
- return $cond unless ref $full_cond;
-
- if (ref $full_cond eq 'ARRAY') {
- $cond = [
- map {
- my %hash;
- foreach my $key (keys %{$_}) {
- $key =~ /([^.]+)$/;
- $hash{$1} = $_->{$key};
- }
- \%hash;
- } @{$full_cond}
- ];
- }
- elsif (ref $full_cond eq 'HASH') {
- if ((keys %{$full_cond})[0] eq '-and') {
- $cond->{-and} = [];
- my @cond = @{$full_cond->{-and}};
- for (my $i = 0; $i < @cond; $i++) {
- my $entry = $cond[$i];
- my $hash;
- if (ref $entry eq 'HASH') {
- $hash = $self->_cond_for_update_delete($entry);
- }
- else {
- $entry =~ /([^.]+)$/;
- $hash->{$1} = $cond[++$i];
- }
- push @{$cond->{-and}}, $hash;
- }
- }
- else {
- foreach my $key (keys %{$full_cond}) {
- $key =~ /([^.]+)$/;
- $cond->{$1} = $full_cond->{$key};
- }
- }
- }
- else {
- $self->throw_exception("Can't update/delete on resultset with condition unless hash or array");
- }
-
- return $cond;
-}
-
-
=head2 update
=over 4
@@ -1782,11 +1634,11 @@
=cut
sub populate {
- my $self = shift @_;
- my $data = ref $_[0][0] eq 'HASH'
- ? $_[0] : ref $_[0][0] eq 'ARRAY' ? $self->_normalize_populate_args($_[0]) :
- $self->throw_exception('Populate expects an arrayref of hashes or arrayref of arrayrefs');
+ my $self = shift;
+ # cruft placed in standalone method
+ my $data = $self->_normalize_populate_args(@_);
+
if(defined wantarray) {
my @created;
foreach my $item (@$data) {
@@ -1794,15 +1646,19 @@
}
return wantarray ? @created : \@created;
} else {
- my ($first, @rest) = @$data;
+ my $first = $data->[0];
- require overload;
- my @names = grep {
- (not ref $first->{$_}) || (ref $first->{$_} eq 'SCALAR') ||
- (overload::Method($first->{$_}, '""'))
- } keys %$first;
+ # if a column is a registered relationship, and is a non-blessed hash/array, consider
+ # it relationship data
+ my (@rels, @columns);
+ for (keys %$first) {
+ my $ref = ref $first->{$_};
+ $self->result_source->has_relationship($_) && ($ref eq 'ARRAY' or $ref eq 'HASH')
+ ? push @rels, $_
+ : push @columns, $_
+ ;
+ }
- my @rels = grep { $self->result_source->has_relationship($_) } keys %$first;
my @pks = $self->result_source->primary_columns;
## do the belongs_to relationships
@@ -1831,17 +1687,21 @@
delete $data->[$index]->{$rel};
$data->[$index] = {%{$data->[$index]}, %$related};
- push @names, keys %$related if $index == 0;
+ push @columns, keys %$related if $index == 0;
}
}
- ## do bulk insert on current row
- my @values = map { [ @$_{@names} ] } @$data;
+ ## inherit the data locked in the conditions of the resultset
+ my ($rs_data) = $self->_merge_cond_with_data({});
+ delete @{$rs_data}{@columns};
+ my @inherit_cols = keys %$rs_data;
+ my @inherit_data = values %$rs_data;
+ ## do bulk insert on current row
$self->result_source->storage->insert_bulk(
$self->result_source,
- \@names,
- \@values,
+ [@columns, @inherit_cols],
+ [ map { [ @$_{@columns}, @inherit_data ] } @$data ],
);
## do the has_many relationships
@@ -1850,7 +1710,7 @@
foreach my $rel (@rels) {
next unless $item->{$rel} && ref $item->{$rel} eq "ARRAY";
- my $parent = $self->find(map {{$_=>$item->{$_}} } @pks)
+ my $parent = $self->find({map { $_ => $item->{$_} } @pks})
|| $self->throw_exception('Cannot find the relating object.');
my $child = $parent->$rel;
@@ -1870,26 +1730,27 @@
}
}
-=head2 _normalize_populate_args ($args)
-Private method used by L</populate> to normalize its incoming arguments. Factored
-out in case you want to subclass and accept new argument structures to the
-L</populate> method.
-
-=cut
-
+# populate() argumnets went over several incarnations
+# What we ultimately support is AoH
sub _normalize_populate_args {
- my ($self, $data) = @_;
- my @names = @{shift(@$data)};
- my @results_to_create;
- foreach my $datum (@$data) {
- my %result_to_create;
- foreach my $index (0..$#names) {
- $result_to_create{$names[$index]} = $$datum[$index];
+ my ($self, $arg) = @_;
+
+ if (ref $arg eq 'ARRAY') {
+ if (ref $arg->[0] eq 'HASH') {
+ return $arg;
}
- push @results_to_create, \%result_to_create;
+ elsif (ref $arg->[0] eq 'ARRAY') {
+ my @ret;
+ my @colnames = @{$arg->[0]};
+ foreach my $values (@{$arg}[1 .. $#$arg]) {
+ push @ret, { map { $colnames[$_] => $values->[$_] } (0 .. $#colnames) };
+ }
+ return \@ret;
+ }
}
- return \@results_to_create;
+
+ $self->throw_exception('Populate expects an arrayref of hashrefs or arrayref of arrayrefs');
}
=head2 pager
@@ -1978,46 +1839,66 @@
$self->throw_exception( "new_result needs a hash" )
unless (ref $values eq 'HASH');
- my %new;
+ my ($merged_cond, $cols_from_relations) = $self->_merge_cond_with_data($values);
+
+ my %new = (
+ %$merged_cond,
+ @$cols_from_relations
+ ? (-cols_from_relations => $cols_from_relations)
+ : (),
+ -source_handle => $self->_source_handle,
+ -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
+ );
+
+ return $self->result_class->new(\%new);
+}
+
+# _merge_cond_with_data
+#
+# Takes a simple hash of K/V data and returns its copy merged with the
+# condition already present on the resultset. Additionally returns an
+# arrayref of value/condition names, which were inferred from related
+# objects (this is needed for in-memory related objects)
+sub _merge_cond_with_data {
+ my ($self, $data) = @_;
+
+ my (%new_data, @cols_from_relations);
+
my $alias = $self->{attrs}{alias};
- if (
- defined $self->{cond}
- && $self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION
- ) {
- %new = %{ $self->{attrs}{related_objects} || {} }; # nothing might have been inserted yet
- $new{-from_resultset} = [ keys %new ] if keys %new;
- } else {
+ if (! defined $self->{cond}) {
+ # just massage $data below
+ }
+ elsif ($self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION) {
+ %new_data = %{ $self->{attrs}{related_objects} || {} }; # nothing might have been inserted yet
+ @cols_from_relations = keys %new_data;
+ }
+ elsif (ref $self->{cond} ne 'HASH') {
$self->throw_exception(
- "Can't abstract implicit construct, condition not a hash"
- ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
-
- my $collapsed_cond = (
- $self->{cond}
- ? $self->_collapse_cond($self->{cond})
- : {}
+ "Can't abstract implicit construct, resultset condition not a hash"
);
-
+ }
+ else {
# precendence must be given to passed values over values inherited from
# the cond, so the order here is important.
- my %implied = %{$self->_remove_alias($collapsed_cond, $alias)};
- while( my($col,$value) = each %implied ){
- if(ref($value) eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '='){
- $new{$col} = $value->{'='};
+ my $collapsed_cond = $self->_collapse_cond($self->{cond});
+ my %implied = %{$self->_remove_alias($collapsed_cond, $alias)};
+
+ while ( my($col, $value) = each %implied ) {
+ if (ref($value) eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '=') {
+ $new_data{$col} = $value->{'='};
next;
}
- $new{$col} = $value if $self->_is_deterministic_value($value);
+ $new_data{$col} = $value if $self->_is_deterministic_value($value);
}
}
- %new = (
- %new,
- %{ $self->_remove_alias($values, $alias) },
- -source_handle => $self->_source_handle,
- -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
+ %new_data = (
+ %new_data,
+ %{ $self->_remove_alias($data, $alias) },
);
- return $self->result_class->new(\%new);
+ return (\%new_data, \@cols_from_relations);
}
# _is_deterministic_value
@@ -2142,7 +2023,7 @@
return \%unaliased;
}
-=head2 as_query (EXPERIMENTAL)
+=head2 as_query
=over 4
@@ -2156,8 +2037,6 @@
This is generally used as the RHS for a subquery.
-B<NOTE>: This feature is still experimental.
-
=cut
sub as_query {
@@ -2607,21 +2486,30 @@
$self->{related_resultsets} ||= {};
return $self->{related_resultsets}{$rel} ||= do {
- my $rel_info = $self->result_source->relationship_info($rel);
+ my $rsrc = $self->result_source;
+ my $rel_info = $rsrc->relationship_info($rel);
$self->throw_exception(
- "search_related: result source '" . $self->result_source->source_name .
+ "search_related: result source '" . $rsrc->source_name .
"' has no such relationship $rel")
unless $rel_info;
- my ($from,$seen) = $self->_chain_relationship($rel);
+ my $attrs = $self->_chain_relationship($rel);
- my $join_count = $seen->{$rel};
- my $alias = ($join_count > 1 ? join('_', $rel, $join_count) : $rel);
+ my $join_count = $attrs->{seen_join}{$rel};
+ my $alias = $self->result_source->storage
+ ->relname_to_table_alias($rel, $join_count);
+
+ # since this is search_related, and we already slid the select window inwards
+ # (the select/as attrs were deleted in the beginning), we need to flip all
+ # left joins to inner, so we get the expected results
+ # read the comment on top of the actual function to see what this does
+ $attrs->{from} = $rsrc->schema->storage->_straight_join_to_node ($attrs->{from}, $alias);
+
+
#XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
- my %attrs = %{$self->{attrs}||{}};
- delete @attrs{qw(result_class alias)};
+ delete @{$attrs}{qw(result_class alias)};
my $new_cache;
@@ -2632,7 +2520,7 @@
}
}
- my $rel_source = $self->result_source->related_source($rel);
+ my $rel_source = $rsrc->related_source($rel);
my $new = do {
@@ -2642,20 +2530,14 @@
# to work sanely (e.g. RestrictWithObject wants to be able to add
# extra query restrictions, and these may need to be $alias.)
- my $attrs = $rel_source->resultset_attributes;
- local $attrs->{alias} = $alias;
+ my $rel_attrs = $rel_source->resultset_attributes;
+ local $rel_attrs->{alias} = $alias;
$rel_source->resultset
->search_rs(
undef, {
- %attrs,
- join => undef,
- prefetch => undef,
- select => undef,
- as => undef,
- where => $self->{cond},
- seen_join => $seen,
- from => $from,
+ %$attrs,
+ where => $attrs->{where},
});
};
$new->set_cache($new_cache) if $new_cache;
@@ -2706,6 +2588,68 @@
return ($self->{attrs} || {})->{alias} || 'me';
}
+=head2 as_subselect_rs
+
+=over 4
+
+=item Arguments: none
+
+=item Return Value: $resultset
+
+=back
+
+Act as a barrier to SQL symbols. The resultset provided will be made into a
+"virtual view" by including it as a subquery within the from clause. From this
+point on, any joined tables are inaccessible to ->search on the resultset (as if
+it were simply where-filtered without joins). For example:
+
+ my $rs = $schema->resultset('Bar')->search({'x.name' => 'abc'},{ join => 'x' });
+
+ # 'x' now pollutes the query namespace
+
+ # So the following works as expected
+ my $ok_rs = $rs->search({'x.other' => 1});
+
+ # But this doesn't: instead of finding a 'Bar' related to two x rows (abc and
+ # def) we look for one row with contradictory terms and join in another table
+ # (aliased 'x_2') which we never use
+ my $broken_rs = $rs->search({'x.name' => 'def'});
+
+ my $rs2 = $rs->as_subselect_rs;
+
+ # doesn't work - 'x' is no longer accessible in $rs2, having been sealed away
+ my $not_joined_rs = $rs2->search({'x.other' => 1});
+
+ # works as expected: finds a 'table' row related to two x rows (abc and def)
+ my $correctly_joined_rs = $rs2->search({'x.name' => 'def'});
+
+Another example of when one might use this would be to select a subset of
+columns in a group by clause:
+
+ my $rs = $schema->resultset('Bar')->search(undef, {
+ group_by => [qw{ id foo_id baz_id }],
+ })->as_subselect_rs->search(undef, {
+ columns => [qw{ id foo_id }]
+ });
+
+In the above example normally columns would have to be equal to the group by,
+but because we isolated the group by into a subselect the above works.
+
+=cut
+
+sub as_subselect_rs {
+ my $self = shift;
+
+ return $self->result_source->resultset->search( undef, {
+ alias => $self->current_source_alias,
+ from => [{
+ $self->current_source_alias => $self->as_query,
+ -alias => $self->current_source_alias,
+ -source_handle => $self->result_source->handle,
+ }]
+ });
+}
+
# This code is called by search_related, and makes sure there
# is clear separation between the joins before, during, and
# after the relationship. This information is needed later
@@ -2713,37 +2657,67 @@
# with a relation_chain_depth less than the depth of the
# current prefetch is not considered)
#
-# The increments happen in 1/2s to make it easier to correlate the
-# join depth with the join path. An integer means a relationship
-# specified via a search_related, whereas a fraction means an added
-# join/prefetch via attributes
+# The increments happen twice per join. An even number means a
+# relationship specified via a search_related, whereas an odd
+# number indicates a join/prefetch added via attributes
+#
+# Also this code will wrap the current resultset (the one we
+# chain to) in a subselect IFF it contains limiting attributes
sub _chain_relationship {
my ($self, $rel) = @_;
my $source = $self->result_source;
- my $attrs = $self->{attrs};
+ my $attrs = { %{$self->{attrs}||{}} };
- my $from = [ @{
- $attrs->{from}
- ||
- [{
- -source_handle => $source->handle,
- -alias => $attrs->{alias},
- $attrs->{alias} => $source->from,
- }]
- }];
+ # we need to take the prefetch the attrs into account before we
+ # ->_resolve_join as otherwise they get lost - captainL
+ my $join = $self->_merge_attr( $attrs->{join}, $attrs->{prefetch} );
- my $seen = { %{$attrs->{seen_join} || {} } };
- my $jpath = ($attrs->{seen_join} && keys %{$attrs->{seen_join}})
- ? $from->[-1][0]{-join_path}
- : [];
+ delete @{$attrs}{qw/join prefetch collapse distinct select as columns +select +as +columns/};
+ my $seen = { %{ (delete $attrs->{seen_join}) || {} } };
- # we need to take the prefetch the attrs into account before we
- # ->_resolve_join as otherwise they get lost - captainL
- my $merged = $self->_merge_attr( $attrs->{join}, $attrs->{prefetch} );
+ my $from;
+ my @force_subq_attrs = qw/offset rows group_by having/;
+ if (
+ ($attrs->{from} && ref $attrs->{from} ne 'ARRAY')
+ ||
+ $self->_has_resolved_attr (@force_subq_attrs)
+ ) {
+ # Nuke the prefetch (if any) before the new $rs attrs
+ # are resolved (prefetch is useless - we are wrapping
+ # a subquery anyway).
+ my $rs_copy = $self->search;
+ $rs_copy->{attrs}{join} = $self->_merge_attr (
+ $rs_copy->{attrs}{join},
+ delete $rs_copy->{attrs}{prefetch},
+ );
+
+ $from = [{
+ -source_handle => $source->handle,
+ -alias => $attrs->{alias},
+ $attrs->{alias} => $rs_copy->as_query,
+ }];
+ delete @{$attrs}{@force_subq_attrs, 'where'};
+ $seen->{-relation_chain_depth} = 0;
+ }
+ elsif ($attrs->{from}) { #shallow copy suffices
+ $from = [ @{$attrs->{from}} ];
+ }
+ else {
+ $from = [{
+ -source_handle => $source->handle,
+ -alias => $attrs->{alias},
+ $attrs->{alias} => $source->from,
+ }];
+ }
+
+ my $jpath = ($seen->{-relation_chain_depth})
+ ? $from->[-1][0]{-join_path}
+ : [];
+
my @requested_joins = $source->_resolve_join(
- $merged,
+ $join,
$attrs->{alias},
$seen,
$jpath,
@@ -2751,7 +2725,7 @@
push @$from, @requested_joins;
- $seen->{-relation_chain_depth} += 0.5;
+ $seen->{-relation_chain_depth}++;
# if $self already had a join/prefetch specified on it, the requested
# $rel might very well be already included. What we do in this case
@@ -2759,26 +2733,16 @@
# the join in question so we could tell it *is* the search_related)
my $already_joined;
-
# we consider the last one thus reverse
for my $j (reverse @requested_joins) {
- if ($rel eq $j->[0]{-join_path}[-1]) {
- $j->[0]{-relation_chain_depth} += 0.5;
+ my ($last_j) = keys %{$j->[0]{-join_path}[-1]};
+ if ($rel eq $last_j) {
+ $j->[0]{-relation_chain_depth}++;
$already_joined++;
last;
}
}
-# alternative way to scan the entire chain - not backwards compatible
-# for my $j (reverse @$from) {
-# next unless ref $j eq 'ARRAY';
-# if ($j->[0]{-join_path} && $j->[0]{-join_path}[-1] eq $rel) {
-# $j->[0]{-relation_chain_depth} += 0.5;
-# $already_joined++;
-# last;
-# }
-# }
-
unless ($already_joined) {
push @$from, $source->_resolve_join(
$rel,
@@ -2788,9 +2752,9 @@
);
}
- $seen->{-relation_chain_depth} += 0.5;
+ $seen->{-relation_chain_depth}++;
- return ($from,$seen);
+ return {%$attrs, from => $from, seen_join => $seen};
}
# too many times we have to do $attrs = { %{$self->_resolved_attrs} }
@@ -2942,6 +2906,21 @@
}
else {
$attrs->{group_by} = [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ];
+
+ # add any order_by parts that are not already present in the group_by
+ # we need to be careful not to add any named functions/aggregates
+ # i.e. select => [ ... { count => 'foo', -as 'foocount' } ... ]
+ my %already_grouped = map { $_ => 1 } (@{$attrs->{group_by}});
+
+ my $storage = $self->result_source->schema->storage;
+
+ my $rs_column_list = $storage->_resolve_column_info ($attrs->{from});
+
+ for my $chunk ($storage->_parse_order_by($attrs->{order_by})) {
+ if ($rs_column_list->{$chunk} && not $already_grouped{$chunk}++) {
+ push @{$attrs->{group_by}}, $chunk;
+ }
+ }
}
}
@@ -2951,8 +2930,27 @@
my $prefetch_ordering = [];
- my $join_map = $self->_joinpath_aliases ($attrs->{from}, $attrs->{seen_join});
+ # this is a separate structure (we don't look in {from} directly)
+ # as the resolver needs to shift things off the lists to work
+ # properly (identical-prefetches on different branches)
+ my $join_map = {};
+ if (ref $attrs->{from} eq 'ARRAY') {
+ my $start_depth = $attrs->{seen_join}{-relation_chain_depth} || 0;
+
+ for my $j ( @{$attrs->{from}}[1 .. $#{$attrs->{from}} ] ) {
+ next unless $j->[0]{-alias};
+ next unless $j->[0]{-join_path};
+ next if ($j->[0]{-relation_chain_depth} || 0) < $start_depth;
+
+ my @jpath = map { keys %$_ } @{$j->[0]{-join_path}};
+
+ my $p = $join_map;
+ $p = $p->{$_} ||= {} for @jpath[ ($start_depth/2) .. $#jpath]; #only even depths are actual jpath boundaries
+ push @{$p->{-join_aliases} }, $j->[0]{-alias};
+ }
+ }
+
my @prefetch =
$source->_resolve_prefetch( $prefetch, $alias, $join_map, $prefetch_ordering, $attrs->{collapse} );
@@ -2980,33 +2978,6 @@
return $self->{_attrs} = $attrs;
}
-sub _joinpath_aliases {
- my ($self, $fromspec, $seen) = @_;
-
- my $paths = {};
- return $paths unless ref $fromspec eq 'ARRAY';
-
- my $cur_depth = $seen->{-relation_chain_depth} || 0;
-
- if (int ($cur_depth) != $cur_depth) {
- $self->throw_exception ("-relation_chain_depth is not an integer, something went horribly wrong ($cur_depth)");
- }
-
- for my $j (@$fromspec) {
-
- next if ref $j ne 'ARRAY';
- next if ($j->[0]{-relation_chain_depth} || 0) < $cur_depth;
-
- my $jpath = $j->[0]{-join_path};
-
- my $p = $paths;
- $p = $p->{$_} ||= {} for @{$jpath}[$cur_depth .. $#$jpath];
- push @{$p->{-join_aliases} }, $j->[0]{-alias};
- }
-
- return $paths;
-}
-
sub _rollout_attr {
my ($self, $attr) = @_;
@@ -3260,6 +3231,9 @@
attribute, the column names returned are storage-dependent. E.g. MySQL would
return a column named C<count(employeeid)> in the above example.
+B<NOTE:> You will almost always need a corresponding 'as' entry when you use
+'select'.
+
=head2 +select
=over 4
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSetColumn.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSetColumn.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSetColumn.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -42,29 +42,58 @@
my ($class, $rs, $column) = @_;
$class = ref $class if ref $class;
- $rs->throw_exception("column must be supplied") unless $column;
+ $rs->throw_exception('column must be supplied') unless $column;
my $orig_attrs = $rs->_resolved_attrs;
- my $new_parent_rs = $rs->search_rs;
- # prefetch causes additional columns to be fetched, but we can not just make a new
- # rs via the _resolved_attrs trick - we need to retain the separation between
- # +select/+as and select/as. At the same time we want to preserve any joins that the
- # prefetch would otherwise generate.
-
- my $new_attrs = $new_parent_rs->{attrs} ||= {};
- $new_attrs->{join} = $rs->_merge_attr( delete $new_attrs->{join}, delete $new_attrs->{prefetch} );
-
# If $column can be found in the 'as' list of the parent resultset, use the
# corresponding element of its 'select' list (to keep any custom column
# definition set up with 'select' or '+select' attrs), otherwise use $column
# (to create a new column definition on-the-fly).
-
my $as_list = $orig_attrs->{as} || [];
my $select_list = $orig_attrs->{select} || [];
my $as_index = List::Util::first { ($as_list->[$_] || "") eq $column } 0..$#$as_list;
my $select = defined $as_index ? $select_list->[$as_index] : $column;
+ my $new_parent_rs;
+ # analyze the order_by, and see if it is done over a function/nonexistentcolumn
+ # if this is the case we will need to wrap a subquery since the result of RSC
+ # *must* be a single column select
+ my %collist = map { $_ => 1 } ($rs->result_source->columns, $column);
+ if (
+ scalar grep
+ { ! $collist{$_} }
+ ( $rs->result_source->schema->storage->_parse_order_by ($orig_attrs->{order_by} ) )
+ ) {
+ my $alias = $rs->current_source_alias;
+ # nuke the prefetch before collapsing to sql
+ my $subq_rs = $rs->search;
+ $subq_rs->{attrs}{join} = $subq_rs->_merge_attr( $subq_rs->{attrs}{join}, delete $subq_rs->{attrs}{prefetch} );
+
+ $new_parent_rs = $rs->result_source->resultset->search ( {}, {
+ alias => $alias,
+ from => [{
+ $alias => $subq_rs->as_query,
+ -alias => $alias,
+ -source_handle => $rs->result_source->handle,
+ }]
+ });
+ }
+
+ $new_parent_rs ||= $rs->search_rs;
+ my $new_attrs = $new_parent_rs->{attrs} ||= {};
+
+ # FIXME - this should go away when the chaining branch is merged
+ # since what we do is actually chain to the original resultset, we need to throw
+ # away all selectors (otherwise they'll chain)
+ delete $new_attrs->{$_} for (qw/columns +columns select +select as +as cols include_columns/);
+
+ # prefetch causes additional columns to be fetched, but we can not just make a new
+ # rs via the _resolved_attrs trick - we need to retain the separation between
+ # +select/+as and select/as. At the same time we want to preserve any joins that the
+ # prefetch would otherwise generate.
+ $new_attrs->{join} = $rs->_merge_attr( $new_attrs->{join}, delete $new_attrs->{prefetch} );
+
# {collapse} would mean a has_many join was injected, which in turn means
# we need to group *IF WE CAN* (only if the column in question is unique)
if (!$new_attrs->{group_by} && keys %{$orig_attrs->{collapse}}) {
@@ -98,7 +127,7 @@
return $new;
}
-=head2 as_query (EXPERIMENTAL)
+=head2 as_query
=over 4
@@ -112,8 +141,6 @@
This is generally used as the RHS for a subquery.
-B<NOTE>: This feature is still experimental.
-
=cut
sub as_query { return shift->_resultset->as_query(@_) }
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSource/View.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSource/View.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSource/View.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -19,9 +19,8 @@
package MyDB::Schema::Result::Year2000CDs;
- use base qw/DBIx::Class/;
+ use base qw/DBIx::Class::Core/;
- __PACKAGE__->load_components('Core');
__PACKAGE__->table_class('DBIx::Class::ResultSource::View');
__PACKAGE__->table('year2000cds');
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSource.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSource.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSource.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -28,9 +28,8 @@
# Create a table based result source, in a result class.
package MyDB::Schema::Result::Artist;
- use base qw/DBIx::Class/;
+ use base qw/DBIx::Class::Core/;
- __PACKAGE__->load_components(qw/Core/);
__PACKAGE__->table('artist');
__PACKAGE__->add_columns(qw/ artistid name /);
__PACKAGE__->set_primary_key('artistid');
@@ -40,8 +39,9 @@
# Create a query (view) based result source, in a result class
package MyDB::Schema::Result::Year2000CDs;
+ use base qw/DBIx::Class::Core/;
- __PACKAGE__->load_components('Core');
+ __PACKAGE__->load_components('InflateColumn::DateTime');
__PACKAGE__->table_class('DBIx::Class::ResultSource::View');
__PACKAGE__->table('year2000cds');
@@ -60,10 +60,10 @@
default result source type, so one is created for you when defining a
result class as described in the synopsis above.
-More specifically, the L<DBIx::Class::Core> component pulls in the
-L<DBIx::Class::ResultSourceProxy::Table> as a base class, which
-defines the L<table|DBIx::Class::ResultSourceProxy::Table/table>
-method. When called, C<table> creates and stores an instance of
+More specifically, the L<DBIx::Class::Core> base class pulls in the
+L<DBIx::Class::ResultSourceProxy::Table> component, which defines
+the L<table|DBIx::Class::ResultSourceProxy::Table/table> method.
+When called, C<table> creates and stores an instance of
L<DBIx::Class::ResultSoure::Table>. Luckily, to use tables as result
sources, you don't need to remember any of this.
@@ -1188,12 +1188,6 @@
return $found;
}
-sub resolve_join {
- carp 'resolve_join is a private method, stop calling it';
- my $self = shift;
- $self->_resolve_join (@_);
-}
-
# Returns the {from} structure used to express JOIN conditions
sub _resolve_join {
my ($self, $join, $alias, $seen, $jpath, $parent_force_left) = @_;
@@ -1205,7 +1199,7 @@
$self->throw_exception ('You must supply a joinpath arrayref as the 4th argument to _resolve_join')
unless ref $jpath eq 'ARRAY';
- $jpath = [@$jpath];
+ $jpath = [@$jpath]; # copy
if (not defined $join) {
return ();
@@ -1228,12 +1222,14 @@
$force_left ||= lc($rel_info->{attrs}{join_type}||'') eq 'left';
# the actual seen value will be incremented by the recursion
- my $as = ($seen->{$rel} ? join ('_', $rel, $seen->{$rel} + 1) : $rel);
+ my $as = $self->storage->relname_to_table_alias(
+ $rel, ($seen->{$rel} && $seen->{$rel} + 1)
+ );
push @ret, (
$self->_resolve_join($rel, $alias, $seen, [@$jpath], $force_left),
$self->related_source($rel)->_resolve_join(
- $join->{$rel}, $as, $seen, [@$jpath, $rel], $force_left
+ $join->{$rel}, $as, $seen, [@$jpath, { $rel => $as }], $force_left
)
);
}
@@ -1245,7 +1241,9 @@
}
else {
my $count = ++$seen->{$join};
- my $as = ($count > 1 ? "${join}_${count}" : $join);
+ my $as = $self->storage->relname_to_table_alias(
+ $join, ($count > 1 && $count)
+ );
my $rel_info = $self->relationship_info($join)
or $self->throw_exception("No such relationship ${join}");
@@ -1257,7 +1255,12 @@
? 'left'
: $rel_info->{attrs}{join_type}
,
- -join_path => [@$jpath, $join],
+ -join_path => [@$jpath, { $join => $as } ],
+ -is_single => (
+ $rel_info->{attrs}{accessor}
+ &&
+ List::Util::first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
+ ),
-alias => $as,
-relation_chain_depth => $seen->{-relation_chain_depth} || 0,
},
@@ -1334,13 +1337,13 @@
unless ($for->has_column_loaded($v)) {
if ($for->in_storage) {
$self->throw_exception(sprintf
- 'Unable to resolve relationship from %s to %s: column %s.%s not '
- . 'loaded from storage (or not passed to new() prior to insert()). '
- . 'Maybe you forgot to call ->discard_changes to get defaults from the db.',
-
- $for->result_source->source_name,
+ "Unable to resolve relationship '%s' from object %s: column '%s' not "
+ . 'loaded from storage (or not passed to new() prior to insert()). You '
+ . 'probably need to call ->discard_changes to get the server-side defaults '
+ . 'from the database.',
$as,
- $as, $v,
+ $for,
+ $v,
);
}
return $UNRESOLVABLE_CONDITION;
@@ -1368,83 +1371,11 @@
}
}
-# Legacy code, needs to go entirely away (fully replaced by _resolve_prefetch)
-sub resolve_prefetch {
- carp 'resolve_prefetch is a private method, stop calling it';
- my ($self, $pre, $alias, $seen, $order, $collapse) = @_;
- $seen ||= {};
- if( ref $pre eq 'ARRAY' ) {
- return
- map { $self->resolve_prefetch( $_, $alias, $seen, $order, $collapse ) }
- @$pre;
- }
- elsif( ref $pre eq 'HASH' ) {
- my @ret =
- map {
- $self->resolve_prefetch($_, $alias, $seen, $order, $collapse),
- $self->related_source($_)->resolve_prefetch(
- $pre->{$_}, "${alias}.$_", $seen, $order, $collapse)
- } keys %$pre;
- return @ret;
- }
- elsif( ref $pre ) {
- $self->throw_exception(
- "don't know how to resolve prefetch reftype ".ref($pre));
- }
- else {
- my $count = ++$seen->{$pre};
- my $as = ($count > 1 ? "${pre}_${count}" : $pre);
- my $rel_info = $self->relationship_info( $pre );
- $self->throw_exception( $self->name . " has no such relationship '$pre'" )
- unless $rel_info;
- my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
- my $rel_source = $self->related_source($pre);
-
- if (exists $rel_info->{attrs}{accessor}
- && $rel_info->{attrs}{accessor} eq 'multi') {
- $self->throw_exception(
- "Can't prefetch has_many ${pre} (join cond too complex)")
- unless ref($rel_info->{cond}) eq 'HASH';
- my $dots = @{[$as_prefix =~ m/\./g]} + 1; # +1 to match the ".${as_prefix}"
- if (my ($fail) = grep { @{[$_ =~ m/\./g]} == $dots }
- keys %{$collapse}) {
- my ($last) = ($fail =~ /([^\.]+)$/);
- carp (
- "Prefetching multiple has_many rels ${last} and ${pre} "
- .(length($as_prefix)
- ? "at the same level (${as_prefix}) "
- : "at top level "
- )
- . 'will explode the number of row objects retrievable via ->next or ->all. '
- . 'Use at your own risk.'
- );
- }
- #my @col = map { (/^self\.(.+)$/ ? ("${as_prefix}.$1") : ()); }
- # values %{$rel_info->{cond}};
- $collapse->{".${as_prefix}${pre}"} = [ $rel_source->primary_columns ];
- # action at a distance. prepending the '.' allows simpler code
- # in ResultSet->_collapse_result
- my @key = map { (/^foreign\.(.+)$/ ? ($1) : ()); }
- keys %{$rel_info->{cond}};
- my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
- ? @{$rel_info->{attrs}{order_by}}
- : (defined $rel_info->{attrs}{order_by}
- ? ($rel_info->{attrs}{order_by})
- : ()));
- push(@$order, map { "${as}.$_" } (@key, @ord));
- }
-
- return map { [ "${as}.$_", "${as_prefix}${pre}.$_", ] }
- $rel_source->columns;
- }
-}
-
# Accepts one or more relationships for the current source and returns an
# array of column names for each of those relationships. Column names are
# prefixed relative to the current source, in accordance with where they appear
-# in the supplied relationships. Needs an alias_map generated by
-# $rs->_joinpath_aliases
+# in the supplied relationships.
sub _resolve_prefetch {
my ($self, $pre, $alias, $alias_map, $order, $collapse, $pref_path) = @_;
@@ -1488,8 +1419,7 @@
my $as_prefix = ($alias =~ /^.*?\.(.+)$/ ? $1.'.' : '');
my $rel_source = $self->related_source($pre);
- if (exists $rel_info->{attrs}{accessor}
- && $rel_info->{attrs}{accessor} eq 'multi') {
+ if ($rel_info->{attrs}{accessor} && $rel_info->{attrs}{accessor} eq 'multi') {
$self->throw_exception(
"Can't prefetch has_many ${pre} (join cond too complex)")
unless ref($rel_info->{cond}) eq 'HASH';
@@ -1516,7 +1446,8 @@
keys %{$rel_info->{cond}};
my @ord = (ref($rel_info->{attrs}{order_by}) eq 'ARRAY'
? @{$rel_info->{attrs}{order_by}}
- : (defined $rel_info->{attrs}{order_by}
+
+ : (defined $rel_info->{attrs}{order_by}
? ($rel_info->{attrs}{order_by})
: ()));
push(@$order, map { "${as}.$_" } (@key, @ord));
@@ -1579,7 +1510,7 @@
=cut
sub handle {
- return new DBIx::Class::ResultSourceHandle({
+ return DBIx::Class::ResultSourceHandle->new({
schema => $_[0]->schema,
source_moniker => $_[0]->source_name
});
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSourceProxy.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSourceProxy.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/ResultSourceProxy.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -41,7 +41,9 @@
}
}
-*add_column = \&add_columns;
+sub add_column {
+ shift->add_columns(@_);
+}
sub has_column {
shift->result_source_instance->has_column(@_);
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Row.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Row.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Row.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -155,7 +155,7 @@
$new->result_source($source);
}
- if (my $related = delete $attrs->{-from_resultset}) {
+ if (my $related = delete $attrs->{-cols_from_relations}) {
@{$new->{_ignore_at_insert}={}}{@$related} = ();
}
@@ -171,9 +171,8 @@
$new->throw_exception("Can't do multi-create without result source")
unless $source;
my $info = $source->relationship_info($key);
- if ($info && $info->{attrs}{accessor}
- && $info->{attrs}{accessor} eq 'single')
- {
+ my $acc_type = $info->{attrs}{accessor} || '';
+ if ($acc_type eq 'single') {
my $rel_obj = delete $attrs->{$key};
if(!Scalar::Util::blessed($rel_obj)) {
$rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
@@ -188,9 +187,8 @@
$related->{$key} = $rel_obj;
next;
- } elsif ($info && $info->{attrs}{accessor}
- && $info->{attrs}{accessor} eq 'multi'
- && ref $attrs->{$key} eq 'ARRAY') {
+ }
+ elsif ($acc_type eq 'multi' && ref $attrs->{$key} eq 'ARRAY' ) {
my $others = delete $attrs->{$key};
my $total = @$others;
my @objects;
@@ -210,9 +208,8 @@
}
$related->{$key} = \@objects;
next;
- } elsif ($info && $info->{attrs}{accessor}
- && $info->{attrs}{accessor} eq 'filter')
- {
+ }
+ elsif ($acc_type eq 'filter') {
## 'filter' should disappear and get merged in with 'single' above!
my $rel_obj = delete $attrs->{$key};
if(!Scalar::Util::blessed($rel_obj)) {
@@ -424,7 +421,7 @@
sub in_storage {
my ($self, $val) = @_;
$self->{_in_storage} = $val if @_ > 1;
- return $self->{_in_storage};
+ return $self->{_in_storage} ? 1 : 0;
}
=head2 update
@@ -527,7 +524,9 @@
this behaviour off, pass C<< cascade_delete => 0 >> in the C<$attr>
hashref of the relationship, see L<DBIx::Class::Relationship>. Any
database-level cascade or restrict will take precedence over a
-DBIx-Class-based cascading delete.
+DBIx-Class-based cascading delete, since DBIx-Class B<deletes the
+main row first> and only then attempts to delete any remaining related
+rows.
If you delete an object within a txn_do() (see L<DBIx::Class::Storage/txn_do>)
and the transaction subsequently fails, the row object will remain marked as
@@ -751,12 +750,43 @@
sub get_inflated_columns {
my $self = shift;
- return map {
- my $accessor = $self->column_info($_)->{'accessor'} || $_;
- ($_ => $self->$accessor);
- } grep $self->has_column_loaded($_), $self->columns;
+
+ my %loaded_colinfo = (map
+ { $_ => $self->column_info($_) }
+ (grep { $self->has_column_loaded($_) } $self->columns)
+ );
+
+ my %inflated;
+ for my $col (keys %loaded_colinfo) {
+ if (exists $loaded_colinfo{$col}{accessor}) {
+ my $acc = $loaded_colinfo{$col}{accessor};
+ $inflated{$col} = $self->$acc if defined $acc;
+ }
+ else {
+ $inflated{$col} = $self->$col;
+ }
+ }
+
+ # return all loaded columns with the inflations overlayed on top
+ return ($self->get_columns, %inflated);
}
+sub _is_column_numeric {
+ my ($self, $column) = @_;
+ my $colinfo = $self->column_info ($column);
+
+ # cache for speed (the object may *not* have a resultsource instance)
+ if (not defined $colinfo->{is_numeric} && $self->_source_handle) {
+ $colinfo->{is_numeric} =
+ $self->result_source->schema->storage->is_datatype_numeric ($colinfo->{data_type})
+ ? 1
+ : 0
+ ;
+ }
+
+ return $colinfo->{is_numeric};
+}
+
=head2 set_column
$row->set_column($col => $val);
@@ -785,7 +815,7 @@
$self->{_orig_ident} ||= $self->ident_condition;
my $old_value = $self->get_column($column);
- $self->store_column($column, $new_value);
+ $new_value = $self->store_column($column, $new_value);
my $dirty;
if (!$self->in_storage) { # no point tracking dirtyness on uninserted data
@@ -801,18 +831,7 @@
$dirty = 0;
}
else { # do a numeric comparison if datatype allows it
- my $colinfo = $self->column_info ($column);
-
- # cache for speed (the object may *not* have a resultsource instance)
- if (not defined $colinfo->{is_numeric} && $self->_source_handle) {
- $colinfo->{is_numeric} =
- $self->result_source->schema->storage->is_datatype_numeric ($colinfo->{data_type})
- ? 1
- : 0
- ;
- }
-
- if ($colinfo->{is_numeric}) {
+ if ($self->_is_column_numeric($column)) {
$dirty = $old_value != $new_value;
}
else {
@@ -893,21 +912,18 @@
foreach my $key (keys %$upd) {
if (ref $upd->{$key}) {
my $info = $self->relationship_info($key);
- if ($info && $info->{attrs}{accessor}
- && $info->{attrs}{accessor} eq 'single')
- {
+ my $acc_type = $info->{attrs}{accessor} || '';
+ if ($acc_type eq 'single') {
my $rel = delete $upd->{$key};
$self->set_from_related($key => $rel);
$self->{_relationship_data}{$key} = $rel;
- } elsif ($info && $info->{attrs}{accessor}
- && $info->{attrs}{accessor} eq 'multi') {
- $self->throw_exception(
- "Recursive update is not supported over relationships of type multi ($key)"
- );
}
- elsif ($self->has_column($key)
- && exists $self->column_info($key)->{_inflate_info})
- {
+ elsif ($acc_type eq 'multi') {
+ $self->throw_exception(
+ "Recursive update is not supported over relationships of type '$acc_type' ($key)"
+ );
+ }
+ elsif ($self->has_column($key) && exists $self->column_info($key)->{_inflate_info}) {
$self->set_inflated_column($key, delete $upd->{$key});
}
}
@@ -1046,9 +1062,10 @@
my ($source_handle) = $source;
if ($source->isa('DBIx::Class::ResultSourceHandle')) {
- $source = $source_handle->resolve
- } else {
- $source_handle = $source->handle
+ $source = $source_handle->resolve
+ }
+ else {
+ $source_handle = $source->handle
}
my $new = {
@@ -1057,17 +1074,29 @@
};
bless $new, (ref $class || $class);
- my $schema;
foreach my $pre (keys %{$prefetch||{}}) {
- my $pre_val = $prefetch->{$pre};
- my $pre_source = $source->related_source($pre);
- $class->throw_exception("Can't prefetch non-existent relationship ${pre}")
- unless $pre_source;
- if (ref($pre_val->[0]) eq 'ARRAY') { # multi
- my @pre_objects;
- for my $me_pref (@$pre_val) {
+ my $pre_source = $source->related_source($pre)
+ or $class->throw_exception("Can't prefetch non-existent relationship ${pre}");
+ my $accessor = $source->relationship_info($pre)->{attrs}{accessor}
+ or $class->throw_exception("No accessor for prefetched $pre");
+
+ my @pre_vals;
+ if (ref $prefetch->{$pre}[0] eq 'ARRAY') {
+ @pre_vals = @{$prefetch->{$pre}};
+ }
+ elsif ($accessor eq 'multi') {
+ $class->throw_exception("Implicit prefetch (via select/columns) not supported with accessor 'multi'");
+ }
+ else {
+ @pre_vals = $prefetch->{$pre};
+ }
+
+ my @pre_objects;
+ for my $me_pref (@pre_vals) {
+
+ # FIXME - this should not be necessary
# the collapser currently *could* return bogus elements with all
# columns set to undef
my $has_def;
@@ -1082,29 +1111,16 @@
push @pre_objects, $pre_source->result_class->inflate_result(
$pre_source, @$me_pref
);
- }
+ }
- $new->related_resultset($pre)->set_cache(\@pre_objects);
- } elsif (defined $pre_val->[0]) {
- my $fetched;
- unless ($pre_source->primary_columns == grep { exists $pre_val->[0]{$_}
- and !defined $pre_val->[0]{$_} } $pre_source->primary_columns)
- {
- $fetched = $pre_source->result_class->inflate_result(
- $pre_source, @{$pre_val});
- }
- my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
- $class->throw_exception("No accessor for prefetched $pre")
- unless defined $accessor;
- if ($accessor eq 'single') {
- $new->{_relationship_data}{$pre} = $fetched;
- } elsif ($accessor eq 'filter') {
- $new->{_inflated_column}{$pre} = $fetched;
- } else {
- $class->throw_exception("Implicit prefetch (via select/columns) not supported with accessor '$accessor'");
- }
- $new->related_resultset($pre)->set_cache([ $fetched ]);
+ if ($accessor eq 'single') {
+ $new->{_relationship_data}{$pre} = $pre_objects[0];
}
+ elsif ($accessor eq 'filter') {
+ $new->{_inflated_column}{$pre} = $pre_objects[0];
+ }
+
+ $new->related_resultset($pre)->set_cache(\@pre_objects);
}
$new->in_storage (1);
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/SQLAHacks/MSSQL.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/SQLAHacks/MSSQL.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/SQLAHacks/MSSQL.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -5,29 +5,10 @@
use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
#
-# MSSQL is retarded wrt TOP (crappy limit) and ordering.
-# One needs to add a TOP to *all* ordered subqueries, if
-# TOP has been used in the statement at least once.
-# Do it here.
+# MSSQL does not support ... OVER() ... RNO limits
#
-sub select {
- my $self = shift;
-
- my ($sql, @bind) = $self->SUPER::select (@_);
-
- # ordering was requested and there are at least 2 SELECT/FROM pairs
- # (thus subquery), and there is no TOP specified
- if (
- $sql =~ /\bSELECT\b .+? \bFROM\b .+? \bSELECT\b .+? \bFROM\b/isx
- &&
- $sql !~ /^ \s* SELECT \s+ TOP \s+ \d+ /xi
- &&
- scalar $self->_order_by_chunks ($_[3]->{order_by})
- ) {
- $sql =~ s/^ \s* SELECT \s/SELECT TOP 100 PERCENT /xi;
- }
-
- return wantarray ? ($sql, @bind) : $sql;
+sub _rno_default_order {
+ return \ '(SELECT(1))';
}
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/SQLAHacks.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/SQLAHacks.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/SQLAHacks.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -9,6 +9,7 @@
use strict;
use warnings;
use Carp::Clan qw/^DBIx::Class|^SQL::Abstract/;
+use Sub::Name();
BEGIN {
# reinstall the carp()/croak() functions imported into SQL::Abstract
@@ -18,17 +19,15 @@
for my $f (qw/carp croak/) {
my $orig = \&{"SQL::Abstract::$f"};
- *{"SQL::Abstract::$f"} = sub {
-
- local $Carp::CarpLevel = 1; # even though Carp::Clan ignores this, $orig will not
-
- if (Carp::longmess() =~ /DBIx::Class::SQLAHacks::[\w]+ .+? called \s at/x) {
- __PACKAGE__->can($f)->(@_);
- }
- else {
- $orig->(@_);
- }
- }
+ *{"SQL::Abstract::$f"} = Sub::Name::subname "SQL::Abstract::$f" =>
+ sub {
+ if (Carp::longmess() =~ /DBIx::Class::SQLAHacks::[\w]+ .+? called \s at/x) {
+ __PACKAGE__->can($f)->(@_);
+ }
+ else {
+ goto $orig;
+ }
+ };
}
}
@@ -48,31 +47,62 @@
}
-# Slow but ANSI standard Limit/Offset support. DB2 uses this
+# ANSI standard Limit/Offset implementation. DB2 and MSSQL use this
sub _RowNumberOver {
my ($self, $sql, $order, $rows, $offset ) = @_;
- $offset += 1;
- my $last = $rows + $offset - 1;
- my ( $order_by ) = $self->_order_by( $order );
+ # get the select to make the final amount of columns equal the original one
+ my ($select) = $sql =~ /^ \s* SELECT \s+ (.+?) \s+ FROM/ix
+ or croak "Unrecognizable SELECT: $sql";
- $sql = <<"SQL";
-SELECT * FROM
-(
- SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
- $sql
- $order_by
- ) Q1
-) Q2
-WHERE ROW_NUM BETWEEN $offset AND $last
+ # get the order_by only (or make up an order if none exists)
+ my $order_by = $self->_order_by(
+ (delete $order->{order_by}) || $self->_rno_default_order
+ );
-SQL
+ # whatever is left of the order_by
+ my $group_having = $self->_order_by($order);
+ my $qalias = $self->_quote ($self->{_dbic_rs_attrs}{alias});
+
+ $sql = sprintf (<<EOS, $offset + 1, $offset + $rows, );
+
+SELECT $select FROM (
+ SELECT $qalias.*, ROW_NUMBER() OVER($order_by ) AS rno__row__index FROM (
+ ${sql}${group_having}
+ ) $qalias
+) $qalias WHERE rno__row__index BETWEEN %d AND %d
+
+EOS
+
+ $sql =~ s/\s*\n\s*/ /g; # easier to read in the debugger
return $sql;
}
-# Crappy Top based Limit/Offset support. MSSQL uses this currently,
-# but may have to switch to RowNumberOver one day
+# some databases are happy with OVER (), some need OVER (ORDER BY (SELECT (1)) )
+sub _rno_default_order {
+ return undef;
+}
+
+# Informix specific limit, almost like LIMIT/OFFSET
+sub _SkipFirst {
+ my ($self, $sql, $order, $rows, $offset) = @_;
+
+ $sql =~ s/^ \s* SELECT \s+ //ix
+ or croak "Unrecognizable SELECT: $sql";
+
+ return sprintf ('SELECT %s%s%s%s',
+ $offset
+ ? sprintf ('SKIP %d ', $offset)
+ : ''
+ ,
+ sprintf ('FIRST %d ', $rows),
+ $sql,
+ $self->_order_by ($order),
+ );
+}
+
+# Crappy Top based Limit/Offset support. Legacy from MSSQL.
sub _Top {
my ( $self, $sql, $order, $rows, $offset ) = @_;
@@ -377,7 +407,7 @@
$self->_sqlcase($func),
$self->_recurse_fields($args),
$as
- ? sprintf (' %s %s', $self->_sqlcase('as'), $as)
+ ? sprintf (' %s %s', $self->_sqlcase('as'), $self->_quote ($as) )
: ''
);
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Schema/Versioned.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Schema/Versioned.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Schema/Versioned.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,10 +1,9 @@
package # Hide from PAUSE
DBIx::Class::Version::Table;
-use base 'DBIx::Class';
+use base 'DBIx::Class::Core';
use strict;
use warnings;
-__PACKAGE__->load_components(qw/ Core/);
__PACKAGE__->table('dbix_class_schema_versions');
__PACKAGE__->add_columns
@@ -31,8 +30,7 @@
package # Hide from PAUSE
DBIx::Class::Version::TableCompat;
-use base 'DBIx::Class';
-__PACKAGE__->load_components(qw/ Core/);
+use base 'DBIx::Class::Core';
__PACKAGE__->table('SchemaVersions');
__PACKAGE__->add_columns
@@ -116,7 +114,7 @@
use Getopt::Long;
use MyApp::Schema;
- my ( $preversion, $help );
+ my ( $preversion, $help );
GetOptions(
'p|preversion:s' => \$preversion,
) or die pod2usage;
@@ -152,13 +150,13 @@
and we can safely deploy the DDL to it. However things are not always so simple.
if you want to initialise a pre-existing database where the DDL is not the same
-as the DDL for your current schema version then you will need a diff which
+as the DDL for your current schema version then you will need a diff which
converts the database's DDL to the current DDL. The best way to do this is
to get a dump of the database schema (without data) and save that in your
SQL directory as version 0.000 (the filename must be as with
-L<DBIx::Class::Schema/ddl_filename>) then create a diff using your create DDL
+L<DBIx::Class::Schema/ddl_filename>) then create a diff using your create DDL
script given above from version 0.000 to the current version. Then hand check
-and if necessary edit the resulting diff to ensure that it will apply. Once you have
+and if necessary edit the resulting diff to ensure that it will apply. Once you have
done all that you can do this:
if (!$schema->get_db_version()) {
@@ -170,7 +168,7 @@
$schema->upgrade();
In the case of an unversioned database the above code will create the
-dbix_class_schema_versions table and write version 0.000 to it, then
+dbix_class_schema_versions table and write version 0.000 to it, then
upgrade will then apply the diff we talked about creating in the previous paragraph
and then you're good to go.
@@ -180,10 +178,10 @@
use strict;
use warnings;
-use base 'DBIx::Class';
+use base 'DBIx::Class::Schema';
use Carp::Clan qw/^DBIx::Class/;
-use POSIX 'strftime';
+use Time::HiRes qw/gettimeofday/;
__PACKAGE__->mk_classdata('_filedata');
__PACKAGE__->mk_classdata('upgrade_directory');
@@ -260,58 +258,155 @@
=back
-Virtual method that should be overriden to create an upgrade file.
-This is useful in the case of upgrading across multiple versions
+Virtual method that should be overriden to create an upgrade file.
+This is useful in the case of upgrading across multiple versions
to concatenate several files to create one upgrade file.
You'll probably want the db_version retrieved via $self->get_db_version
-and the schema_version which is retrieved via $self->schema_version
+and the schema_version which is retrieved via $self->schema_version
=cut
sub create_upgrade_path {
- ## override this method
+ ## override this method
}
+=head2 ordered_schema_versions
+
+=over 4
+
+=item Returns: a list of version numbers, ordered from lowest to highest
+
+=back
+
+Virtual method that should be overriden to return an ordered list
+of schema versions. This is then used to produce a set of steps to
+upgrade through to achieve the required schema version.
+
+You may want the db_version retrieved via $self->get_db_version
+and the schema_version which is retrieved via $self->schema_version
+
+=cut
+
+sub ordered_schema_versions {
+ ## override this method
+}
+
=head2 upgrade
-Call this to attempt to upgrade your database from the version it is at to the version
-this DBIC schema is at. If they are the same it does nothing.
+Call this to attempt to upgrade your database from the version it
+is at to the version this DBIC schema is at. If they are the same
+it does nothing.
-It requires an SQL diff file to exist in you I<upgrade_directory>, normally you will
-have created this using L<DBIx::Class::Schema/create_ddl_dir>.
+It will call L</ordered_schema_versions> to retrieve an ordered
+list of schema versions (if ordered_schema_versions returns nothing
+then it is assumed you can do the upgrade as a single step). It
+then iterates through the list of versions between the current db
+version and the schema version applying one update at a time until
+all relvant updates are applied.
-If successful the dbix_class_schema_versions table is updated with the current
-DBIC schema version.
+The individual update steps are performed by using
+L</upgrade_single_step>, which will apply the update and also
+update the dbix_class_schema_versions table.
=cut
-sub upgrade
+sub upgrade {
+ my ($self) = @_;
+ my $db_version = $self->get_db_version();
+
+ # db unversioned
+ unless ($db_version) {
+ carp 'Upgrade not possible as database is unversioned. Please call install first.';
+ return;
+ }
+
+ # db and schema at same version. do nothing
+ if ( $db_version eq $self->schema_version ) {
+ carp "Upgrade not necessary\n";
+ return;
+ }
+
+ my @version_list = $self->ordered_schema_versions;
+
+ # if nothing returned then we preload with min/max
+ @version_list = ( $db_version, $self->schema_version )
+ unless ( scalar(@version_list) );
+
+ # catch the case of someone returning an arrayref
+ @version_list = @{ $version_list[0] }
+ if ( ref( $version_list[0] ) eq 'ARRAY' );
+
+ # remove all versions in list above the required version
+ while ( scalar(@version_list)
+ && ( $version_list[-1] ne $self->schema_version ) )
+ {
+ pop @version_list;
+ }
+
+ # remove all versions in list below the current version
+ while ( scalar(@version_list) && ( $version_list[0] ne $db_version ) ) {
+ shift @version_list;
+ }
+
+ # check we have an appropriate list of versions
+ if ( scalar(@version_list) < 2 ) {
+ die;
+ }
+
+ # do sets of upgrade
+ while ( scalar(@version_list) >= 2 ) {
+ $self->upgrade_single_step( $version_list[0], $version_list[1] );
+ shift @version_list;
+ }
+}
+
+=head2 upgrade_single_step
+
+=over 4
+
+=item Arguments: db_version - the version currently within the db
+
+=item Arguments: target_version - the version to upgrade to
+
+=back
+
+Call this to attempt to upgrade your database from the
+I<db_version> to the I<target_version>. If they are the same it
+does nothing.
+
+It requires an SQL diff file to exist in your I<upgrade_directory>,
+normally you will have created this using L<DBIx::Class::Schema/create_ddl_dir>.
+
+If successful the dbix_class_schema_versions table is updated with
+the I<target_version>.
+
+This method may be called repeatedly by the upgrade method to
+upgrade through a series of updates.
+
+=cut
+
+sub upgrade_single_step
{
- my ($self) = @_;
- my $db_version = $self->get_db_version();
+ my ($self,
+ $db_version,
+ $target_version) = @_;
- # db unversioned
- unless ($db_version) {
- carp 'Upgrade not possible as database is unversioned. Please call install first.';
- return;
- }
-
# db and schema at same version. do nothing
- if ($db_version eq $self->schema_version) {
+ if ($db_version eq $target_version) {
carp "Upgrade not necessary\n";
return;
}
# strangely the first time this is called can
- # differ to subsequent times. so we call it
+ # differ to subsequent times. so we call it
# here to be sure.
# XXX - just fix it
$self->storage->sqlt_type;
my $upgrade_file = $self->ddl_filename(
$self->storage->sqlt_type,
- $self->schema_version,
+ $target_version,
$self->upgrade_directory,
$db_version,
);
@@ -323,7 +418,7 @@
return;
}
- carp "\nDB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n";
+ carp "DB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n";
# backup if necessary then apply upgrade
$self->_filedata($self->_read_sql_file($upgrade_file));
@@ -331,7 +426,7 @@
$self->txn_do(sub { $self->do_upgrade() });
# set row in dbix_class_schema_versions table
- $self->_set_db_version;
+ $self->_set_db_version({version => $target_version});
}
=head2 do_upgrade
@@ -340,7 +435,7 @@
allows you to run your upgrade any way you please, you can call C<run_upgrade>
any number of times to run the actual SQL commands, and in between you can
sandwich your data upgrading. For example, first run all the B<CREATE>
-commands, then migrate your data from old to new tables/formats, then
+commands, then migrate your data from old to new tables/formats, then
issue the DROP commands when you are finished. Will run the whole file as it is by default.
=cut
@@ -349,7 +444,7 @@
{
my ($self) = @_;
- # just run all the commands (including inserts) in order
+ # just run all the commands (including inserts) in order
$self->run_upgrade(qr/.*?/);
}
@@ -374,7 +469,7 @@
$self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]);
for (@statements)
- {
+ {
$self->storage->debugobj->query_start($_) if $self->storage->debug;
$self->apply_statement($_);
$self->storage->debugobj->query_end($_) if $self->storage->debug;
@@ -393,7 +488,7 @@
sub apply_statement {
my ($self, $statement) = @_;
- $self->storage->dbh->do($_) or carp "SQL was:\n $_";
+ $self->storage->dbh->do($_) or carp "SQL was: $_";
}
=head2 get_db_version
@@ -408,12 +503,12 @@
my ($self, $rs) = @_;
my $vtable = $self->{vschema}->resultset('Table');
- my $version = 0;
- eval {
- my $stamp = $vtable->get_column('installed')->max;
- $version = $vtable->search({ installed => $stamp })->first->version;
+ my $version = eval {
+ $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } )
+ ->get_column ('version')
+ ->next;
};
- return $version;
+ return $version || 0;
}
=head2 schema_version
@@ -427,7 +522,7 @@
This is an overwritable method which is called just before the upgrade, to
allow you to make a backup of the database. Per default this method attempts
to call C<< $self->storage->backup >>, to run the standard backup on each
-database type.
+database type.
This method should return the name of the backup file, if appropriate..
@@ -472,9 +567,13 @@
my ($self, $args) = @_;
$args = {} unless $args;
+
$self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
my $vtable = $self->{vschema}->resultset('Table');
+ # useful when connecting from scripts etc
+ return if ($args->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $args->{ignore_version}));
+
# check for legacy versions table and move to new if exists
my $vschema_compat = DBIx::Class::VersionCompat->connect(@{$self->storage->connect_info()});
unless ($self->_source_exists($vtable)) {
@@ -486,8 +585,6 @@
}
}
- # useful when connecting from scripts etc
- return if ($args->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $args->{ignore_version}));
my $pversion = $self->get_db_version();
if($pversion eq $self->schema_version)
@@ -502,7 +599,7 @@
return 1;
}
- carp "Versions out of sync. This is " . $self->schema_version .
+ carp "Versions out of sync. This is " . $self->schema_version .
", your database contains version $pversion, please call upgrade on your Schema.\n";
}
@@ -544,7 +641,7 @@
$tr->parser->($tr, $$data);
}
- my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db,
+ my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db,
$dbic_tr->schema, $db,
{ ignore_constraint_names => 1, ignore_index_names => 1, caseopt => 1 });
@@ -574,24 +671,50 @@
my $version = $params->{version} ? $params->{version} : $self->schema_version;
my $vtable = $self->{vschema}->resultset('Table');
- $vtable->create({ version => $version,
- installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
- });
+ ##############################################################################
+ # !!! NOTE !!!
+ ##############################################################################
+ #
+ # The travesty below replaces the old nice timestamp format of %Y-%m-%d %H:%M:%S
+ # This is necessary since there are legitimate cases when upgrades can happen
+ # back to back within the same second. This breaks things since we relay on the
+ # ability to sort by the 'installed' value. The logical choice of an autoinc
+ # is not possible, as it will break multiple legacy installations. Also it is
+ # not possible to format the string sanely, as the column is a varchar(20).
+ # The 'v' character is added to the front of the string, so that any version
+ # formatted by this new function will sort _after_ any existing 200... strings.
+ my @tm = gettimeofday();
+ my @dt = gmtime ($tm[0]);
+ my $o = $vtable->create({
+ version => $version,
+ installed => sprintf("v%04d%02d%02d_%02d%02d%02d.%03.0f",
+ $dt[5] + 1900,
+ $dt[4] + 1,
+ $dt[3],
+ $dt[2],
+ $dt[1],
+ $dt[0],
+ $tm[1] / 1000, # convert to millisecs, format as up/down rounded int above
+ ),
+ });
}
sub _read_sql_file {
my $self = shift;
my $file = shift || return;
- my $fh;
- open $fh, "<$file" or carp("Can't open upgrade file, $file ($!)");
- my @data = split(/\n/, join('', <$fh>));
- @data = grep(!/^--/, @data);
- @data = split(/;/, join('', @data));
- close($fh);
- @data = grep { $_ && $_ !~ /^-- / } @data;
- @data = grep { $_ !~ /^(BEGIN|BEGIN TRANSACTION|COMMIT)/m } @data;
+ open my $fh, '<', $file or carp("Can't open upgrade file, $file ($!)");
+ my @data = split /\n/, join '', <$fh>;
+ close $fh;
+
+ @data = grep {
+ $_ &&
+ !/^--/ &&
+ !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/m
+ } split /;/,
+ join '', @data;
+
return \@data;
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Schema.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Schema.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Schema.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -5,7 +5,7 @@
use DBIx::Class::Exception;
use Carp::Clan qw/^DBIx::Class/;
-use Scalar::Util qw/weaken/;
+use Scalar::Util ();
use File::Spec;
use Sub::Name ();
use Module::Find();
@@ -33,8 +33,9 @@
__PACKAGE__->load_namespaces();
package Library::Schema::Result::CD;
- use base qw/DBIx::Class/;
- __PACKAGE__->load_components(qw/Core/); # for example
+ use base qw/DBIx::Class::Core/;
+
+ __PACKAGE__->load_components(qw/InflateColumn::DateTime/); # for example
__PACKAGE__->table('cd');
# Elsewhere in your code:
@@ -406,12 +407,10 @@
Set the storage class that will be instantiated when L</connect> is called.
If the classname starts with C<::>, the prefix C<DBIx::Class::Storage> is
-assumed by L</connect>.
+assumed by L</connect>.
You want to use this to set subclasses of L<DBIx::Class::Storage::DBI>
-in cases where the appropriate subclass is not autodetected, such as
-when dealing with MSSQL via L<DBD::Sybase>, in which case you'd set it
-to C<::DBI::Sybase::MSSQL>.
+in cases where the appropriate subclass is not autodetected.
If your storage type requires instantiation arguments, those are
defined as a second argument in the form of a hashref and the entire
@@ -631,13 +630,13 @@
This interface is preferred over using the individual methods L</txn_begin>,
L</txn_commit>, and L</txn_rollback> below.
-WARNING: If you are connected with C<AutoCommit => 0> the transaction is
+WARNING: If you are connected with C<< AutoCommit => 0 >> the transaction is
considered nested, and you will still need to call L</txn_commit> to write your
-changes when appropriate. You will also want to connect with C<auto_savepoint =>
-1> to get partial rollback to work, if the storage driver for your database
+changes when appropriate. You will also want to connect with C<< auto_savepoint =>
+1 >> to get partial rollback to work, if the storage driver for your database
supports it.
-Connecting with C<AutoCommit => 1> is recommended.
+Connecting with C<< AutoCommit => 1 >> is recommended.
=cut
@@ -910,7 +909,7 @@
no strict 'refs';
no warnings 'redefine';
foreach my $meth (qw/class source resultset/) {
- *{"${target}::${meth}"} =
+ *{"${target}::${meth}"} = Sub::Name::subname "${target}::${meth}" =>
sub { shift->schema->$meth(@_) };
}
}
@@ -1084,7 +1083,7 @@
$self->storage->deployment_statements($self, @_);
}
-=head2 create_ddl_dir (EXPERIMENTAL)
+=head2 create_ddl_dir
=over 4
@@ -1179,9 +1178,18 @@
=head2 dclone
-Recommeneded way of dcloning objects. This is needed to properly maintain
-references to the schema object (which itself is B<not> cloned.)
+=over 4
+=item Arguments: $object
+
+=item Return Value: dcloned $object
+
+=back
+
+Recommended way of dcloning L<DBIx::Class::Row> and L<DBIx::Class::ResultSet>
+objects so their references to the schema object
+(which itself is B<not> cloned) are properly maintained.
+
=cut
sub dclone {
@@ -1261,6 +1269,24 @@
$self->_register_source(@_);
}
+=head2 unregister_source
+
+=over 4
+
+=item Arguments: $moniker
+
+=back
+
+Removes the L<DBIx::Class::ResultSource> from the schema for the given moniker.
+
+=cut
+
+sub unregister_source {
+ my $self = shift;
+
+ $self->_unregister_source(@_);
+}
+
=head2 register_extra_source
=over 4
@@ -1287,7 +1313,7 @@
$source = $source->new({ %$source, source_name => $moniker });
$source->schema($self);
- weaken($source->{schema}) if ref($self);
+ Scalar::Util::weaken($source->{schema}) if ref($self);
my $rs_class = $source->result_class;
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,144 @@
+package DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server;
+
+use strict;
+use warnings;
+
+use base qw/
+ DBIx::Class::Storage::DBI::ADO
+ DBIx::Class::Storage::DBI::MSSQL
+/;
+use mro 'c3';
+
+sub _rebless {
+ my $self = shift;
+ $self->_identity_method('@@identity');
+}
+
+sub source_bind_attributes {
+ my $self = shift;
+ my ($source) = @_;
+
+ my $bind_attributes = $self->next::method(@_);
+
+ foreach my $column ($source->columns) {
+ $bind_attributes->{$column}{ado_size} ||= 8000; # max VARCHAR
+ }
+
+ return $bind_attributes;
+}
+
+sub bind_attribute_by_data_type {
+ my ($self, $data_type) = @_;
+
+ ($data_type = lc($data_type)) =~ s/\s+.*//;
+
+ my $max_size =
+ $self->_mssql_max_data_type_representation_size_in_bytes->{$data_type};
+
+ my $res = {};
+ $res->{ado_size} = $max_size if $max_size;
+
+ return $res;
+}
+
+# approximate
+# XXX needs to support varchar(max) and varbinary(max)
+sub _mssql_max_data_type_representation_size_in_bytes {
+ my $self = shift;
+
+ my $blob_max = $self->_get_dbh->{LongReadLen} || 32768;
+
+ return +{
+# MSSQL types
+ char => 8000,
+ varchar => 8000,
+ binary => 8000,
+ varbinary => 8000,
+ nchar => 8000,
+ nvarchar => 8000,
+ numeric => 100,
+ smallint => 100,
+ tinyint => 100,
+ smallmoney => 100,
+ bigint => 100,
+ bit => 100,
+ decimal => 100,
+ integer => 100,
+ int => 100,
+ money => 100,
+ float => 100,
+ real => 100,
+ uniqueidentifier => 100,
+ ntext => $blob_max,
+ text => $blob_max,
+ image => $blob_max,
+ date => 100,
+ datetime => 100,
+ datetime2 => 100,
+ datetimeoffset => 100,
+ smalldatetime => 100,
+ time => 100,
+ timestamp => 100,
+ cursor => 100,
+ hierarchyid => 100,
+ sql_variant => 100,
+ table => 100,
+ xml => $blob_max, # ???
+
+# some non-MSSQL types
+ serial => 100,
+ bigserial => 100,
+ varchar2 => 8000,
+ blob => $blob_max,
+ clob => $blob_max,
+ }
+}
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server - Support for Microsoft
+SQL Server via DBD::ADO
+
+=head1 SYNOPSIS
+
+This subclass supports MSSQL server connections via L<DBD::ADO>.
+
+=head1 DESCRIPTION
+
+The MSSQL specific functionality is provided by
+L<DBIx::Class::Storage::DBI::MSSQL>.
+
+=head2 CAVEATS
+
+=head3 identities
+
+C<_identity_method> is set to C<@@identity>, as C<SCOPE_IDENTITY()> doesn't work
+with L<DBD::ADO>. See L<DBIx::Class::Storage::DBI::MSSQL/IMPLEMENTATION NOTES>
+for caveats regarding this.
+
+=head3 truncation bug
+
+There is a bug with MSSQL ADO providers where data gets truncated based on the
+size of the bind sizes in the first prepare call:
+
+L<https://rt.cpan.org/Ticket/Display.html?id=52048>
+
+The C<ado_size> workaround is used (see L<DBD::ADO/"ADO Providers">) with the
+approximate maximum size of the data_type of the bound column, or 8000 (maximum
+VARCHAR size) if the data_type is not available.
+
+This code is incomplete and may be buggy. Particularly, C<VARCHAR(MAX)> is not
+supported yet. The data_type list for other DBs is also incomplete. Please
+report problems (and send patches.)
+
+=head1 AUTHOR
+
+See L<DBIx::Class/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ADO.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ADO.pm (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ADO.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,43 @@
+package # hide from PAUSE
+ DBIx::Class::Storage::DBI::ADO;
+
+use base 'DBIx::Class::Storage::DBI';
+
+sub _rebless {
+ my $self = shift;
+
+# check for MSSQL
+# XXX This should be using an OpenSchema method of some sort, but I don't know
+# how.
+# Current version is stolen from Sybase.pm
+ my $dbtype = eval {
+ @{$self->_get_dbh
+ ->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})
+ }[2]
+ };
+
+ unless ($@) {
+ $dbtype =~ s/\W/_/gi;
+ my $subclass = "DBIx::Class::Storage::DBI::ADO::${dbtype}";
+ if ($self->load_optional_class($subclass) && !$self->isa($subclass)) {
+ bless $self, $subclass;
+ $self->_rebless;
+ }
+ }
+}
+
+# Here I was just experimenting with ADO cursor types, left in as a comment in
+# case you want to as well. See the DBD::ADO docs.
+#sub _dbh_sth {
+# my ($self, $dbh, $sql) = @_;
+#
+# my $sth = $self->disable_sth_caching
+# ? $dbh->prepare($sql, { CursorType => 'adOpenStatic' })
+# : $dbh->prepare_cached($sql, { CursorType => 'adOpenStatic' }, 3);
+#
+# $self->throw_exception($dbh->errstr) if !$sth;
+#
+# $sth;
+#}
+
+1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/AmbiguousGlob.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/AmbiguousGlob.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/AmbiguousGlob.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -8,7 +8,7 @@
=head1 NAME
-DBIx::Class::Storage::DBI::AmbiguousGlob - Storage component for RDBMS supporting multicolumn in clauses
+DBIx::Class::Storage::DBI::AmbiguousGlob - Storage component for RDBMS choking on count(*)
=head1 DESCRIPTION
@@ -27,6 +27,9 @@
sub _subq_count_select {
my ($self, $source, $rs_attrs) = @_;
+
+ return $rs_attrs->{group_by} if $rs_attrs->{group_by};
+
my @pcols = map { join '.', $rs_attrs->{alias}, $_ } ($source->primary_columns);
return @pcols ? \@pcols : [ 1 ];
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/DB2.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/DB2.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/DB2.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -38,7 +38,7 @@
=head1 SYNOPSIS
# In your table classes
- __PACKAGE__->load_components(qw/PK::Auto Core/);
+ use base 'DBIx::Class::Core';
__PACKAGE__->set_primary_key('id');
=head1 DESCRIPTION
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Informix.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Informix.pm (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Informix.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,57 @@
+package DBIx::Class::Storage::DBI::Informix;
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+
+use mro 'c3';
+
+__PACKAGE__->mk_group_accessors('simple' => '__last_insert_id');
+
+sub _execute {
+ my $self = shift;
+ my ($op) = @_;
+ my ($rv, $sth, @rest) = $self->next::method(@_);
+ if ($op eq 'insert') {
+ $self->__last_insert_id($sth->{ix_sqlerrd}[1]);
+ }
+ return (wantarray ? ($rv, $sth, @rest) : $rv);
+}
+
+sub last_insert_id {
+ shift->__last_insert_id;
+}
+
+sub _sql_maker_opts {
+ my ( $self, $opts ) = @_;
+
+ if ( $opts ) {
+ $self->{_sql_maker_opts} = { %$opts };
+ }
+
+ return { limit_dialect => 'SkipFirst', %{$self->{_sql_maker_opts}||{}} };
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Informix - Base Storage Class for INFORMIX Support
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+This class implements storage-specific support for Informix
+
+=head1 AUTHORS
+
+See L<DBIx::Class/CONTRIBUTORS>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/MSSQL.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/MSSQL.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/MSSQL.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -160,7 +160,7 @@
# this should bring back the result of SELECT SCOPE_IDENTITY() we tacked
# on in _prep_for_execute above
- my ($identity) = $sth->fetchrow_array;
+ my ($identity) = eval { $sth->fetchrow_array };
# SCOPE_IDENTITY failed, but we can do something else
if ( (! $identity) && $self->_identity_method) {
@@ -178,6 +178,33 @@
sub last_insert_id { shift->_identity }
+#
+# MSSQL is retarded wrt ordered subselects. One needs to add a TOP
+# to *all* subqueries, but one also can't use TOP 100 PERCENT
+# http://sqladvice.com/forums/permalink/18496/22931/ShowThread.aspx#22931
+#
+sub _select_args_to_query {
+ my $self = shift;
+
+ my ($sql, $prep_bind, @rest) = $self->next::method (@_);
+
+ # see if this is an ordered subquery
+ my $attrs = $_[3];
+ if ( scalar $self->_parse_order_by ($attrs->{order_by}) ) {
+ $self->throw_exception(
+ 'An ordered subselect encountered - this is not safe! Please see "Ordered Subselects" in DBIx::Class::Storage::DBI::MSSQL
+ ') unless $attrs->{unsafe_subselect_ok};
+ my $max = 2 ** 32;
+ $sql =~ s/^ \s* SELECT \s/SELECT TOP $max /xi;
+ }
+
+ return wantarray
+ ? ($sql, $prep_bind, @rest)
+ : \[ "($sql)", @$prep_bind ]
+ ;
+}
+
+
# savepoint syntax is the same as in Sybase ASE
sub _svp_begin {
@@ -205,14 +232,35 @@
sub sqlt_type { 'SQLServer' }
-sub _sql_maker_opts {
- my ( $self, $opts ) = @_;
+sub _get_mssql_version {
+ my $self = shift;
- if ( $opts ) {
- $self->{_sql_maker_opts} = { %$opts };
+ my $data = $self->_get_dbh->selectrow_hashref('xp_msver ProductVersion');
+
+ if ($data->{Character_Value} =~ /^(\d+)\./) {
+ return $1;
+ } else {
+ $self->throw_exception(q{Your ProductVersion's Character_Value is missing or malformed!});
}
+}
- return { limit_dialect => 'Top', %{$self->{_sql_maker_opts}||{}} };
+sub sql_maker {
+ my $self = shift;
+
+ unless ($self->_sql_maker) {
+ unless ($self->{_sql_maker_opts}{limit_dialect}) {
+ my $version = eval { $self->_get_mssql_version; } || 0;
+
+ $self->{_sql_maker_opts} = {
+ limit_dialect => ($version >= 9 ? 'RowNumberOver' : 'Top'),
+ %{$self->{_sql_maker_opts}||{}}
+ };
+ }
+
+ my $maker = $self->next::method (@_);
+ }
+
+ return $self->_sql_maker;
}
1;
@@ -260,6 +308,54 @@
C<db_ddladmin> privilege, which is normally not included in the standard
write-permissions.
+=head2 Ordered Subselects
+
+If you attempted the following query (among many others) in Microsoft SQL
+Server
+
+ $rs->search ({}, {
+ prefetch => 'relation',
+ rows => 2,
+ offset => 3,
+ });
+
+You may be surprised to receive an exception. The reason for this is a quirk
+in the MSSQL engine itself, and sadly doesn't have a sensible workaround due
+to the way DBIC is built. DBIC can do truly wonderful things with the aid of
+subselects, and does so automatically when necessary. The list of situations
+when a subselect is necessary is long and still changes often, so it can not
+be exhaustively enumerated here. The general rule of thumb is a joined
+L<has_many|DBIx::Class::Relationship/has_many> relationship with limit/group
+applied to the left part of the join.
+
+In its "pursuit of standards" Microsft SQL Server goes to great lengths to
+forbid the use of ordered subselects. This breaks a very useful group of
+searches like "Give me things number 4 to 6 (ordered by name), and prefetch
+all their relations, no matter how many". While there is a hack which fools
+the syntax checker, the optimizer may B<still elect to break the subselect>.
+Testing has determined that while such breakage does occur (the test suite
+contains an explicit test which demonstrates the problem), it is relative
+rare. The benefits of ordered subselects are on the other hand too great to be
+outright disabled for MSSQL.
+
+Thus compromise between usability and perfection is the MSSQL-specific
+L<resultset attribute|DBIx::Class::ResultSet/ATTRIBUTES> C<unsafe_subselect_ok>.
+It is deliberately not possible to set this on the Storage level, as the user
+should inspect (and preferrably regression-test) the return of every such
+ResultSet individually. The example above would work if written like:
+
+ $rs->search ({}, {
+ unsafe_subselect_ok => 1,
+ prefetch => 'relation',
+ rows => 2,
+ offset => 3,
+ });
+
+If it is possible to rewrite the search() in a way that will avoid the need
+for this flag - you are urged to do so. If DBIC internals insist that an
+ordered subselect is necessary for an operation, and you believe there is a
+differnt/better way to get the same result - please file a bugreport.
+
=head1 AUTHOR
See L<DBIx::Class/CONTRIBUTORS>.
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC/DB2_400_SQL.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -43,8 +43,8 @@
=head1 SYNOPSIS
- # In your table classes
- __PACKAGE__->load_components(qw/PK::Auto Core/);
+ # In your result (table) classes
+ use base 'DBIx::Class::Core';
__PACKAGE__->set_primary_key('id');
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -175,6 +175,14 @@
}
}
+sub _get_mssql_version {
+ my $self = shift;
+
+ my ($version) = $self->_get_dbh->get_info(18) =~ /^(\d+)/;
+
+ return $version;
+}
+
1;
=head1 AUTHOR
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC/SQL_Anywhere.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC/SQL_Anywhere.pm (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC/SQL_Anywhere.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,28 @@
+package DBIx::Class::Storage::DBI::ODBC::SQL_Anywhere;
+
+use strict;
+use warnings;
+use base qw/DBIx::Class::Storage::DBI::SQLAnywhere/;
+use mro 'c3';
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::ODBC::SQL_Anywhere - Driver for using Sybase SQL
+Anywhere through ODBC
+
+=head1 SYNOPSIS
+
+All functionality is provided by L<DBIx::Class::Storage::DBI::SQLAnywhere>, see
+that module for details.
+
+=head1 AUTHOR
+
+See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/ODBC.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -21,33 +21,17 @@
}
}
-sub _dbh_last_insert_id {
- my ($self, $dbh, $source, $col) = @_;
-
- # punt: if there is no derived class for the specific backend, attempt
- # to use the DBI->last_insert_id, which may not be sufficient (see the
- # discussion of last_insert_id in perldoc DBI)
- return $dbh->last_insert_id(undef, undef, $source->from, $col);
-}
-
1;
=head1 NAME
DBIx::Class::Storage::DBI::ODBC - Base class for ODBC drivers
-=head1 SYNOPSIS
-
- # In your table classes
- __PACKAGE__->load_components(qw/Core/);
-
-
=head1 DESCRIPTION
This class simply provides a mechanism for discovering and loading a sub-class
for a specific ODBC backend. It should be transparent to the user.
-
=head1 AUTHORS
Marc Mims C<< <marc at questright.com> >>
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -9,15 +9,17 @@
=head1 SYNOPSIS
- # In your table classes
- __PACKAGE__->load_components(qw/PK::Auto Core/);
+ # In your result (table) classes
+ use base 'DBIx::Class::Core';
__PACKAGE__->add_columns({ id => { sequence => 'mysequence', auto_nextval => 1 } });
__PACKAGE__->set_primary_key('id');
__PACKAGE__->sequence('mysequence');
=head1 DESCRIPTION
-This class implements autoincrements for Oracle.
+This class implements base Oracle support. The subclass
+L<DBIx::Class::Storage::DBI::Oracle::WhereJoins> is for C<(+)> joins in Oracle
+versions before 9.
=head1 METHODS
@@ -53,8 +55,16 @@
my $sth;
+ my $source_name;
+ if ( ref $source->name ne 'SCALAR' ) {
+ $source_name = $source->name;
+ }
+ else {
+ $source_name = ${$source->name};
+ }
+
# check for fully-qualified name (eg. SCHEMA.TABLENAME)
- if ( my ( $schema, $table ) = $source->name =~ /(\w+)\.(\w+)/ ) {
+ if ( my ( $schema, $table ) = $source_name =~ /(\w+)\.(\w+)/ ) {
$sql = q{
SELECT trigger_body FROM ALL_TRIGGERS t
WHERE t.owner = ? AND t.table_name = ?
@@ -66,7 +76,7 @@
}
else {
$sth = $dbh->prepare($sql);
- $sth->execute( uc( $source->name ) );
+ $sth->execute( uc( $source_name ) );
}
while (my ($insert_trigger) = $sth->fetchrow_array) {
return uc($1) if $insert_trigger =~ m!(\w+)\.nextval!i; # col name goes here???
@@ -199,11 +209,15 @@
my $timestamp_tz_format = $ENV{NLS_TIMESTAMP_TZ_FORMAT} ||=
'YYYY-MM-DD HH24:MI:SS.FF TZHTZM';
- $self->_do_query("alter session set nls_date_format = '$date_format'");
$self->_do_query(
-"alter session set nls_timestamp_format = '$timestamp_format'");
+ "alter session set nls_date_format = '$date_format'"
+ );
$self->_do_query(
-"alter session set nls_timestamp_tz_format='$timestamp_tz_format'");
+ "alter session set nls_timestamp_format = '$timestamp_format'"
+ );
+ $self->_do_query(
+ "alter session set nls_timestamp_tz_format='$timestamp_tz_format'"
+ );
}
=head2 source_bind_attributes
@@ -223,37 +237,44 @@
=cut
-sub source_bind_attributes
+sub source_bind_attributes
{
- require DBD::Oracle;
- my $self = shift;
- my($source) = @_;
+ require DBD::Oracle;
+ my $self = shift;
+ my($source) = @_;
- my %bind_attributes;
+ my %bind_attributes;
- foreach my $column ($source->columns) {
- my $data_type = $source->column_info($column)->{data_type} || '';
- next unless $data_type;
+ foreach my $column ($source->columns) {
+ my $data_type = $source->column_info($column)->{data_type} || '';
+ next unless $data_type;
- my %column_bind_attrs = $self->bind_attribute_by_data_type($data_type);
+ my %column_bind_attrs = $self->bind_attribute_by_data_type($data_type);
- if ($data_type =~ /^[BC]LOB$/i) {
- $column_bind_attrs{'ora_type'} = uc($data_type) eq 'CLOB' ?
- DBD::Oracle::ORA_CLOB() :
- DBD::Oracle::ORA_BLOB();
- $column_bind_attrs{'ora_field'} = $column;
- }
+ if ($data_type =~ /^[BC]LOB$/i) {
+ if ($DBD::Oracle::VERSION eq '1.23') {
+ $self->throw_exception(
+"BLOB/CLOB support in DBD::Oracle == 1.23 is broken, use an earlier or later ".
+"version.\n\nSee: https://rt.cpan.org/Public/Bug/Display.html?id=46016\n"
+ );
+ }
- $bind_attributes{$column} = \%column_bind_attrs;
- }
+ $column_bind_attrs{'ora_type'} = uc($data_type) eq 'CLOB'
+ ? DBD::Oracle::ORA_CLOB()
+ : DBD::Oracle::ORA_BLOB()
+ ;
+ $column_bind_attrs{'ora_field'} = $column;
+ }
- return \%bind_attributes;
+ $bind_attributes{$column} = \%column_bind_attrs;
+ }
+
+ return \%bind_attributes;
}
sub _svp_begin {
- my ($self, $name) = @_;
-
- $self->_get_dbh->do("SAVEPOINT $name");
+ my ($self, $name) = @_;
+ $self->_get_dbh->do("SAVEPOINT $name");
}
# Oracle automatically releases a savepoint when you start another one with the
@@ -261,9 +282,48 @@
sub _svp_release { 1 }
sub _svp_rollback {
- my ($self, $name) = @_;
+ my ($self, $name) = @_;
+ $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
+}
- $self->_get_dbh->do("ROLLBACK TO SAVEPOINT $name")
+=head2 relname_to_table_alias
+
+L<DBIx::Class> uses L<DBIx::Class::Relationship> names as table aliases in
+queries.
+
+Unfortunately, Oracle doesn't support identifiers over 30 chars in length, so
+the L<DBIx::Class::Relationship> name is shortened and appended with half of an
+MD5 hash.
+
+See L<DBIx::Class::Storage/"relname_to_table_alias">.
+
+=cut
+
+sub relname_to_table_alias {
+ my $self = shift;
+ my ($relname, $join_count) = @_;
+
+ my $alias = $self->next::method(@_);
+
+ return $alias if length($alias) <= 30;
+
+ # get a base64 md5 of the alias with join_count
+ require Digest::MD5;
+ my $ctx = Digest::MD5->new;
+ $ctx->add($alias);
+ my $md5 = $ctx->b64digest;
+
+ # remove alignment mark just in case
+ $md5 =~ s/=*\z//;
+
+ # truncate and prepend to truncated relname without vowels
+ (my $devoweled = $relname) =~ s/[aeiou]//g;
+ my $shortened = substr($devoweled, 0, 18);
+
+ my $new_alias =
+ $shortened . '_' . substr($md5, 0, 30 - length($shortened) - 1);
+
+ return $new_alias;
}
=head1 AUTHOR
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Oracle.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Oracle.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Oracle.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -30,11 +30,6 @@
DBIx::Class::Storage::DBI::Oracle - Base class for Oracle driver
-=head1 SYNOPSIS
-
- # In your table classes
- __PACKAGE__->load_components(qw/Core/);
-
=head1 DESCRIPTION
This class simply provides a mechanism for discovering and loading a sub-class
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Pg.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Pg.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Pg.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -26,11 +26,11 @@
for my $col (@cols) {
my $seq = ( $source->column_info($col)->{sequence} ||= $self->dbh_do('_dbh_get_autoinc_seq', $source, $col) )
- or $self->throw_exception( "could not determine sequence for "
- . $source->name
- . ".$col, please consider adding a "
- . "schema-qualified sequence to its column info"
- );
+ or $self->throw_exception( sprintf(
+ 'could not determine sequence for column %s.%s, please consider adding a schema-qualified sequence to its column info',
+ $source->name,
+ $col,
+ ));
push @values, $self->_dbh_last_insert_id ($self->_dbh, $seq);
}
@@ -61,26 +61,22 @@
( $schema, $table ) = ( $1, $2 );
}
-### XXX This is unsafe in DBD::Pg 2.15.1, it can disconnect for some reason
-###
- # use DBD::Pg to fetch the column info if it is recent enough to
- # work. otherwise, use custom SQL
-# my $seq_expr = $DBD::Pg::VERSION >= 2.015001
-# ? eval{ $dbh->column_info(undef,$schema,$table,$col)->fetchrow_hashref->{COLUMN_DEF} }
-# : $self->_dbh_get_column_default( $dbh, $schema, $table, $col );
-
+ # get the column default using a Postgres-specific pg_catalog query
my $seq_expr = $self->_dbh_get_column_default( $dbh, $schema, $table, $col );
# if no default value is set on the column, or if we can't parse the
# default value as a sequence, throw.
- unless ( defined $seq_expr and $seq_expr =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i ){
+ unless ( defined $seq_expr and $seq_expr =~ /^nextval\(+'([^']+)'::(?:text|regclass)\)/i ) {
$seq_expr = '' unless defined $seq_expr;
$schema = "$schema." if defined $schema && length $schema;
- $self->throw_exception( "no sequence found for $schema$table.$col, check table definition, "
- . "or explicitly set the 'sequence' for this column in the "
- . $source->source_name
- . " class"
- );
+ $self->throw_exception( sprintf (
+ 'no sequence found for %s%s.%s, check the RDBMS table definition or explicitly set the '.
+ "'sequence' for this column in %s",
+ $schema ? "$schema." : '',
+ $table,
+ $col,
+ $source->source_name,
+ ));
}
return $1;
@@ -193,8 +189,8 @@
=head1 SYNOPSIS
- # In your table classes
- __PACKAGE__->load_components(qw/PK::Auto Core/);
+ # In your result (table) classes
+ use base 'DBIx::Class::Core';
__PACKAGE__->set_primary_key('id');
__PACKAGE__->sequence('mysequence');
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated/Introduction.pod
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated/Introduction.pod 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated/Introduction.pod 2010-02-10 22:41:54 UTC (rev 8606)
@@ -89,26 +89,25 @@
you use (or upgrade to) the latest L<Catalyst::Model::DBIC::Schema>, which makes
this job even easier.
-First, you need to connect your L<DBIx::Class::Schema>. Let's assume you have
-such a schema called, "MyApp::Schema".
+First, you need to get a C<$schema> object and set the storage_type:
- use MyApp::Schema;
- my $schema = MyApp::Schema->connect($dsn, $user, $pass);
+ my $schema = MyApp::Schema->clone;
+ $schema->storage_type([
+ '::DBI::Replicated' => {
+ balancer_type => '::Random',
+ balancer_args => {
+ auto_validate_every => 5,
+ master_read_weight => 1
+ },
+ pool_args => {
+ maximum_lag =>2,
+ },
+ }
+ ]);
-Next, you need to set the storage_type.
+Then, you need to connect your L<DBIx::Class::Schema>.
- $schema->storage_type(
- ::DBI::Replicated' => {
- balancer_type => '::Random',
- balancer_args => {
- auto_validate_every => 5,
- master_read_weight => 1
- },
- pool_args => {
- maximum_lag =>2,
- },
- }
- );
+ $schema->connection($dsn, $user, $pass);
Let's break down the settings. The method L<DBIx::Class::Schema/storage_type>
takes one mandatory parameter, a scalar value, and an option second value which
@@ -160,11 +159,11 @@
After you've configured the replicated storage, you need to add the connection
information for the replicants:
- $schema->storage->connect_replicants(
- [$dsn1, $user, $pass, \%opts],
- [$dsn2, $user, $pass, \%opts],
- [$dsn3, $user, $pass, \%opts],
- );
+ $schema->storage->connect_replicants(
+ [$dsn1, $user, $pass, \%opts],
+ [$dsn2, $user, $pass, \%opts],
+ [$dsn3, $user, $pass, \%opts],
+ );
These replicants should be configured as slaves to the master using the
instructions for MySQL native replication, or if you are just learning, you
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated/Pool.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,13 +1,13 @@
package DBIx::Class::Storage::DBI::Replicated::Pool;
use Moose;
-use MooseX::AttributeHelpers;
use DBIx::Class::Storage::DBI::Replicated::Replicant;
use List::Util 'sum';
use Scalar::Util 'reftype';
use DBI ();
use Carp::Clan qw/^DBIx::Class/;
use MooseX::Types::Moose qw/Num Int ClassName HashRef/;
+use DBIx::Class::Storage::DBI::Replicated::Types 'DBICStorageDBI';
use namespace::clean -except => 'meta';
@@ -125,29 +125,42 @@
has 'replicants' => (
is=>'rw',
- metaclass => 'Collection::Hash',
+ traits => ['Hash'],
isa=>HashRef['Object'],
default=>sub {{}},
- provides => {
- 'set' => 'set_replicant',
- 'get' => 'get_replicant',
- 'empty' => 'has_replicants',
- 'count' => 'num_replicants',
- 'delete' => 'delete_replicant',
- 'values' => 'all_replicant_storages',
+ handles => {
+ 'set_replicant' => 'set',
+ 'get_replicant' => 'get',
+ 'has_replicants' => 'is_empty',
+ 'num_replicants' => 'count',
+ 'delete_replicant' => 'delete',
+ 'all_replicant_storages' => 'values',
},
);
+around has_replicants => sub {
+ my ($orig, $self) = @_;
+ return !$self->$orig;
+};
+
has next_unknown_replicant_id => (
is => 'rw',
- metaclass => 'Counter',
+ traits => ['Counter'],
isa => Int,
default => 1,
- provides => {
- inc => 'inc_unknown_replicant_id'
+ handles => {
+ 'inc_unknown_replicant_id' => 'inc',
},
);
+=head2 master
+
+Reference to the master Storage.
+
+=cut
+
+has master => (is => 'rw', isa => DBICStorageDBI, weak_ref => 1);
+
=head1 METHODS
This class defines the following methods.
@@ -239,7 +252,13 @@
$replicant->_determine_driver
});
- DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant);
+ Moose::Meta::Class->initialize(ref $replicant);
+
+ DBIx::Class::Storage::DBI::Replicated::Replicant->meta->apply($replicant);
+
+ # link back to master
+ $replicant->master($self->master);
+
return $replicant;
}
@@ -276,16 +295,15 @@
eval {
$code->()
- };
+ };
if ($@) {
- $replicant
- ->debugobj
- ->print(
- sprintf( "Exception trying to $name for replicant %s, error is %s",
- $replicant->_dbi_connect_info->[0], $@)
- );
- return;
+ $replicant->debugobj->print(sprintf(
+ "Exception trying to $name for replicant %s, error is %s",
+ $replicant->_dbi_connect_info->[0], $@)
+ );
+ return undef;
}
+
return 1;
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated/Replicant.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -4,6 +4,7 @@
requires qw/_query_start/;
with 'DBIx::Class::Storage::DBI::Replicated::WithDSN';
use MooseX::Types::Moose qw/Bool Str/;
+use DBIx::Class::Storage::DBI::Replicated::Types 'DBICStorageDBI';
use namespace::clean -except => 'meta';
@@ -55,6 +56,14 @@
has dsn => (is => 'rw', isa => Str);
has id => (is => 'rw', isa => Str);
+=head2 master
+
+Reference to the master Storage.
+
+=cut
+
+has master => (is => 'rw', isa => DBICStorageDBI, weak_ref => 1);
+
=head1 METHODS
This class defines the following methods.
@@ -66,7 +75,9 @@
=cut
sub debugobj {
- return shift->schema->storage->debugobj;
+ my $self = shift;
+
+ return $self->master->debugobj;
}
=head1 ALSO SEE
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Replicated.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -7,9 +7,8 @@
## use, so we explicitly test for these.
my %replication_required = (
- 'Moose' => '0.87',
- 'MooseX::AttributeHelpers' => '0.21',
- 'MooseX::Types' => '0.16',
+ 'Moose' => '0.98',
+ 'MooseX::Types' => '0.21',
'namespace::clean' => '0.11',
'Hash::Merge' => '0.11'
);
@@ -51,7 +50,9 @@
also define your arguments, such as which balancer you want and any arguments
that the Pool object should get.
+ my $schema = Schema::Class->clone;
$schema->storage_type( ['::DBI::Replicated', {balancer=>'::Random'}] );
+ $schema->connection(...);
Next, you need to add in the Replicants. Basically this is an array of
arrayrefs, where each arrayref is database connect information. Think of these
@@ -119,9 +120,8 @@
Replicated Storage has additional requirements not currently part of L<DBIx::Class>
- Moose => '0.87',
- MooseX::AttributeHelpers => '0.20',
- MooseX::Types => '0.16',
+ Moose => '0.98',
+ MooseX::Types => '0.21',
namespace::clean => '0.11',
Hash::Merge => '0.11'
@@ -328,6 +328,8 @@
svp_rollback
svp_begin
svp_release
+ relname_to_table_alias
+ _straight_join_to_node
/],
);
@@ -391,8 +393,12 @@
my $master = $self->master;
$master->_determine_driver;
Moose::Meta::Class->initialize(ref $master);
+
DBIx::Class::Storage::DBI::Replicated::WithDSN->meta->apply($master);
+ # link pool back to master
+ $self->pool->master($master);
+
$wantarray ? @res : $res;
};
@@ -409,7 +415,7 @@
=cut
sub BUILDARGS {
- my ($class, $schema, $storage_type_args, @args) = @_;
+ my ($class, $schema, $storage_type_args, @args) = @_;
return {
schema=>$schema,
@@ -744,50 +750,35 @@
=head2 debugobj
-set a debug object across all storages
+set a debug object
=cut
sub debugobj {
my $self = shift @_;
- if(@_) {
- foreach my $source ($self->all_storages) {
- $source->debugobj(@_);
- }
- }
- return $self->master->debugobj;
+ return $self->master->debugobj(@_);
}
=head2 debugfh
-set a debugfh object across all storages
+set a debugfh object
=cut
sub debugfh {
my $self = shift @_;
- if(@_) {
- foreach my $source ($self->all_storages) {
- $source->debugfh(@_);
- }
- }
- return $self->master->debugfh;
+ return $self->master->debugfh(@_);
}
=head2 debugcb
-set a debug callback across all storages
+set a debug callback
=cut
sub debugcb {
my $self = shift @_;
- if(@_) {
- foreach my $source ($self->all_storages) {
- $source->debugcb(@_);
- }
- }
- return $self->master->debugcb;
+ return $self->master->debugcb(@_);
}
=head2 disconnect
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/SQLAnywhere.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,135 @@
+package DBIx::Class::Storage::DBI::SQLAnywhere;
+
+use strict;
+use warnings;
+use base qw/DBIx::Class::Storage::DBI/;
+use mro 'c3';
+use List::Util ();
+
+__PACKAGE__->mk_group_accessors(simple => qw/
+ _identity
+/);
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::SQLAnywhere - Driver for Sybase SQL Anywhere
+
+=head1 DESCRIPTION
+
+This class implements autoincrements for Sybase SQL Anywhere, selects the
+RowNumberOver limit implementation and provides
+L<DBIx::Class::InflateColumn::DateTime> support.
+
+You need the C<DBD::SQLAnywhere> driver that comes with the SQL Anywhere
+distribution, B<NOT> the one on CPAN. It is usually under a path such as:
+
+ /opt/sqlanywhere11/sdk/perl
+
+Recommended L<DBIx::Class::Storage::DBI/connect_info> settings:
+
+ on_connect_call => 'datetime_setup'
+
+=head1 METHODS
+
+=cut
+
+sub last_insert_id { shift->_identity }
+
+sub insert {
+ my $self = shift;
+ my ($source, $to_insert) = @_;
+
+ my $identity_col = List::Util::first {
+ $source->column_info($_)->{is_auto_increment}
+ } $source->columns;
+
+# user might have an identity PK without is_auto_increment
+ if (not $identity_col) {
+ foreach my $pk_col ($source->primary_columns) {
+ if (not exists $to_insert->{$pk_col}) {
+ $identity_col = $pk_col;
+ last;
+ }
+ }
+ }
+
+ if ($identity_col && (not exists $to_insert->{$identity_col})) {
+ my $dbh = $self->_get_dbh;
+ my $table_name = $source->from;
+ $table_name = $$table_name if ref $table_name;
+
+ my ($identity) = $dbh->selectrow_array("SELECT GET_IDENTITY('$table_name')");
+
+ $to_insert->{$identity_col} = $identity;
+
+ $self->_identity($identity);
+ }
+
+ return $self->next::method(@_);
+}
+
+# this sub stolen from DB2
+
+sub _sql_maker_opts {
+ my ( $self, $opts ) = @_;
+
+ if ( $opts ) {
+ $self->{_sql_maker_opts} = { %$opts };
+ }
+
+ return { limit_dialect => 'RowNumberOver', %{$self->{_sql_maker_opts}||{}} };
+}
+
+# this sub stolen from MSSQL
+
+sub build_datetime_parser {
+ my $self = shift;
+ my $type = "DateTime::Format::Strptime";
+ eval "use ${type}";
+ $self->throw_exception("Couldn't load ${type}: $@") if $@;
+ return $type->new( pattern => '%Y-%m-%d %H:%M:%S.%6N' );
+}
+
+=head2 connect_call_datetime_setup
+
+Used as:
+
+ on_connect_call => 'datetime_setup'
+
+In L<DBIx::Class::Storage::DBI/connect_info> to set the date and timestamp
+formats (as temporary options for the session) for use with
+L<DBIx::Class::InflateColumn::DateTime>.
+
+The C<TIMESTAMP> data type supports up to 6 digits after the decimal point for
+second precision. The full precision is used.
+
+The C<DATE> data type supposedly stores hours and minutes too, according to the
+documentation, but I could not get that to work. It seems to only store the
+date.
+
+You will need the L<DateTime::Format::Strptime> module for inflation to work.
+
+=cut
+
+sub connect_call_datetime_setup {
+ my $self = shift;
+
+ $self->_do_query(
+ "set temporary option timestamp_format = 'yyyy-mm-dd hh:mm:ss.ssssss'"
+ );
+ $self->_do_query(
+ "set temporary option date_format = 'yyyy-mm-dd hh:mm:ss.ssssss'"
+ );
+}
+
+1;
+
+=head1 AUTHOR
+
+See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/SQLite.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/SQLite.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/SQLite.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -10,11 +10,6 @@
use File::Copy;
use File::Spec;
-sub _dbh_last_insert_id {
- my ($self, $dbh, $source, $col) = @_;
- $dbh->func('last_insert_rowid');
-}
-
sub backup
{
my ($self, $dir) = @_;
@@ -74,7 +69,7 @@
=head1 SYNOPSIS
# In your table classes
- __PACKAGE__->load_components(qw/PK::Auto Core/);
+ use base 'DBIx::Class::Core';
__PACKAGE__->set_primary_key('id');
=head1 DESCRIPTION
Copied: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/ASE/NoBindVars.pm (from rev 7836, DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm)
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/ASE/NoBindVars.pm (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/ASE/NoBindVars.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,102 @@
+package DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars;
+
+use base qw/
+ DBIx::Class::Storage::DBI::NoBindVars
+ DBIx::Class::Storage::DBI::Sybase::ASE
+/;
+use mro 'c3';
+use List::Util ();
+use Scalar::Util ();
+
+sub _init {
+ my $self = shift;
+ $self->disable_sth_caching(1);
+ $self->_identity_method('@@IDENTITY');
+ $self->next::method (@_);
+}
+
+sub _fetch_identity_sql { 'SELECT ' . $_[0]->_identity_method }
+
+my $number = sub { Scalar::Util::looks_like_number($_[0]) };
+
+my $decimal = sub { $_[0] =~ /^ [-+]? \d+ (?:\.\d*)? \z/x };
+
+my %noquote = (
+ int => sub { $_[0] =~ /^ [-+]? \d+ \z/x },
+ bit => => sub { $_[0] =~ /^[01]\z/ },
+ money => sub { $_[0] =~ /^\$ \d+ (?:\.\d*)? \z/x },
+ float => $number,
+ real => $number,
+ double => $number,
+ decimal => $decimal,
+ numeric => $decimal,
+);
+
+sub interpolate_unquoted {
+ my $self = shift;
+ my ($type, $value) = @_;
+
+ return $self->next::method(@_) if not defined $value or not defined $type;
+
+ if (my $key = List::Util::first { $type =~ /$_/i } keys %noquote) {
+ return 1 if $noquote{$key}->($value);
+ }
+ elsif ($self->is_datatype_numeric($type) && $number->($value)) {
+ return 1;
+ }
+
+ return $self->next::method(@_);
+}
+
+sub _prep_interpolated_value {
+ my ($self, $type, $value) = @_;
+
+ if ($type =~ /money/i && defined $value) {
+ # change a ^ not followed by \$ to a \$
+ $value =~ s/^ (?! \$) /\$/x;
+ }
+
+ return $value;
+}
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars - Storage::DBI subclass for
+Sybase ASE without placeholder support
+
+=head1 DESCRIPTION
+
+If you're using this driver than your version of Sybase, or the libraries you
+use to connect to it, do not support placeholders.
+
+You can also enable this driver explicitly using:
+
+ my $schema = SchemaClass->clone;
+ $schema->storage_type('::DBI::Sybase::ASE::NoBindVars');
+ $schema->connect($dsn, $user, $pass, \%opts);
+
+See the discussion in L<< DBD::Sybase/Using ? Placeholders & bind parameters to
+$sth->execute >> for details on the pros and cons of using placeholders.
+
+One advantage of not using placeholders is that C<select @@identity> will work
+for obtainging the last insert id of an C<IDENTITY> column, instead of having to
+do C<select max(col)> in a transaction as the base Sybase driver does.
+
+When using this driver, bind variables will be interpolated (properly quoted of
+course) into the SQL query itself, without using placeholders.
+
+The caching of prepared statements is also explicitly disabled, as the
+interpolation renders it useless.
+
+=head1 AUTHORS
+
+See L<DBIx::Class/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+# vim:sts=2 sw=2:
Copied: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm (from rev 7836, DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase.pm)
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,1173 @@
+package DBIx::Class::Storage::DBI::Sybase::ASE;
+
+use strict;
+use warnings;
+
+use base qw/
+ DBIx::Class::Storage::DBI::Sybase
+ DBIx::Class::Storage::DBI::AutoCast
+/;
+use mro 'c3';
+use Carp::Clan qw/^DBIx::Class/;
+use Scalar::Util();
+use List::Util();
+use Sub::Name();
+use Data::Dumper::Concise();
+
+__PACKAGE__->mk_group_accessors('simple' =>
+ qw/_identity _blob_log_on_update _writer_storage _is_extra_storage
+ _bulk_storage _is_bulk_storage _began_bulk_work
+ _bulk_disabled_due_to_coderef_connect_info_warned
+ _identity_method/
+);
+
+my @also_proxy_to_extra_storages = qw/
+ connect_call_set_auto_cast auto_cast connect_call_blob_setup
+ connect_call_datetime_setup
+
+ disconnect _connect_info _sql_maker _sql_maker_opts disable_sth_caching
+ auto_savepoint unsafe cursor_class debug debugobj schema
+/;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase::ASE - Sybase ASE SQL Server support for
+DBIx::Class
+
+=head1 SYNOPSIS
+
+This subclass supports L<DBD::Sybase> for real (non-Microsoft) Sybase databases.
+
+=head1 DESCRIPTION
+
+If your version of Sybase does not support placeholders, then your storage will
+be reblessed to L<DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars>.
+You can also enable that driver explicitly, see the documentation for more
+details.
+
+With this driver there is unfortunately no way to get the C<last_insert_id>
+without doing a C<SELECT MAX(col)>. This is done safely in a transaction
+(locking the table.) See L</INSERTS WITH PLACEHOLDERS>.
+
+A recommended L<DBIx::Class::Storage::DBI/connect_info> setting:
+
+ on_connect_call => [['datetime_setup'], ['blob_setup', log_on_update => 0]]
+
+=head1 METHODS
+
+=cut
+
+sub _rebless {
+ my $self = shift;
+
+ my $no_bind_vars = __PACKAGE__ . '::NoBindVars';
+
+ if ($self->using_freetds) {
+ carp <<'EOF' unless $ENV{DBIC_SYBASE_FREETDS_NOWARN};
+
+You are using FreeTDS with Sybase.
+
+We will do our best to support this configuration, but please consider this
+support experimental.
+
+TEXT/IMAGE columns will definitely not work.
+
+You are encouraged to recompile DBD::Sybase with the Sybase Open Client libraries
+instead.
+
+See perldoc DBIx::Class::Storage::DBI::Sybase::ASE for more details.
+
+To turn off this warning set the DBIC_SYBASE_FREETDS_NOWARN environment
+variable.
+EOF
+
+ if (not $self->_typeless_placeholders_supported) {
+ if ($self->_placeholders_supported) {
+ $self->auto_cast(1);
+ }
+ else {
+ $self->ensure_class_loaded($no_bind_vars);
+ bless $self, $no_bind_vars;
+ $self->_rebless;
+ }
+ }
+ }
+
+ elsif (not $self->_get_dbh->{syb_dynamic_supported}) {
+ # not necessarily FreeTDS, but no placeholders nevertheless
+ $self->ensure_class_loaded($no_bind_vars);
+ bless $self, $no_bind_vars;
+ $self->_rebless;
+ }
+ # this is highly unlikely, but we check just in case
+ elsif (not $self->_typeless_placeholders_supported) {
+ $self->auto_cast(1);
+ }
+}
+
+sub _init {
+ my $self = shift;
+ $self->_set_max_connect(256);
+
+# create storage for insert/(update blob) transactions,
+# unless this is that storage
+ return if $self->_is_extra_storage;
+
+ my $writer_storage = (ref $self)->new;
+
+ $writer_storage->_is_extra_storage(1);
+ $writer_storage->connect_info($self->connect_info);
+ $writer_storage->auto_cast($self->auto_cast);
+
+ $self->_writer_storage($writer_storage);
+
+# create a bulk storage unless connect_info is a coderef
+ return if ref($self->_dbi_connect_info->[0]) eq 'CODE';
+
+ my $bulk_storage = (ref $self)->new;
+
+ $bulk_storage->_is_extra_storage(1);
+ $bulk_storage->_is_bulk_storage(1); # for special ->disconnect acrobatics
+ $bulk_storage->connect_info($self->connect_info);
+
+# this is why
+ $bulk_storage->_dbi_connect_info->[0] .= ';bulkLogin=1';
+
+ $self->_bulk_storage($bulk_storage);
+}
+
+for my $method (@also_proxy_to_extra_storages) {
+ no strict 'refs';
+ no warnings 'redefine';
+
+ my $replaced = __PACKAGE__->can($method);
+
+ *{$method} = Sub::Name::subname $method => sub {
+ my $self = shift;
+ $self->_writer_storage->$replaced(@_) if $self->_writer_storage;
+ $self->_bulk_storage->$replaced(@_) if $self->_bulk_storage;
+ return $self->$replaced(@_);
+ };
+}
+
+sub disconnect {
+ my $self = shift;
+
+# Even though we call $sth->finish for uses off the bulk API, there's still an
+# "active statement" warning on disconnect, which we throw away here.
+# This is due to the bug described in insert_bulk.
+# Currently a noop because 'prepare' is used instead of 'prepare_cached'.
+ local $SIG{__WARN__} = sub {
+ warn $_[0] unless $_[0] =~ /active statement/i;
+ } if $self->_is_bulk_storage;
+
+# so that next transaction gets a dbh
+ $self->_began_bulk_work(0) if $self->_is_bulk_storage;
+
+ $self->next::method;
+}
+
+# Set up session settings for Sybase databases for the connection.
+#
+# Make sure we have CHAINED mode turned on if AutoCommit is off in non-FreeTDS
+# DBD::Sybase (since we don't know how DBD::Sybase was compiled.) If however
+# we're using FreeTDS, CHAINED mode turns on an implicit transaction which we
+# only want when AutoCommit is off.
+#
+# Also SET TEXTSIZE for FreeTDS because LongReadLen doesn't work.
+sub _run_connection_actions {
+ my $self = shift;
+
+ if ($self->_is_bulk_storage) {
+# this should be cleared on every reconnect
+ $self->_began_bulk_work(0);
+ return;
+ }
+
+ if (not $self->using_freetds) {
+ $self->_dbh->{syb_chained_txn} = 1;
+ } else {
+ # based on LongReadLen in connect_info
+ $self->set_textsize;
+
+ if ($self->_dbh_autocommit) {
+ $self->_dbh->do('SET CHAINED OFF');
+ } else {
+ $self->_dbh->do('SET CHAINED ON');
+ }
+ }
+
+ $self->next::method(@_);
+}
+
+=head2 connect_call_blob_setup
+
+Used as:
+
+ on_connect_call => [ [ 'blob_setup', log_on_update => 0 ] ]
+
+Does C<< $dbh->{syb_binary_images} = 1; >> to return C<IMAGE> data as raw binary
+instead of as a hex string.
+
+Recommended.
+
+Also sets the C<log_on_update> value for blob write operations. The default is
+C<1>, but C<0> is better if your database is configured for it.
+
+See
+L<DBD::Sybase/Handling_IMAGE/TEXT_data_with_syb_ct_get_data()/syb_ct_send_data()>.
+
+=cut
+
+sub connect_call_blob_setup {
+ my $self = shift;
+ my %args = @_;
+ my $dbh = $self->_dbh;
+ $dbh->{syb_binary_images} = 1;
+
+ $self->_blob_log_on_update($args{log_on_update})
+ if exists $args{log_on_update};
+}
+
+sub _is_lob_type {
+ my $self = shift;
+ my $type = shift;
+ $type && $type =~ /(?:text|image|lob|bytea|binary|memo)/i;
+}
+
+sub _is_lob_column {
+ my ($self, $source, $column) = @_;
+
+ return $self->_is_lob_type($source->column_info($column)->{data_type});
+}
+
+sub _prep_for_execute {
+ my $self = shift;
+ my ($op, $extra_bind, $ident, $args) = @_;
+
+ my ($sql, $bind) = $self->next::method (@_);
+
+ my $table = Scalar::Util::blessed($ident) ? $ident->from : $ident;
+
+ my $bind_info = $self->_resolve_column_info(
+ $ident, [map $_->[0], @{$bind}]
+ );
+ my $bound_identity_col = List::Util::first
+ { $bind_info->{$_}{is_auto_increment} }
+ (keys %$bind_info)
+ ;
+ my $identity_col = Scalar::Util::blessed($ident) &&
+ List::Util::first
+ { $ident->column_info($_)->{is_auto_increment} }
+ $ident->columns
+ ;
+
+ if (($op eq 'insert' && $bound_identity_col) ||
+ ($op eq 'update' && exists $args->[0]{$identity_col})) {
+ $sql = join ("\n",
+ $self->_set_table_identity_sql($op => $table, 'on'),
+ $sql,
+ $self->_set_table_identity_sql($op => $table, 'off'),
+ );
+ }
+
+ if ($op eq 'insert' && (not $bound_identity_col) && $identity_col &&
+ (not $self->{insert_bulk})) {
+ $sql =
+ "$sql\n" .
+ $self->_fetch_identity_sql($ident, $identity_col);
+ }
+
+ return ($sql, $bind);
+}
+
+sub _set_table_identity_sql {
+ my ($self, $op, $table, $on_off) = @_;
+
+ return sprintf 'SET IDENTITY_%s %s %s',
+ uc($op), $self->sql_maker->_quote($table), uc($on_off);
+}
+
+# Stolen from SQLT, with some modifications. This is a makeshift
+# solution before a sane type-mapping library is available, thus
+# the 'our' for easy overrides.
+our %TYPE_MAPPING = (
+ number => 'numeric',
+ money => 'money',
+ varchar => 'varchar',
+ varchar2 => 'varchar',
+ timestamp => 'datetime',
+ text => 'varchar',
+ real => 'double precision',
+ comment => 'text',
+ bit => 'bit',
+ tinyint => 'smallint',
+ float => 'double precision',
+ serial => 'numeric',
+ bigserial => 'numeric',
+ boolean => 'varchar',
+ long => 'varchar',
+);
+
+sub _native_data_type {
+ my ($self, $type) = @_;
+
+ $type = lc $type;
+ $type =~ s/\s* identity//x;
+
+ return uc($TYPE_MAPPING{$type} || $type);
+}
+
+sub _fetch_identity_sql {
+ my ($self, $source, $col) = @_;
+
+ return sprintf ("SELECT MAX(%s) FROM %s",
+ map { $self->sql_maker->_quote ($_) } ($col, $source->from)
+ );
+}
+
+sub _execute {
+ my $self = shift;
+ my ($op) = @_;
+
+ my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
+
+ if ($op eq 'insert') {
+ $self->_identity($sth->fetchrow_array);
+ $sth->finish;
+ }
+
+ return wantarray ? ($rv, $sth, @bind) : $rv;
+}
+
+sub last_insert_id { shift->_identity }
+
+# handles TEXT/IMAGE and transaction for last_insert_id
+sub insert {
+ my $self = shift;
+ my ($source, $to_insert) = @_;
+
+ my $identity_col = (List::Util::first
+ { $source->column_info($_)->{is_auto_increment} }
+ $source->columns) || '';
+
+ # check for empty insert
+ # INSERT INTO foo DEFAULT VALUES -- does not work with Sybase
+ # try to insert explicit 'DEFAULT's instead (except for identity, timestamp
+ # and computed columns)
+ if (not %$to_insert) {
+ for my $col ($source->columns) {
+ next if $col eq $identity_col;
+
+ my $info = $source->column_info($col);
+
+ next if ref $info->{default_value} eq 'SCALAR'
+ || (exists $info->{data_type} && (not defined $info->{data_type}));
+
+ next if $info->{data_type} && $info->{data_type} =~ /^timestamp\z/i;
+
+ $to_insert->{$col} = \'DEFAULT';
+ }
+ }
+
+ my $blob_cols = $self->_remove_blob_cols($source, $to_insert);
+
+ # do we need the horrific SELECT MAX(COL) hack?
+ my $dumb_last_insert_id =
+ $identity_col
+ && (not exists $to_insert->{$identity_col})
+ && ($self->_identity_method||'') ne '@@IDENTITY';
+
+ my $next = $self->next::can;
+
+ # we are already in a transaction, or there are no blobs
+ # and we don't need the PK - just (try to) do it
+ if ($self->{transaction_depth}
+ || (!$blob_cols && !$dumb_last_insert_id)
+ ) {
+ return $self->_insert (
+ $next, $source, $to_insert, $blob_cols, $identity_col
+ );
+ }
+
+ # otherwise use the _writer_storage to do the insert+transaction on another
+ # connection
+ my $guard = $self->_writer_storage->txn_scope_guard;
+
+ my $updated_cols = $self->_writer_storage->_insert (
+ $next, $source, $to_insert, $blob_cols, $identity_col
+ );
+
+ $self->_identity($self->_writer_storage->_identity);
+
+ $guard->commit;
+
+ return $updated_cols;
+}
+
+sub _insert {
+ my ($self, $next, $source, $to_insert, $blob_cols, $identity_col) = @_;
+
+ my $updated_cols = $self->$next ($source, $to_insert);
+
+ my $final_row = {
+ ($identity_col ?
+ ($identity_col => $self->last_insert_id($source, $identity_col)) : ()),
+ %$to_insert,
+ %$updated_cols,
+ };
+
+ $self->_insert_blobs ($source, $blob_cols, $final_row) if $blob_cols;
+
+ return $updated_cols;
+}
+
+sub update {
+ my $self = shift;
+ my ($source, $fields, $where, @rest) = @_;
+
+ my $wantarray = wantarray;
+
+ my $blob_cols = $self->_remove_blob_cols($source, $fields);
+
+ my $table = $source->name;
+
+ my $identity_col = List::Util::first
+ { $source->column_info($_)->{is_auto_increment} }
+ $source->columns;
+
+ my $is_identity_update = $identity_col && defined $fields->{$identity_col};
+
+ return $self->next::method(@_) unless $blob_cols;
+
+# If there are any blobs in $where, Sybase will return a descriptive error
+# message.
+# XXX blobs can still be used with a LIKE query, and this should be handled.
+
+# update+blob update(s) done atomically on separate connection
+ $self = $self->_writer_storage;
+
+ my $guard = $self->txn_scope_guard;
+
+# First update the blob columns to be updated to '' (taken from $fields, where
+# it is originally put by _remove_blob_cols .)
+ my %blobs_to_empty = map { ($_ => delete $fields->{$_}) } keys %$blob_cols;
+
+# We can't only update NULL blobs, because blobs cannot be in the WHERE clause.
+
+ $self->next::method($source, \%blobs_to_empty, $where, @rest);
+
+# Now update the blobs before the other columns in case the update of other
+# columns makes the search condition invalid.
+ $self->_update_blobs($source, $blob_cols, $where);
+
+ my @res;
+ if (%$fields) {
+ if ($wantarray) {
+ @res = $self->next::method(@_);
+ }
+ elsif (defined $wantarray) {
+ $res[0] = $self->next::method(@_);
+ }
+ else {
+ $self->next::method(@_);
+ }
+ }
+
+ $guard->commit;
+
+ return $wantarray ? @res : $res[0];
+}
+
+sub insert_bulk {
+ my $self = shift;
+ my ($source, $cols, $data) = @_;
+
+ my $identity_col = List::Util::first
+ { $source->column_info($_)->{is_auto_increment} }
+ $source->columns;
+
+ my $is_identity_insert = (List::Util::first
+ { $_ eq $identity_col }
+ @{$cols}
+ ) ? 1 : 0;
+
+ my @source_columns = $source->columns;
+
+ my $use_bulk_api =
+ $self->_bulk_storage &&
+ $self->_get_dbh->{syb_has_blk};
+
+ if ((not $use_bulk_api)
+ &&
+ (ref($self->_dbi_connect_info->[0]) eq 'CODE')
+ &&
+ (not $self->_bulk_disabled_due_to_coderef_connect_info_warned)) {
+ carp <<'EOF';
+Bulk API support disabled due to use of a CODEREF connect_info. Reverting to
+regular array inserts.
+EOF
+ $self->_bulk_disabled_due_to_coderef_connect_info_warned(1);
+ }
+
+ if (not $use_bulk_api) {
+ my $blob_cols = $self->_remove_blob_cols_array($source, $cols, $data);
+
+# _execute_array uses a txn anyway, but it ends too early in case we need to
+# select max(col) to get the identity for inserting blobs.
+ ($self, my $guard) = $self->{transaction_depth} == 0 ?
+ ($self->_writer_storage, $self->_writer_storage->txn_scope_guard)
+ :
+ ($self, undef);
+
+ local $self->{insert_bulk} = 1;
+
+ $self->next::method(@_);
+
+ if ($blob_cols) {
+ if ($is_identity_insert) {
+ $self->_insert_blobs_array ($source, $blob_cols, $cols, $data);
+ }
+ else {
+ my @cols_with_identities = (@$cols, $identity_col);
+
+ ## calculate identities
+ # XXX This assumes identities always increase by 1, which may or may not
+ # be true.
+ my ($last_identity) =
+ $self->_dbh->selectrow_array (
+ $self->_fetch_identity_sql($source, $identity_col)
+ );
+ my @identities = (($last_identity - @$data + 1) .. $last_identity);
+
+ my @data_with_identities = map [@$_, shift @identities], @$data;
+
+ $self->_insert_blobs_array (
+ $source, $blob_cols, \@cols_with_identities, \@data_with_identities
+ );
+ }
+ }
+
+ $guard->commit if $guard;
+
+ return;
+ }
+
+# otherwise, use the bulk API
+
+# rearrange @$data so that columns are in database order
+ my %orig_idx;
+ @orig_idx{@$cols} = 0..$#$cols;
+
+ my %new_idx;
+ @new_idx{@source_columns} = 0..$#source_columns;
+
+ my @new_data;
+ for my $datum (@$data) {
+ my $new_datum = [];
+ for my $col (@source_columns) {
+# identity data will be 'undef' if not $is_identity_insert
+# columns with defaults will also be 'undef'
+ $new_datum->[ $new_idx{$col} ] =
+ exists $orig_idx{$col} ? $datum->[ $orig_idx{$col} ] : undef;
+ }
+ push @new_data, $new_datum;
+ }
+
+# bcp identity index is 1-based
+ my $identity_idx = exists $new_idx{$identity_col} ?
+ $new_idx{$identity_col} + 1 : 0;
+
+## Set a client-side conversion error handler, straight from DBD::Sybase docs.
+# This ignores any data conversion errors detected by the client side libs, as
+# they are usually harmless.
+ my $orig_cslib_cb = DBD::Sybase::set_cslib_cb(
+ Sub::Name::subname insert_bulk => sub {
+ my ($layer, $origin, $severity, $errno, $errmsg, $osmsg, $blkmsg) = @_;
+
+ return 1 if $errno == 36;
+
+ carp
+ "Layer: $layer, Origin: $origin, Severity: $severity, Error: $errno" .
+ ($errmsg ? "\n$errmsg" : '') .
+ ($osmsg ? "\n$osmsg" : '') .
+ ($blkmsg ? "\n$blkmsg" : '');
+
+ return 0;
+ });
+
+ eval {
+ my $bulk = $self->_bulk_storage;
+
+ my $guard = $bulk->txn_scope_guard;
+
+## XXX get this to work instead of our own $sth
+## will require SQLA or *Hacks changes for ordered columns
+# $bulk->next::method($source, \@source_columns, \@new_data, {
+# syb_bcp_attribs => {
+# identity_flag => $is_identity_insert,
+# identity_column => $identity_idx,
+# }
+# });
+ my $sql = 'INSERT INTO ' .
+ $bulk->sql_maker->_quote($source->name) . ' (' .
+# colname list is ignored for BCP, but does no harm
+ (join ', ', map $bulk->sql_maker->_quote($_), @source_columns) . ') '.
+ ' VALUES ('. (join ', ', ('?') x @source_columns) . ')';
+
+## XXX there's a bug in the DBD::Sybase bulk support that makes $sth->finish for
+## a prepare_cached statement ineffective. Replace with ->sth when fixed, or
+## better yet the version above. Should be fixed in DBD::Sybase .
+ my $sth = $bulk->_get_dbh->prepare($sql,
+# 'insert', # op
+ {
+ syb_bcp_attribs => {
+ identity_flag => $is_identity_insert,
+ identity_column => $identity_idx,
+ }
+ }
+ );
+
+ my @bind = do {
+ my $idx = 0;
+ map [ $_, $idx++ ], @source_columns;
+ };
+
+ $self->_execute_array(
+ $source, $sth, \@bind, \@source_columns, \@new_data, sub {
+ $guard->commit
+ }
+ );
+
+ $bulk->_query_end($sql);
+ };
+
+ my $exception = $@;
+ DBD::Sybase::set_cslib_cb($orig_cslib_cb);
+
+ if ($exception =~ /-Y option/) {
+ carp <<"EOF";
+
+Sybase bulk API operation failed due to character set incompatibility, reverting
+to regular array inserts:
+
+*** Try unsetting the LANG environment variable.
+
+$exception
+EOF
+ $self->_bulk_storage(undef);
+ unshift @_, $self;
+ goto \&insert_bulk;
+ }
+ elsif ($exception) {
+# rollback makes the bulkLogin connection unusable
+ $self->_bulk_storage->disconnect;
+ $self->throw_exception($exception);
+ }
+}
+
+sub _dbh_execute_array {
+ my ($self, $sth, $tuple_status, $cb) = @_;
+
+ my $rv = $self->next::method($sth, $tuple_status);
+ $cb->() if $cb;
+
+ return $rv;
+}
+
+# Make sure blobs are not bound as placeholders, and return any non-empty ones
+# as a hash.
+sub _remove_blob_cols {
+ my ($self, $source, $fields) = @_;
+
+ my %blob_cols;
+
+ for my $col (keys %$fields) {
+ if ($self->_is_lob_column($source, $col)) {
+ my $blob_val = delete $fields->{$col};
+ if (not defined $blob_val) {
+ $fields->{$col} = \'NULL';
+ }
+ else {
+ $fields->{$col} = \"''";
+ $blob_cols{$col} = $blob_val unless $blob_val eq '';
+ }
+ }
+ }
+
+ return %blob_cols ? \%blob_cols : undef;
+}
+
+# same for insert_bulk
+sub _remove_blob_cols_array {
+ my ($self, $source, $cols, $data) = @_;
+
+ my @blob_cols;
+
+ for my $i (0..$#$cols) {
+ my $col = $cols->[$i];
+
+ if ($self->_is_lob_column($source, $col)) {
+ for my $j (0..$#$data) {
+ my $blob_val = delete $data->[$j][$i];
+ if (not defined $blob_val) {
+ $data->[$j][$i] = \'NULL';
+ }
+ else {
+ $data->[$j][$i] = \"''";
+ $blob_cols[$j][$i] = $blob_val
+ unless $blob_val eq '';
+ }
+ }
+ }
+ }
+
+ return @blob_cols ? \@blob_cols : undef;
+}
+
+sub _update_blobs {
+ my ($self, $source, $blob_cols, $where) = @_;
+
+ my (@primary_cols) = $source->primary_columns;
+
+ $self->throw_exception('Cannot update TEXT/IMAGE column(s) without a primary key')
+ unless @primary_cols;
+
+# check if we're updating a single row by PK
+ my $pk_cols_in_where = 0;
+ for my $col (@primary_cols) {
+ $pk_cols_in_where++ if defined $where->{$col};
+ }
+ my @rows;
+
+ if ($pk_cols_in_where == @primary_cols) {
+ my %row_to_update;
+ @row_to_update{@primary_cols} = @{$where}{@primary_cols};
+ @rows = \%row_to_update;
+ } else {
+ my $cursor = $self->select ($source, \@primary_cols, $where, {});
+ @rows = map {
+ my %row; @row{@primary_cols} = @$_; \%row
+ } $cursor->all;
+ }
+
+ for my $row (@rows) {
+ $self->_insert_blobs($source, $blob_cols, $row);
+ }
+}
+
+sub _insert_blobs {
+ my ($self, $source, $blob_cols, $row) = @_;
+ my $dbh = $self->_get_dbh;
+
+ my $table = $source->name;
+
+ my %row = %$row;
+ my (@primary_cols) = $source->primary_columns;
+
+ $self->throw_exception('Cannot update TEXT/IMAGE column(s) without a primary key')
+ unless @primary_cols;
+
+ $self->throw_exception('Cannot update TEXT/IMAGE column(s) without primary key values')
+ if ((grep { defined $row{$_} } @primary_cols) != @primary_cols);
+
+ for my $col (keys %$blob_cols) {
+ my $blob = $blob_cols->{$col};
+
+ my %where = map { ($_, $row{$_}) } @primary_cols;
+
+ my $cursor = $self->select ($source, [$col], \%where, {});
+ $cursor->next;
+ my $sth = $cursor->sth;
+
+ if (not $sth) {
+
+ $self->throw_exception(
+ "Could not find row in table '$table' for blob update:\n"
+ . Data::Dumper::Concise::Dumper (\%where)
+ );
+ }
+
+ eval {
+ do {
+ $sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
+ } while $sth->fetch;
+
+ $sth->func('ct_prepare_send') or die $sth->errstr;
+
+ my $log_on_update = $self->_blob_log_on_update;
+ $log_on_update = 1 if not defined $log_on_update;
+
+ $sth->func('CS_SET', 1, {
+ total_txtlen => length($blob),
+ log_on_update => $log_on_update
+ }, 'ct_data_info') or die $sth->errstr;
+
+ $sth->func($blob, length($blob), 'ct_send_data') or die $sth->errstr;
+
+ $sth->func('ct_finish_send') or die $sth->errstr;
+ };
+ my $exception = $@;
+ $sth->finish if $sth;
+ if ($exception) {
+ if ($self->using_freetds) {
+ $self->throw_exception (
+ 'TEXT/IMAGE operation failed, probably because you are using FreeTDS: '
+ . $exception
+ );
+ } else {
+ $self->throw_exception($exception);
+ }
+ }
+ }
+}
+
+sub _insert_blobs_array {
+ my ($self, $source, $blob_cols, $cols, $data) = @_;
+
+ for my $i (0..$#$data) {
+ my $datum = $data->[$i];
+
+ my %row;
+ @row{ @$cols } = @$datum;
+
+ my %blob_vals;
+ for my $j (0..$#$cols) {
+ if (exists $blob_cols->[$i][$j]) {
+ $blob_vals{ $cols->[$j] } = $blob_cols->[$i][$j];
+ }
+ }
+
+ $self->_insert_blobs ($source, \%blob_vals, \%row);
+ }
+}
+
+=head2 connect_call_datetime_setup
+
+Used as:
+
+ on_connect_call => 'datetime_setup'
+
+In L<DBIx::Class::Storage::DBI/connect_info> to set:
+
+ $dbh->syb_date_fmt('ISO_strict'); # output fmt: 2004-08-21T14:36:48.080Z
+ $dbh->do('set dateformat mdy'); # input fmt: 08/13/1979 18:08:55.080
+
+On connection for use with L<DBIx::Class::InflateColumn::DateTime>, using
+L<DateTime::Format::Sybase>, which you will need to install.
+
+This works for both C<DATETIME> and C<SMALLDATETIME> columns, although
+C<SMALLDATETIME> columns only have minute precision.
+
+=cut
+
+{
+ my $old_dbd_warned = 0;
+
+ sub connect_call_datetime_setup {
+ my $self = shift;
+ my $dbh = $self->_get_dbh;
+
+ if ($dbh->can('syb_date_fmt')) {
+ # amazingly, this works with FreeTDS
+ $dbh->syb_date_fmt('ISO_strict');
+ } elsif (not $old_dbd_warned) {
+ carp "Your DBD::Sybase is too old to support ".
+ "DBIx::Class::InflateColumn::DateTime, please upgrade!";
+ $old_dbd_warned = 1;
+ }
+
+ $dbh->do('SET DATEFORMAT mdy');
+
+ 1;
+ }
+}
+
+sub datetime_parser_type { "DateTime::Format::Sybase" }
+
+# ->begin_work and such have no effect with FreeTDS but we run them anyway to
+# let the DBD keep any state it needs to.
+#
+# If they ever do start working, the extra statements will do no harm (because
+# Sybase supports nested transactions.)
+
+sub _dbh_begin_work {
+ my $self = shift;
+
+# bulkLogin=1 connections are always in a transaction, and can only call BEGIN
+# TRAN once. However, we need to make sure there's a $dbh.
+ return if $self->_is_bulk_storage && $self->_dbh && $self->_began_bulk_work;
+
+ $self->next::method(@_);
+
+ if ($self->using_freetds) {
+ $self->_get_dbh->do('BEGIN TRAN');
+ }
+
+ $self->_began_bulk_work(1) if $self->_is_bulk_storage;
+}
+
+sub _dbh_commit {
+ my $self = shift;
+ if ($self->using_freetds) {
+ $self->_dbh->do('COMMIT');
+ }
+ return $self->next::method(@_);
+}
+
+sub _dbh_rollback {
+ my $self = shift;
+ if ($self->using_freetds) {
+ $self->_dbh->do('ROLLBACK');
+ }
+ return $self->next::method(@_);
+}
+
+# savepoint support using ASE syntax
+
+sub _svp_begin {
+ my ($self, $name) = @_;
+
+ $self->_get_dbh->do("SAVE TRANSACTION $name");
+}
+
+# A new SAVE TRANSACTION with the same name releases the previous one.
+sub _svp_release { 1 }
+
+sub _svp_rollback {
+ my ($self, $name) = @_;
+
+ $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
+}
+
+1;
+
+=head1 Schema::Loader Support
+
+As of version C<0.05000>, L<DBIx::Class::Schema::Loader> should work well with
+most (if not all) versions of Sybase ASE.
+
+=head1 FreeTDS
+
+This driver supports L<DBD::Sybase> compiled against FreeTDS
+(L<http://www.freetds.org/>) to the best of our ability, however it is
+recommended that you recompile L<DBD::Sybase> against the Sybase Open Client
+libraries. They are a part of the Sybase ASE distribution:
+
+The Open Client FAQ is here:
+L<http://www.isug.com/Sybase_FAQ/ASE/section7.html>.
+
+Sybase ASE for Linux (which comes with the Open Client libraries) may be
+downloaded here: L<http://response.sybase.com/forms/ASE_Linux_Download>.
+
+To see if you're using FreeTDS check C<< $schema->storage->using_freetds >>, or run:
+
+ perl -MDBI -le 'my $dbh = DBI->connect($dsn, $user, $pass); print $dbh->{syb_oc_version}'
+
+Some versions of the libraries involved will not support placeholders, in which
+case the storage will be reblessed to
+L<DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars>.
+
+In some configurations, placeholders will work but will throw implicit type
+conversion errors for anything that's not expecting a string. In such a case,
+the C<auto_cast> option from L<DBIx::Class::Storage::DBI::AutoCast> is
+automatically set, which you may enable on connection with
+L<DBIx::Class::Storage::DBI::AutoCast/connect_call_set_auto_cast>. The type info
+for the C<CAST>s is taken from the L<DBIx::Class::ResultSource/data_type>
+definitions in your Result classes, and are mapped to a Sybase type (if it isn't
+already) using a mapping based on L<SQL::Translator>.
+
+In other configurations, placeholers will work just as they do with the Sybase
+Open Client libraries.
+
+Inserts or updates of TEXT/IMAGE columns will B<NOT> work with FreeTDS.
+
+=head1 INSERTS WITH PLACEHOLDERS
+
+With placeholders enabled, inserts are done in a transaction so that there are
+no concurrency issues with getting the inserted identity value using
+C<SELECT MAX(col)>, which is the only way to get the C<IDENTITY> value in this
+mode.
+
+In addition, they are done on a separate connection so that it's possible to
+have active cursors when doing an insert.
+
+When using C<DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars> transactions
+are disabled, as there are no concurrency issues with C<SELECT @@IDENTITY> as
+it's a session variable.
+
+=head1 TRANSACTIONS
+
+Due to limitations of the TDS protocol, L<DBD::Sybase>, or both; you cannot
+begin a transaction while there are active cursors; nor can you use multiple
+active cursors within a transaction. An active cursor is, for example, a
+L<ResultSet|DBIx::Class::ResultSet> that has been executed using C<next> or
+C<first> but has not been exhausted or L<reset|DBIx::Class::ResultSet/reset>.
+
+For example, this will not work:
+
+ $schema->txn_do(sub {
+ my $rs = $schema->resultset('Book');
+ while (my $row = $rs->next) {
+ $schema->resultset('MetaData')->create({
+ book_id => $row->id,
+ ...
+ });
+ }
+ });
+
+This won't either:
+
+ my $first_row = $large_rs->first;
+ $schema->txn_do(sub { ... });
+
+Transactions done for inserts in C<AutoCommit> mode when placeholders are in use
+are not affected, as they are done on an extra database handle.
+
+Some workarounds:
+
+=over 4
+
+=item * use L<DBIx::Class::Storage::DBI::Replicated>
+
+=item * L<connect|DBIx::Class::Schema/connect> another L<Schema|DBIx::Class::Schema>
+
+=item * load the data from your cursor with L<DBIx::Class::ResultSet/all>
+
+=back
+
+=head1 MAXIMUM CONNECTIONS
+
+The TDS protocol makes separate connections to the server for active statements
+in the background. By default the number of such connections is limited to 25,
+on both the client side and the server side.
+
+This is a bit too low for a complex L<DBIx::Class> application, so on connection
+the client side setting is set to C<256> (see L<DBD::Sybase/maxConnect>.) You
+can override it to whatever setting you like in the DSN.
+
+See
+L<http://infocenter.sybase.com/help/index.jsp?topic=/com.sybase.help.ase_15.0.sag1/html/sag1/sag1272.htm>
+for information on changing the setting on the server side.
+
+=head1 DATES
+
+See L</connect_call_datetime_setup> to setup date formats
+for L<DBIx::Class::InflateColumn::DateTime>.
+
+=head1 TEXT/IMAGE COLUMNS
+
+L<DBD::Sybase> compiled with FreeTDS will B<NOT> allow you to insert or update
+C<TEXT/IMAGE> columns.
+
+Setting C<< $dbh->{LongReadLen} >> will also not work with FreeTDS use either:
+
+ $schema->storage->dbh->do("SET TEXTSIZE $bytes");
+
+or
+
+ $schema->storage->set_textsize($bytes);
+
+instead.
+
+However, the C<LongReadLen> you pass in
+L<DBIx::Class::Storage::DBI/connect_info> is used to execute the equivalent
+C<SET TEXTSIZE> command on connection.
+
+See L</connect_call_blob_setup> for a L<DBIx::Class::Storage::DBI/connect_info>
+setting you need to work with C<IMAGE> columns.
+
+=head1 BULK API
+
+The experimental L<DBD::Sybase> Bulk API support is used for
+L<populate|DBIx::Class::ResultSet/populate> in B<void> context, in a transaction
+on a separate connection.
+
+To use this feature effectively, use a large number of rows for each
+L<populate|DBIx::Class::ResultSet/populate> call, eg.:
+
+ while (my $rows = $data_source->get_100_rows()) {
+ $rs->populate($rows);
+ }
+
+B<NOTE:> the L<add_columns|DBIx::Class::ResultSource/add_columns>
+calls in your C<Result> classes B<must> list columns in database order for this
+to work. Also, you may have to unset the C<LANG> environment variable before
+loading your app, if it doesn't match the character set of your database.
+
+When inserting IMAGE columns using this method, you'll need to use
+L</connect_call_blob_setup> as well.
+
+=head1 COMPUTED COLUMNS
+
+If you have columns such as:
+
+ created_dtm AS getdate()
+
+represent them in your Result classes as:
+
+ created_dtm => {
+ data_type => undef,
+ default_value => \'getdate()',
+ is_nullable => 0,
+ }
+
+The C<data_type> must exist and must be C<undef>. Then empty inserts will work
+on tables with such columns.
+
+=head1 TIMESTAMP COLUMNS
+
+C<timestamp> columns in Sybase ASE are not really timestamps, see:
+L<http://dba.fyicenter.com/Interview-Questions/SYBASE/The_timestamp_datatype_in_Sybase_.html>.
+
+They should be defined in your Result classes as:
+
+ ts => {
+ data_type => 'timestamp',
+ is_nullable => 0,
+ inflate_datetime => 0,
+ }
+
+The C<<inflate_datetime => 0>> is necessary if you use
+L<DBIx::Class::InflateColumn::DateTime>, and most people do, and still want to
+be able to read these values.
+
+The values will come back as hexadecimal.
+
+=head1 TODO
+
+=over
+
+=item *
+
+Transitions to AutoCommit=0 (starting a transaction) mode by exhausting
+any active cursors, using eager cursors.
+
+=item *
+
+Real limits and limited counts using stored procedures deployed on startup.
+
+=item *
+
+Adaptive Server Anywhere (ASA) support, with possible SQLA::Limit support.
+
+=item *
+
+Blob update with a LIKE query on a blob, without invalidating the WHERE condition.
+
+=item *
+
+bulk_insert using prepare_cached (see comments.)
+
+=back
+
+=head1 AUTHOR
+
+See L<DBIx::Class/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+# vim:sts=2 sw=2:
Deleted: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/Common.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/Common.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/Common.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,111 +0,0 @@
-package DBIx::Class::Storage::DBI::Sybase::Common;
-
-use strict;
-use warnings;
-
-use base qw/DBIx::Class::Storage::DBI/;
-use mro 'c3';
-
-=head1 NAME
-
-DBIx::Class::Storage::DBI::Sybase::Common - Common functionality for drivers using
-DBD::Sybase
-
-=head1 DESCRIPTION
-
-This is the base class for L<DBIx::Class::Storage::DBI::Sybase> and
-L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>. It provides some
-utility methods related to L<DBD::Sybase> and the supported functions of the
-database you are connecting to.
-
-=head1 METHODS
-
-=cut
-
-sub _ping {
- my $self = shift;
-
- my $dbh = $self->_dbh or return 0;
-
- local $dbh->{RaiseError} = 1;
- local $dbh->{PrintError} = 0;
-
- if ($dbh->{syb_no_child_con}) {
-# ping is impossible with an active statement, we return false if so
- my $ping = eval { $dbh->ping };
- return $@ ? 0 : $ping;
- }
-
- eval {
-# XXX if the main connection goes stale, does opening another for this statement
-# really determine anything?
- $dbh->do('select 1');
- };
-
- return $@ ? 0 : 1;
-}
-
-sub _set_max_connect {
- my $self = shift;
- my $val = shift || 256;
-
- my $dsn = $self->_dbi_connect_info->[0];
-
- return if ref($dsn) eq 'CODE';
-
- if ($dsn !~ /maxConnect=/) {
- $self->_dbi_connect_info->[0] = "$dsn;maxConnect=$val";
- my $connected = defined $self->_dbh;
- $self->disconnect;
- $self->ensure_connected if $connected;
- }
-}
-
-=head2 using_freetds
-
-Whether or not L<DBD::Sybase> was compiled against FreeTDS. If false, it means
-the Sybase OpenClient libraries were used.
-
-=cut
-
-sub using_freetds {
- my $self = shift;
-
- return $self->_get_dbh->{syb_oc_version} =~ /freetds/i;
-}
-
-=head2 set_textsize
-
-When using FreeTDS and/or MSSQL, C<< $dbh->{LongReadLen} >> is not available,
-use this function instead. It does:
-
- $dbh->do("SET TEXTSIZE $bytes");
-
-Takes the number of bytes, or uses the C<LongReadLen> value from your
-L<DBIx::Class/connect_info> if omitted, lastly falls back to the C<32768> which
-is the L<DBD::Sybase> default.
-
-=cut
-
-sub set_textsize {
- my $self = shift;
- my $text_size = shift ||
- eval { $self->_dbi_connect_info->[-1]->{LongReadLen} } ||
- 32768; # the DBD::Sybase default
-
- return unless defined $text_size;
-
- $self->_dbh->do("SET TEXTSIZE $text_size");
-}
-
-1;
-
-=head1 AUTHORS
-
-See L<DBIx::Class/CONTRIBUTORS>.
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -4,7 +4,7 @@
use warnings;
use base qw/
- DBIx::Class::Storage::DBI::Sybase::Common
+ DBIx::Class::Storage::DBI::Sybase
DBIx::Class::Storage::DBI::MSSQL
/;
use mro 'c3';
@@ -13,22 +13,48 @@
my $self = shift;
my $dbh = $self->_get_dbh;
+ return if ref $self ne __PACKAGE__;
+
if (not $self->_typeless_placeholders_supported) {
+ require
+ DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars;
bless $self,
'DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server::NoBindVars';
$self->_rebless;
}
}
-sub _init {
+sub _run_connection_actions {
my $self = shift;
# LongReadLen doesn't work with MSSQL through DBD::Sybase, and the default is
# huge on some versions of SQL server and can cause memory problems, so we
- # fix it up here (see Sybase/Common.pm)
+ # fix it up here (see ::DBI::Sybase.pm)
$self->set_textsize;
+
+ $self->next::method(@_);
}
+sub _dbh_begin_work {
+ my $self = shift;
+
+ $self->_get_dbh->do('BEGIN TRAN');
+}
+
+sub _dbh_commit {
+ my $self = shift;
+ my $dbh = $self->_dbh
+ or $self->throw_exception('cannot COMMIT on a disconnected handle');
+ $dbh->do('COMMIT');
+}
+
+sub _dbh_rollback {
+ my $self = shift;
+ my $dbh = $self->_dbh
+ or $self->throw_exception('cannot ROLLBACK on a disconnected handle');
+ $dbh->do('ROLLBACK');
+}
+
1;
=head1 NAME
Deleted: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,102 +0,0 @@
-package DBIx::Class::Storage::DBI::Sybase::NoBindVars;
-
-use base qw/
- DBIx::Class::Storage::DBI::NoBindVars
- DBIx::Class::Storage::DBI::Sybase
-/;
-use mro 'c3';
-use List::Util ();
-use Scalar::Util ();
-
-sub _init {
- my $self = shift;
- $self->disable_sth_caching(1);
- $self->_identity_method('@@IDENTITY');
- $self->next::method (@_);
-}
-
-sub _fetch_identity_sql { 'SELECT ' . $_[0]->_identity_method }
-
-my $number = sub { Scalar::Util::looks_like_number($_[0]) };
-
-my $decimal = sub { $_[0] =~ /^ [-+]? \d+ (?:\.\d*)? \z/x };
-
-my %noquote = (
- int => sub { $_[0] =~ /^ [-+]? \d+ \z/x },
- bit => => sub { $_[0] =~ /^[01]\z/ },
- money => sub { $_[0] =~ /^\$ \d+ (?:\.\d*)? \z/x },
- float => $number,
- real => $number,
- double => $number,
- decimal => $decimal,
- numeric => $decimal,
-);
-
-sub interpolate_unquoted {
- my $self = shift;
- my ($type, $value) = @_;
-
- return $self->next::method(@_) if not defined $value or not defined $type;
-
- if (my $key = List::Util::first { $type =~ /$_/i } keys %noquote) {
- return 1 if $noquote{$key}->($value);
- }
- elsif ($self->is_datatype_numeric($type) && $number->($value)) {
- return 1;
- }
-
- return $self->next::method(@_);
-}
-
-sub _prep_interpolated_value {
- my ($self, $type, $value) = @_;
-
- if ($type =~ /money/i && defined $value) {
- # change a ^ not followed by \$ to a \$
- $value =~ s/^ (?! \$) /\$/x;
- }
-
- return $value;
-}
-
-1;
-
-=head1 NAME
-
-DBIx::Class::Storage::DBI::Sybase::NoBindVars - Storage::DBI subclass for Sybase
-without placeholder support
-
-=head1 DESCRIPTION
-
-If you're using this driver than your version of Sybase, or the libraries you
-use to connect to it, do not support placeholders.
-
-You can also enable this driver explicitly using:
-
- my $schema = SchemaClass->clone;
- $schema->storage_type('::DBI::Sybase::NoBindVars');
- $schema->connect($dsn, $user, $pass, \%opts);
-
-See the discussion in L<< DBD::Sybase/Using ? Placeholders & bind parameters to
-$sth->execute >> for details on the pros and cons of using placeholders.
-
-One advantage of not using placeholders is that C<select @@identity> will work
-for obtainging the last insert id of an C<IDENTITY> column, instead of having to
-do C<select max(col)> in a transaction as the base Sybase driver does.
-
-When using this driver, bind variables will be interpolated (properly quoted of
-course) into the SQL query itself, without using placeholders.
-
-The caching of prepared statements is also explicitly disabled, as the
-interpolation renders it useless.
-
-=head1 AUTHORS
-
-See L<DBIx::Class/CONTRIBUTORS>.
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
-# vim:sts=2 sw=2:
Deleted: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,1137 +0,0 @@
-package DBIx::Class::Storage::DBI::Sybase;
-
-use strict;
-use warnings;
-
-use base qw/
- DBIx::Class::Storage::DBI::Sybase::Common
- DBIx::Class::Storage::DBI::AutoCast
-/;
-use mro 'c3';
-use Carp::Clan qw/^DBIx::Class/;
-use List::Util();
-use Sub::Name();
-use Data::Dumper::Concise();
-
-__PACKAGE__->mk_group_accessors('simple' =>
- qw/_identity _blob_log_on_update _writer_storage _is_extra_storage
- _bulk_storage _is_bulk_storage _began_bulk_work
- _bulk_disabled_due_to_coderef_connect_info_warned
- _identity_method/
-);
-
-my @also_proxy_to_extra_storages = qw/
- connect_call_set_auto_cast auto_cast connect_call_blob_setup
- connect_call_datetime_setup
-
- disconnect _connect_info _sql_maker _sql_maker_opts disable_sth_caching
- auto_savepoint unsafe cursor_class debug debugobj schema
-/;
-
-=head1 NAME
-
-DBIx::Class::Storage::DBI::Sybase - Sybase support for DBIx::Class
-
-=head1 SYNOPSIS
-
-This subclass supports L<DBD::Sybase> for real Sybase databases. If you are
-using an MSSQL database via L<DBD::Sybase>, your storage will be reblessed to
-L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
-
-=head1 DESCRIPTION
-
-If your version of Sybase does not support placeholders, then your storage
-will be reblessed to L<DBIx::Class::Storage::DBI::Sybase::NoBindVars>. You can
-also enable that driver explicitly, see the documentation for more details.
-
-With this driver there is unfortunately no way to get the C<last_insert_id>
-without doing a C<SELECT MAX(col)>. This is done safely in a transaction
-(locking the table.) See L</INSERTS WITH PLACEHOLDERS>.
-
-A recommended L<DBIx::Class::Storage::DBI/connect_info> setting:
-
- on_connect_call => [['datetime_setup'], ['blob_setup', log_on_update => 0]]
-
-=head1 METHODS
-
-=cut
-
-sub _rebless {
- my $self = shift;
-
- if (ref($self) eq 'DBIx::Class::Storage::DBI::Sybase') {
- my $dbtype = eval {
- @{$self->_get_dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2]
- } || '';
-
- my $exception = $@;
- $dbtype =~ s/\W/_/gi;
- my $subclass = "DBIx::Class::Storage::DBI::Sybase::${dbtype}";
-
- if (!$exception && $dbtype && $self->load_optional_class($subclass)) {
- bless $self, $subclass;
- $self->_rebless;
- } else { # real Sybase
- my $no_bind_vars = 'DBIx::Class::Storage::DBI::Sybase::NoBindVars';
-
- if ($self->using_freetds) {
- carp <<'EOF' unless $ENV{DBIC_SYBASE_FREETDS_NOWARN};
-
-You are using FreeTDS with Sybase.
-
-We will do our best to support this configuration, but please consider this
-support experimental.
-
-TEXT/IMAGE columns will definitely not work.
-
-You are encouraged to recompile DBD::Sybase with the Sybase Open Client libraries
-instead.
-
-See perldoc DBIx::Class::Storage::DBI::Sybase for more details.
-
-To turn off this warning set the DBIC_SYBASE_FREETDS_NOWARN environment
-variable.
-EOF
- if (not $self->_typeless_placeholders_supported) {
- if ($self->_placeholders_supported) {
- $self->auto_cast(1);
- } else {
- $self->ensure_class_loaded($no_bind_vars);
- bless $self, $no_bind_vars;
- $self->_rebless;
- }
- }
- }
- elsif (not $self->_get_dbh->{syb_dynamic_supported}) {
- # not necessarily FreeTDS, but no placeholders nevertheless
- $self->ensure_class_loaded($no_bind_vars);
- bless $self, $no_bind_vars;
- $self->_rebless;
- } elsif (not $self->_typeless_placeholders_supported) {
- # this is highly unlikely, but we check just in case
- $self->auto_cast(1);
- }
- }
- }
-}
-
-sub _init {
- my $self = shift;
- $self->_set_max_connect(256);
-
- # based on LongReadLen in connect_info
- $self->set_textsize if $self->using_freetds;
-
-# create storage for insert/(update blob) transactions,
-# unless this is that storage
- return if $self->_is_extra_storage;
-
- my $writer_storage = (ref $self)->new;
-
- $writer_storage->_is_extra_storage(1);
- $writer_storage->connect_info($self->connect_info);
- $writer_storage->auto_cast($self->auto_cast);
-
- $self->_writer_storage($writer_storage);
-
-# create a bulk storage unless connect_info is a coderef
- return
- if (Scalar::Util::reftype($self->_dbi_connect_info->[0])||'') eq 'CODE';
-
- my $bulk_storage = (ref $self)->new;
-
- $bulk_storage->_is_extra_storage(1);
- $bulk_storage->_is_bulk_storage(1); # for special ->disconnect acrobatics
- $bulk_storage->connect_info($self->connect_info);
-
-# this is why
- $bulk_storage->_dbi_connect_info->[0] .= ';bulkLogin=1';
-
- $self->_bulk_storage($bulk_storage);
-}
-
-for my $method (@also_proxy_to_extra_storages) {
- no strict 'refs';
- no warnings 'redefine';
-
- my $replaced = __PACKAGE__->can($method);
-
- *{$method} = Sub::Name::subname $method => sub {
- my $self = shift;
- $self->_writer_storage->$replaced(@_) if $self->_writer_storage;
- $self->_bulk_storage->$replaced(@_) if $self->_bulk_storage;
- return $self->$replaced(@_);
- };
-}
-
-sub disconnect {
- my $self = shift;
-
-# Even though we call $sth->finish for uses off the bulk API, there's still an
-# "active statement" warning on disconnect, which we throw away here.
-# This is due to the bug described in insert_bulk.
-# Currently a noop because 'prepare' is used instead of 'prepare_cached'.
- local $SIG{__WARN__} = sub {
- warn $_[0] unless $_[0] =~ /active statement/i;
- } if $self->_is_bulk_storage;
-
-# so that next transaction gets a dbh
- $self->_began_bulk_work(0) if $self->_is_bulk_storage;
-
- $self->next::method;
-}
-
-# Make sure we have CHAINED mode turned on if AutoCommit is off in non-FreeTDS
-# DBD::Sybase (since we don't know how DBD::Sybase was compiled.) If however
-# we're using FreeTDS, CHAINED mode turns on an implicit transaction which we
-# only want when AutoCommit is off.
-sub _populate_dbh {
- my $self = shift;
-
- $self->next::method(@_);
-
- if ($self->_is_bulk_storage) {
-# this should be cleared on every reconnect
- $self->_began_bulk_work(0);
- return;
- }
-
- if (not $self->using_freetds) {
- $self->_dbh->{syb_chained_txn} = 1;
- } else {
- if ($self->_dbh_autocommit) {
- $self->_dbh->do('SET CHAINED OFF');
- } else {
- $self->_dbh->do('SET CHAINED ON');
- }
- }
-}
-
-=head2 connect_call_blob_setup
-
-Used as:
-
- on_connect_call => [ [ 'blob_setup', log_on_update => 0 ] ]
-
-Does C<< $dbh->{syb_binary_images} = 1; >> to return C<IMAGE> data as raw binary
-instead of as a hex string.
-
-Recommended.
-
-Also sets the C<log_on_update> value for blob write operations. The default is
-C<1>, but C<0> is better if your database is configured for it.
-
-See
-L<DBD::Sybase/Handling_IMAGE/TEXT_data_with_syb_ct_get_data()/syb_ct_send_data()>.
-
-=cut
-
-sub connect_call_blob_setup {
- my $self = shift;
- my %args = @_;
- my $dbh = $self->_dbh;
- $dbh->{syb_binary_images} = 1;
-
- $self->_blob_log_on_update($args{log_on_update})
- if exists $args{log_on_update};
-}
-
-sub _is_lob_type {
- my $self = shift;
- my $type = shift;
- $type && $type =~ /(?:text|image|lob|bytea|binary|memo)/i;
-}
-
-sub _is_lob_column {
- my ($self, $source, $column) = @_;
-
- return $self->_is_lob_type($source->column_info($column)->{data_type});
-}
-
-sub _prep_for_execute {
- my $self = shift;
- my ($op, $extra_bind, $ident, $args) = @_;
-
- my ($sql, $bind) = $self->next::method (@_);
-
- my $table = Scalar::Util::blessed($ident) ? $ident->from : $ident;
-
- my $bind_info = $self->_resolve_column_info(
- $ident, [map $_->[0], @{$bind}]
- );
- my $bound_identity_col = List::Util::first
- { $bind_info->{$_}{is_auto_increment} }
- (keys %$bind_info)
- ;
- my $identity_col = Scalar::Util::blessed($ident) &&
- List::Util::first
- { $ident->column_info($_)->{is_auto_increment} }
- $ident->columns
- ;
-
- if (($op eq 'insert' && $bound_identity_col) ||
- ($op eq 'update' && exists $args->[0]{$identity_col})) {
- $sql = join ("\n",
- $self->_set_table_identity_sql($op => $table, 'on'),
- $sql,
- $self->_set_table_identity_sql($op => $table, 'off'),
- );
- }
-
- if ($op eq 'insert' && (not $bound_identity_col) && $identity_col &&
- (not $self->{insert_bulk})) {
- $sql =
- "$sql\n" .
- $self->_fetch_identity_sql($ident, $identity_col);
- }
-
- return ($sql, $bind);
-}
-
-sub _set_table_identity_sql {
- my ($self, $op, $table, $on_off) = @_;
-
- return sprintf 'SET IDENTITY_%s %s %s',
- uc($op), $self->sql_maker->_quote($table), uc($on_off);
-}
-
-# Stolen from SQLT, with some modifications. This is a makeshift
-# solution before a sane type-mapping library is available, thus
-# the 'our' for easy overrides.
-our %TYPE_MAPPING = (
- number => 'numeric',
- money => 'money',
- varchar => 'varchar',
- varchar2 => 'varchar',
- timestamp => 'datetime',
- text => 'varchar',
- real => 'double precision',
- comment => 'text',
- bit => 'bit',
- tinyint => 'smallint',
- float => 'double precision',
- serial => 'numeric',
- bigserial => 'numeric',
- boolean => 'varchar',
- long => 'varchar',
-);
-
-sub _native_data_type {
- my ($self, $type) = @_;
-
- $type = lc $type;
- $type =~ s/\s* identity//x;
-
- return uc($TYPE_MAPPING{$type} || $type);
-}
-
-sub _fetch_identity_sql {
- my ($self, $source, $col) = @_;
-
- return sprintf ("SELECT MAX(%s) FROM %s",
- map { $self->sql_maker->_quote ($_) } ($col, $source->from)
- );
-}
-
-sub _execute {
- my $self = shift;
- my ($op) = @_;
-
- my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
-
- if ($op eq 'insert') {
- $self->_identity($sth->fetchrow_array);
- $sth->finish;
- }
-
- return wantarray ? ($rv, $sth, @bind) : $rv;
-}
-
-sub last_insert_id { shift->_identity }
-
-# handles TEXT/IMAGE and transaction for last_insert_id
-sub insert {
- my $self = shift;
- my ($source, $to_insert) = @_;
-
- my $identity_col = (List::Util::first
- { $source->column_info($_)->{is_auto_increment} }
- $source->columns) || '';
-
- # check for empty insert
- # INSERT INTO foo DEFAULT VALUES -- does not work with Sybase
- # try to insert explicit 'DEFAULT's instead (except for identity)
- if (not %$to_insert) {
- for my $col ($source->columns) {
- next if $col eq $identity_col;
- $to_insert->{$col} = \'DEFAULT';
- }
- }
-
- my $blob_cols = $self->_remove_blob_cols($source, $to_insert);
-
- # do we need the horrific SELECT MAX(COL) hack?
- my $dumb_last_insert_id =
- $identity_col
- && (not exists $to_insert->{$identity_col})
- && ($self->_identity_method||'') ne '@@IDENTITY';
-
- my $next = $self->next::can;
-
- # we are already in a transaction, or there are no blobs
- # and we don't need the PK - just (try to) do it
- if ($self->{transaction_depth}
- || (!$blob_cols && !$dumb_last_insert_id)
- ) {
- return $self->_insert (
- $next, $source, $to_insert, $blob_cols, $identity_col
- );
- }
-
- # otherwise use the _writer_storage to do the insert+transaction on another
- # connection
- my $guard = $self->_writer_storage->txn_scope_guard;
-
- my $updated_cols = $self->_writer_storage->_insert (
- $next, $source, $to_insert, $blob_cols, $identity_col
- );
-
- $self->_identity($self->_writer_storage->_identity);
-
- $guard->commit;
-
- return $updated_cols;
-}
-
-sub _insert {
- my ($self, $next, $source, $to_insert, $blob_cols, $identity_col) = @_;
-
- my $updated_cols = $self->$next ($source, $to_insert);
-
- my $final_row = {
- ($identity_col ?
- ($identity_col => $self->last_insert_id($source, $identity_col)) : ()),
- %$to_insert,
- %$updated_cols,
- };
-
- $self->_insert_blobs ($source, $blob_cols, $final_row) if $blob_cols;
-
- return $updated_cols;
-}
-
-sub update {
- my $self = shift;
- my ($source, $fields, $where, @rest) = @_;
-
- my $wantarray = wantarray;
-
- my $blob_cols = $self->_remove_blob_cols($source, $fields);
-
- my $table = $source->name;
-
- my $identity_col = List::Util::first
- { $source->column_info($_)->{is_auto_increment} }
- $source->columns;
-
- my $is_identity_update = $identity_col && defined $fields->{$identity_col};
-
- return $self->next::method(@_) unless $blob_cols;
-
-# If there are any blobs in $where, Sybase will return a descriptive error
-# message.
-# XXX blobs can still be used with a LIKE query, and this should be handled.
-
-# update+blob update(s) done atomically on separate connection
- $self = $self->_writer_storage;
-
- my $guard = $self->txn_scope_guard;
-
-# First update the blob columns to be updated to '' (taken from $fields, where
-# it is originally put by _remove_blob_cols .)
- my %blobs_to_empty = map { ($_ => delete $fields->{$_}) } keys %$blob_cols;
-
-# We can't only update NULL blobs, because blobs cannot be in the WHERE clause.
-
- $self->next::method($source, \%blobs_to_empty, $where, @rest);
-
-# Now update the blobs before the other columns in case the update of other
-# columns makes the search condition invalid.
- $self->_update_blobs($source, $blob_cols, $where);
-
- my @res;
- if (%$fields) {
- if ($wantarray) {
- @res = $self->next::method(@_);
- }
- elsif (defined $wantarray) {
- $res[0] = $self->next::method(@_);
- }
- else {
- $self->next::method(@_);
- }
- }
-
- $guard->commit;
-
- return $wantarray ? @res : $res[0];
-}
-
-sub insert_bulk {
- my $self = shift;
- my ($source, $cols, $data) = @_;
-
- my $identity_col = List::Util::first
- { $source->column_info($_)->{is_auto_increment} }
- $source->columns;
-
- my $is_identity_insert = (List::Util::first
- { $_ eq $identity_col }
- @{$cols}
- ) ? 1 : 0;
-
- my @source_columns = $source->columns;
-
- my $use_bulk_api =
- $self->_bulk_storage &&
- $self->_get_dbh->{syb_has_blk};
-
- if ((not $use_bulk_api) &&
- (Scalar::Util::reftype($self->_dbi_connect_info->[0])||'') eq 'CODE' &&
- (not $self->_bulk_disabled_due_to_coderef_connect_info_warned)) {
- carp <<'EOF';
-Bulk API support disabled due to use of a CODEREF connect_info. Reverting to
-regular array inserts.
-EOF
- $self->_bulk_disabled_due_to_coderef_connect_info_warned(1);
- }
-
- if (not $use_bulk_api) {
- my $blob_cols = $self->_remove_blob_cols_array($source, $cols, $data);
-
-# _execute_array uses a txn anyway, but it ends too early in case we need to
-# select max(col) to get the identity for inserting blobs.
- ($self, my $guard) = $self->{transaction_depth} == 0 ?
- ($self->_writer_storage, $self->_writer_storage->txn_scope_guard)
- :
- ($self, undef);
-
- local $self->{insert_bulk} = 1;
-
- $self->next::method(@_);
-
- if ($blob_cols) {
- if ($is_identity_insert) {
- $self->_insert_blobs_array ($source, $blob_cols, $cols, $data);
- }
- else {
- my @cols_with_identities = (@$cols, $identity_col);
-
- ## calculate identities
- # XXX This assumes identities always increase by 1, which may or may not
- # be true.
- my ($last_identity) =
- $self->_dbh->selectrow_array (
- $self->_fetch_identity_sql($source, $identity_col)
- );
- my @identities = (($last_identity - @$data + 1) .. $last_identity);
-
- my @data_with_identities = map [@$_, shift @identities], @$data;
-
- $self->_insert_blobs_array (
- $source, $blob_cols, \@cols_with_identities, \@data_with_identities
- );
- }
- }
-
- $guard->commit if $guard;
-
- return;
- }
-
-# otherwise, use the bulk API
-
-# rearrange @$data so that columns are in database order
- my %orig_idx;
- @orig_idx{@$cols} = 0..$#$cols;
-
- my %new_idx;
- @new_idx{@source_columns} = 0..$#source_columns;
-
- my @new_data;
- for my $datum (@$data) {
- my $new_datum = [];
- for my $col (@source_columns) {
-# identity data will be 'undef' if not $is_identity_insert
-# columns with defaults will also be 'undef'
- $new_datum->[ $new_idx{$col} ] =
- exists $orig_idx{$col} ? $datum->[ $orig_idx{$col} ] : undef;
- }
- push @new_data, $new_datum;
- }
-
-# bcp identity index is 1-based
- my $identity_idx = exists $new_idx{$identity_col} ?
- $new_idx{$identity_col} + 1 : 0;
-
-## Set a client-side conversion error handler, straight from DBD::Sybase docs.
-# This ignores any data conversion errors detected by the client side libs, as
-# they are usually harmless.
- my $orig_cslib_cb = DBD::Sybase::set_cslib_cb(
- Sub::Name::subname insert_bulk => sub {
- my ($layer, $origin, $severity, $errno, $errmsg, $osmsg, $blkmsg) = @_;
-
- return 1 if $errno == 36;
-
- carp
- "Layer: $layer, Origin: $origin, Severity: $severity, Error: $errno" .
- ($errmsg ? "\n$errmsg" : '') .
- ($osmsg ? "\n$osmsg" : '') .
- ($blkmsg ? "\n$blkmsg" : '');
-
- return 0;
- });
-
- eval {
- my $bulk = $self->_bulk_storage;
-
- my $guard = $bulk->txn_scope_guard;
-
-## XXX get this to work instead of our own $sth
-## will require SQLA or *Hacks changes for ordered columns
-# $bulk->next::method($source, \@source_columns, \@new_data, {
-# syb_bcp_attribs => {
-# identity_flag => $is_identity_insert,
-# identity_column => $identity_idx,
-# }
-# });
- my $sql = 'INSERT INTO ' .
- $bulk->sql_maker->_quote($source->name) . ' (' .
-# colname list is ignored for BCP, but does no harm
- (join ', ', map $bulk->sql_maker->_quote($_), @source_columns) . ') '.
- ' VALUES ('. (join ', ', ('?') x @source_columns) . ')';
-
-## XXX there's a bug in the DBD::Sybase bulk support that makes $sth->finish for
-## a prepare_cached statement ineffective. Replace with ->sth when fixed, or
-## better yet the version above. Should be fixed in DBD::Sybase .
- my $sth = $bulk->_get_dbh->prepare($sql,
-# 'insert', # op
- {
- syb_bcp_attribs => {
- identity_flag => $is_identity_insert,
- identity_column => $identity_idx,
- }
- }
- );
-
- my @bind = do {
- my $idx = 0;
- map [ $_, $idx++ ], @source_columns;
- };
-
- $self->_execute_array(
- $source, $sth, \@bind, \@source_columns, \@new_data, sub {
- $guard->commit
- }
- );
-
- $bulk->_query_end($sql);
- };
-
- my $exception = $@;
- DBD::Sybase::set_cslib_cb($orig_cslib_cb);
-
- if ($exception =~ /-Y option/) {
- carp <<"EOF";
-
-Sybase bulk API operation failed due to character set incompatibility, reverting
-to regular array inserts:
-
-*** Try unsetting the LANG environment variable.
-
-$exception
-EOF
- $self->_bulk_storage(undef);
- unshift @_, $self;
- goto \&insert_bulk;
- }
- elsif ($exception) {
-# rollback makes the bulkLogin connection unusable
- $self->_bulk_storage->disconnect;
- $self->throw_exception($exception);
- }
-}
-
-sub _dbh_execute_array {
- my ($self, $sth, $tuple_status, $cb) = @_;
-
- my $rv = $self->next::method($sth, $tuple_status);
- $cb->() if $cb;
-
- return $rv;
-}
-
-# Make sure blobs are not bound as placeholders, and return any non-empty ones
-# as a hash.
-sub _remove_blob_cols {
- my ($self, $source, $fields) = @_;
-
- my %blob_cols;
-
- for my $col (keys %$fields) {
- if ($self->_is_lob_column($source, $col)) {
- my $blob_val = delete $fields->{$col};
- if (not defined $blob_val) {
- $fields->{$col} = \'NULL';
- }
- else {
- $fields->{$col} = \"''";
- $blob_cols{$col} = $blob_val unless $blob_val eq '';
- }
- }
- }
-
- return %blob_cols ? \%blob_cols : undef;
-}
-
-# same for insert_bulk
-sub _remove_blob_cols_array {
- my ($self, $source, $cols, $data) = @_;
-
- my @blob_cols;
-
- for my $i (0..$#$cols) {
- my $col = $cols->[$i];
-
- if ($self->_is_lob_column($source, $col)) {
- for my $j (0..$#$data) {
- my $blob_val = delete $data->[$j][$i];
- if (not defined $blob_val) {
- $data->[$j][$i] = \'NULL';
- }
- else {
- $data->[$j][$i] = \"''";
- $blob_cols[$j][$i] = $blob_val
- unless $blob_val eq '';
- }
- }
- }
- }
-
- return @blob_cols ? \@blob_cols : undef;
-}
-
-sub _update_blobs {
- my ($self, $source, $blob_cols, $where) = @_;
-
- my (@primary_cols) = $source->primary_columns;
-
- $self->throw_exception('Cannot update TEXT/IMAGE column(s) without a primary key')
- unless @primary_cols;
-
-# check if we're updating a single row by PK
- my $pk_cols_in_where = 0;
- for my $col (@primary_cols) {
- $pk_cols_in_where++ if defined $where->{$col};
- }
- my @rows;
-
- if ($pk_cols_in_where == @primary_cols) {
- my %row_to_update;
- @row_to_update{@primary_cols} = @{$where}{@primary_cols};
- @rows = \%row_to_update;
- } else {
- my $cursor = $self->select ($source, \@primary_cols, $where, {});
- @rows = map {
- my %row; @row{@primary_cols} = @$_; \%row
- } $cursor->all;
- }
-
- for my $row (@rows) {
- $self->_insert_blobs($source, $blob_cols, $row);
- }
-}
-
-sub _insert_blobs {
- my ($self, $source, $blob_cols, $row) = @_;
- my $dbh = $self->_get_dbh;
-
- my $table = $source->name;
-
- my %row = %$row;
- my (@primary_cols) = $source->primary_columns;
-
- $self->throw_exception('Cannot update TEXT/IMAGE column(s) without a primary key')
- unless @primary_cols;
-
- $self->throw_exception('Cannot update TEXT/IMAGE column(s) without primary key values')
- if ((grep { defined $row{$_} } @primary_cols) != @primary_cols);
-
- for my $col (keys %$blob_cols) {
- my $blob = $blob_cols->{$col};
-
- my %where = map { ($_, $row{$_}) } @primary_cols;
-
- my $cursor = $self->select ($source, [$col], \%where, {});
- $cursor->next;
- my $sth = $cursor->sth;
-
- if (not $sth) {
-
- $self->throw_exception(
- "Could not find row in table '$table' for blob update:\n"
- . Data::Dumper::Concise::Dumper (\%where)
- );
- }
-
- eval {
- do {
- $sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
- } while $sth->fetch;
-
- $sth->func('ct_prepare_send') or die $sth->errstr;
-
- my $log_on_update = $self->_blob_log_on_update;
- $log_on_update = 1 if not defined $log_on_update;
-
- $sth->func('CS_SET', 1, {
- total_txtlen => length($blob),
- log_on_update => $log_on_update
- }, 'ct_data_info') or die $sth->errstr;
-
- $sth->func($blob, length($blob), 'ct_send_data') or die $sth->errstr;
-
- $sth->func('ct_finish_send') or die $sth->errstr;
- };
- my $exception = $@;
- $sth->finish if $sth;
- if ($exception) {
- if ($self->using_freetds) {
- $self->throw_exception (
- 'TEXT/IMAGE operation failed, probably because you are using FreeTDS: '
- . $exception
- );
- } else {
- $self->throw_exception($exception);
- }
- }
- }
-}
-
-sub _insert_blobs_array {
- my ($self, $source, $blob_cols, $cols, $data) = @_;
-
- for my $i (0..$#$data) {
- my $datum = $data->[$i];
-
- my %row;
- @row{ @$cols } = @$datum;
-
- my %blob_vals;
- for my $j (0..$#$cols) {
- if (exists $blob_cols->[$i][$j]) {
- $blob_vals{ $cols->[$j] } = $blob_cols->[$i][$j];
- }
- }
-
- $self->_insert_blobs ($source, \%blob_vals, \%row);
- }
-}
-
-=head2 connect_call_datetime_setup
-
-Used as:
-
- on_connect_call => 'datetime_setup'
-
-In L<DBIx::Class::Storage::DBI/connect_info> to set:
-
- $dbh->syb_date_fmt('ISO_strict'); # output fmt: 2004-08-21T14:36:48.080Z
- $dbh->do('set dateformat mdy'); # input fmt: 08/13/1979 18:08:55.080
-
-On connection for use with L<DBIx::Class::InflateColumn::DateTime>, using
-L<DateTime::Format::Sybase>, which you will need to install.
-
-This works for both C<DATETIME> and C<SMALLDATETIME> columns, although
-C<SMALLDATETIME> columns only have minute precision.
-
-=cut
-
-{
- my $old_dbd_warned = 0;
-
- sub connect_call_datetime_setup {
- my $self = shift;
- my $dbh = $self->_get_dbh;
-
- if ($dbh->can('syb_date_fmt')) {
- # amazingly, this works with FreeTDS
- $dbh->syb_date_fmt('ISO_strict');
- } elsif (not $old_dbd_warned) {
- carp "Your DBD::Sybase is too old to support ".
- "DBIx::Class::InflateColumn::DateTime, please upgrade!";
- $old_dbd_warned = 1;
- }
-
- $dbh->do('SET DATEFORMAT mdy');
-
- 1;
- }
-}
-
-sub datetime_parser_type { "DateTime::Format::Sybase" }
-
-# ->begin_work and such have no effect with FreeTDS but we run them anyway to
-# let the DBD keep any state it needs to.
-#
-# If they ever do start working, the extra statements will do no harm (because
-# Sybase supports nested transactions.)
-
-sub _dbh_begin_work {
- my $self = shift;
-
-# bulkLogin=1 connections are always in a transaction, and can only call BEGIN
-# TRAN once. However, we need to make sure there's a $dbh.
- return if $self->_is_bulk_storage && $self->_dbh && $self->_began_bulk_work;
-
- $self->next::method(@_);
-
- if ($self->using_freetds) {
- $self->_get_dbh->do('BEGIN TRAN');
- }
-
- $self->_began_bulk_work(1) if $self->_is_bulk_storage;
-}
-
-sub _dbh_commit {
- my $self = shift;
- if ($self->using_freetds) {
- $self->_dbh->do('COMMIT');
- }
- return $self->next::method(@_);
-}
-
-sub _dbh_rollback {
- my $self = shift;
- if ($self->using_freetds) {
- $self->_dbh->do('ROLLBACK');
- }
- return $self->next::method(@_);
-}
-
-# savepoint support using ASE syntax
-
-sub _svp_begin {
- my ($self, $name) = @_;
-
- $self->_get_dbh->do("SAVE TRANSACTION $name");
-}
-
-# A new SAVE TRANSACTION with the same name releases the previous one.
-sub _svp_release { 1 }
-
-sub _svp_rollback {
- my ($self, $name) = @_;
-
- $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
-}
-
-1;
-
-=head1 Schema::Loader Support
-
-There is an experimental branch of L<DBIx::Class::Schema::Loader> that will
-allow you to dump a schema from most (if not all) versions of Sybase.
-
-It is available via subversion from:
-
- http://dev.catalyst.perl.org/repos/bast/branches/DBIx-Class-Schema-Loader/current/
-
-=head1 FreeTDS
-
-This driver supports L<DBD::Sybase> compiled against FreeTDS
-(L<http://www.freetds.org/>) to the best of our ability, however it is
-recommended that you recompile L<DBD::Sybase> against the Sybase Open Client
-libraries. They are a part of the Sybase ASE distribution:
-
-The Open Client FAQ is here:
-L<http://www.isug.com/Sybase_FAQ/ASE/section7.html>.
-
-Sybase ASE for Linux (which comes with the Open Client libraries) may be
-downloaded here: L<http://response.sybase.com/forms/ASE_Linux_Download>.
-
-To see if you're using FreeTDS check C<< $schema->storage->using_freetds >>, or run:
-
- perl -MDBI -le 'my $dbh = DBI->connect($dsn, $user, $pass); print $dbh->{syb_oc_version}'
-
-Some versions of the libraries involved will not support placeholders, in which
-case the storage will be reblessed to
-L<DBIx::Class::Storage::DBI::Sybase::NoBindVars>.
-
-In some configurations, placeholders will work but will throw implicit type
-conversion errors for anything that's not expecting a string. In such a case,
-the C<auto_cast> option from L<DBIx::Class::Storage::DBI::AutoCast> is
-automatically set, which you may enable on connection with
-L<DBIx::Class::Storage::DBI::AutoCast/connect_call_set_auto_cast>. The type info
-for the C<CAST>s is taken from the L<DBIx::Class::ResultSource/data_type>
-definitions in your Result classes, and are mapped to a Sybase type (if it isn't
-already) using a mapping based on L<SQL::Translator>.
-
-In other configurations, placeholers will work just as they do with the Sybase
-Open Client libraries.
-
-Inserts or updates of TEXT/IMAGE columns will B<NOT> work with FreeTDS.
-
-=head1 INSERTS WITH PLACEHOLDERS
-
-With placeholders enabled, inserts are done in a transaction so that there are
-no concurrency issues with getting the inserted identity value using
-C<SELECT MAX(col)>, which is the only way to get the C<IDENTITY> value in this
-mode.
-
-In addition, they are done on a separate connection so that it's possible to
-have active cursors when doing an insert.
-
-When using C<DBIx::Class::Storage::DBI::Sybase::NoBindVars> transactions are
-disabled, as there are no concurrency issues with C<SELECT @@IDENTITY> as it's a
-session variable.
-
-=head1 TRANSACTIONS
-
-Due to limitations of the TDS protocol, L<DBD::Sybase>, or both; you cannot
-begin a transaction while there are active cursors; nor can you use multiple
-active cursors within a transaction. An active cursor is, for example, a
-L<ResultSet|DBIx::Class::ResultSet> that has been executed using C<next> or
-C<first> but has not been exhausted or L<reset|DBIx::Class::ResultSet/reset>.
-
-For example, this will not work:
-
- $schema->txn_do(sub {
- my $rs = $schema->resultset('Book');
- while (my $row = $rs->next) {
- $schema->resultset('MetaData')->create({
- book_id => $row->id,
- ...
- });
- }
- });
-
-This won't either:
-
- my $first_row = $large_rs->first;
- $schema->txn_do(sub { ... });
-
-Transactions done for inserts in C<AutoCommit> mode when placeholders are in use
-are not affected, as they are done on an extra database handle.
-
-Some workarounds:
-
-=over 4
-
-=item * use L<DBIx::Class::Storage::DBI::Replicated>
-
-=item * L<connect|DBIx::Class::Schema/connect> another L<Schema|DBIx::Class::Schema>
-
-=item * load the data from your cursor with L<DBIx::Class::ResultSet/all>
-
-=back
-
-=head1 MAXIMUM CONNECTIONS
-
-The TDS protocol makes separate connections to the server for active statements
-in the background. By default the number of such connections is limited to 25,
-on both the client side and the server side.
-
-This is a bit too low for a complex L<DBIx::Class> application, so on connection
-the client side setting is set to C<256> (see L<DBD::Sybase/maxConnect>.) You
-can override it to whatever setting you like in the DSN.
-
-See
-L<http://infocenter.sybase.com/help/index.jsp?topic=/com.sybase.help.ase_15.0.sag1/html/sag1/sag1272.htm>
-for information on changing the setting on the server side.
-
-=head1 DATES
-
-See L</connect_call_datetime_setup> to setup date formats
-for L<DBIx::Class::InflateColumn::DateTime>.
-
-=head1 TEXT/IMAGE COLUMNS
-
-L<DBD::Sybase> compiled with FreeTDS will B<NOT> allow you to insert or update
-C<TEXT/IMAGE> columns.
-
-Setting C<< $dbh->{LongReadLen} >> will also not work with FreeTDS use either:
-
- $schema->storage->dbh->do("SET TEXTSIZE $bytes");
-
-or
-
- $schema->storage->set_textsize($bytes);
-
-instead.
-
-However, the C<LongReadLen> you pass in
-L<DBIx::Class::Storage::DBI/connect_info> is used to execute the equivalent
-C<SET TEXTSIZE> command on connection.
-
-See L</connect_call_blob_setup> for a L<DBIx::Class::Storage::DBI/connect_info>
-setting you need to work with C<IMAGE> columns.
-
-=head1 BULK API
-
-The experimental L<DBD::Sybase> Bulk API support is used for
-L<populate|DBIx::Class::ResultSet/populate> in B<void> context, in a transaction
-on a separate connection.
-
-To use this feature effectively, use a large number of rows for each
-L<populate|DBIx::Class::ResultSet/populate> call, eg.:
-
- while (my $rows = $data_source->get_100_rows()) {
- $rs->populate($rows);
- }
-
-B<NOTE:> the L<add_columns|DBIx::Class::ResultSource/add_columns>
-calls in your C<Result> classes B<must> list columns in database order for this
-to work. Also, you may have to unset the C<LANG> environment variable before
-loading your app, if it doesn't match the character set of your database.
-
-When inserting IMAGE columns using this method, you'll need to use
-L</connect_call_blob_setup> as well.
-
-=head1 TODO
-
-=over
-
-=item *
-
-Transitions to AutoCommit=0 (starting a transaction) mode by exhausting
-any active cursors, using eager cursors.
-
-=item *
-
-Real limits and limited counts using stored procedures deployed on startup.
-
-=item *
-
-Adaptive Server Anywhere (ASA) support, with possible SQLA::Limit support.
-
-=item *
-
-Blob update with a LIKE query on a blob, without invalidating the WHERE condition.
-
-=item *
-
-bulk_insert using prepare_cached (see comments.)
-
-=back
-
-=head1 AUTHOR
-
-See L<DBIx::Class/CONTRIBUTORS>.
-
-=head1 LICENSE
-
-You may distribute this code under the same terms as Perl itself.
-
-=cut
-# vim:sts=2 sw=2:
Copied: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase.pm (from rev 7836, DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase/Common.pm)
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase.pm (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/Sybase.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,132 @@
+package DBIx::Class::Storage::DBI::Sybase;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI/;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase - Base class for drivers using
+L<DBD::Sybase>
+
+=head1 DESCRIPTION
+
+This is the base class/dispatcher for Storage's designed to work with
+L<DBD::Sybase>
+
+=head1 METHODS
+
+=cut
+
+sub _rebless {
+ my $self = shift;
+
+ my $dbtype = eval {
+ @{$self->_get_dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2]
+ };
+
+ $self->throw_exception("Unable to estable connection to determine database type: $@")
+ if $@;
+
+ if ($dbtype) {
+ $dbtype =~ s/\W/_/gi;
+
+ # saner class name
+ $dbtype = 'ASE' if $dbtype eq 'SQL_Server';
+
+ my $subclass = __PACKAGE__ . "::$dbtype";
+ if ($self->load_optional_class($subclass)) {
+ bless $self, $subclass;
+ $self->_rebless;
+ }
+ }
+}
+
+sub _ping {
+ my $self = shift;
+
+ my $dbh = $self->_dbh or return 0;
+
+ local $dbh->{RaiseError} = 1;
+ local $dbh->{PrintError} = 0;
+
+ if ($dbh->{syb_no_child_con}) {
+# if extra connections are not allowed, then ->ping is reliable
+ my $ping = eval { $dbh->ping };
+ return $@ ? 0 : $ping;
+ }
+
+ eval {
+# XXX if the main connection goes stale, does opening another for this statement
+# really determine anything?
+ $dbh->do('select 1');
+ };
+
+ return $@ ? 0 : 1;
+}
+
+sub _set_max_connect {
+ my $self = shift;
+ my $val = shift || 256;
+
+ my $dsn = $self->_dbi_connect_info->[0];
+
+ return if ref($dsn) eq 'CODE';
+
+ if ($dsn !~ /maxConnect=/) {
+ $self->_dbi_connect_info->[0] = "$dsn;maxConnect=$val";
+ my $connected = defined $self->_dbh;
+ $self->disconnect;
+ $self->ensure_connected if $connected;
+ }
+}
+
+=head2 using_freetds
+
+Whether or not L<DBD::Sybase> was compiled against FreeTDS. If false, it means
+the Sybase OpenClient libraries were used.
+
+=cut
+
+sub using_freetds {
+ my $self = shift;
+
+ return $self->_get_dbh->{syb_oc_version} =~ /freetds/i;
+}
+
+=head2 set_textsize
+
+When using FreeTDS and/or MSSQL, C<< $dbh->{LongReadLen} >> is not available,
+use this function instead. It does:
+
+ $dbh->do("SET TEXTSIZE $bytes");
+
+Takes the number of bytes, or uses the C<LongReadLen> value from your
+L<DBIx::Class/connect_info> if omitted, lastly falls back to the C<32768> which
+is the L<DBD::Sybase> default.
+
+=cut
+
+sub set_textsize {
+ my $self = shift;
+ my $text_size = shift ||
+ eval { $self->_dbi_connect_info->[-1]->{LongReadLen} } ||
+ 32768; # the DBD::Sybase default
+
+ return unless defined $text_size;
+
+ $self->_dbh->do("SET TEXTSIZE $text_size");
+}
+
+1;
+
+=head1 AUTHORS
+
+See L<DBIx::Class/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/mysql.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/mysql.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI/mysql.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -106,6 +106,19 @@
session variables such that MySQL behaves more predictably as far as the
SQL standard is concerned.
+=head1 STORAGE OPTIONS
+
+=head2 set_strict_mode
+
+Enables session-wide strict options upon connecting. Equivalent to:
+
+ ->connect ( ... , {
+ on_connect_do => [
+ q|SET SQL_MODE = CONCAT('ANSI,TRADITIONAL,ONLY_FULL_GROUP_BY,', @@sql_mode)|,
+ q|SET SQL_AUTO_IS_NULL = 0|,
+ ]
+ });
+
=head1 AUTHORS
See L<DBIx::Class/CONTRIBUTORS>
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBI.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -4,7 +4,7 @@
use strict;
use warnings;
-use base 'DBIx::Class::Storage';
+use base qw/DBIx::Class::Storage::DBIHacks DBIx::Class::Storage/;
use mro 'c3';
use Carp::Clan qw/^DBIx::Class/;
@@ -14,6 +14,7 @@
use Scalar::Util();
use List::Util();
use Data::Dumper::Concise();
+use Sub::Name ();
# what version of sqlt do we require if deploy() without a ddl_dir is invoked
# when changing also adjust the corresponding author_require in Makefile.PL
@@ -41,6 +42,38 @@
__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks');
+# Each of these methods need _determine_driver called before itself
+# in order to function reliably. This is a purely DRY optimization
+my @rdbms_specific_methods = qw/
+ sqlt_type
+ build_datetime_parser
+ datetime_parser_type
+
+ insert
+ insert_bulk
+ update
+ delete
+ select
+ select_single
+/;
+
+for my $meth (@rdbms_specific_methods) {
+
+ my $orig = __PACKAGE__->can ($meth)
+ or next;
+
+ no strict qw/refs/;
+ no warnings qw/redefine/;
+ *{__PACKAGE__ ."::$meth"} = Sub::Name::subname $meth => sub {
+ if (not $_[0]->_driver_determined) {
+ $_[0]->_determine_driver;
+ goto $_[0]->can($meth);
+ }
+ $orig->(@_);
+ };
+}
+
+
=head1 NAME
DBIx::Class::Storage::DBI - DBI storage handler
@@ -418,14 +451,51 @@
=cut
sub connect_info {
- my ($self, $info_arg) = @_;
+ my ($self, $info) = @_;
- return $self->_connect_info if !$info_arg;
+ return $self->_connect_info if !$info;
- my @args = @$info_arg; # take a shallow copy for further mutilation
- $self->_connect_info([@args]); # copy for _connect_info
+ $self->_connect_info($info); # copy for _connect_info
+ $info = $self->_normalize_connect_info($info)
+ if ref $info eq 'ARRAY';
+ for my $storage_opt (keys %{ $info->{storage_options} }) {
+ my $value = $info->{storage_options}{$storage_opt};
+
+ $self->$storage_opt($value);
+ }
+
+ # Kill sql_maker/_sql_maker_opts, so we get a fresh one with only
+ # the new set of options
+ $self->_sql_maker(undef);
+ $self->_sql_maker_opts({});
+
+ for my $sql_maker_opt (keys %{ $info->{sql_maker_options} }) {
+ my $value = $info->{sql_maker_options}{$sql_maker_opt};
+
+ $self->_sql_maker_opts->{$sql_maker_opt} = $value;
+ }
+
+ my %attrs = (
+ %{ $self->_default_dbi_connect_attributes || {} },
+ %{ $info->{attributes} || {} },
+ );
+
+ my @args = @{ $info->{arguments} };
+
+ $self->_dbi_connect_info([@args,
+ %attrs && !(ref $args[0] eq 'CODE') ? \%attrs : ()]);
+
+ return $self->_connect_info;
+}
+
+sub _normalize_connect_info {
+ my ($self, $info_arg) = @_;
+ my %info;
+
+ my @args = @$info_arg; # take a shallow copy for further mutilation
+
# combine/pre-parse arguments depending on invocation style
my %attrs;
@@ -461,36 +531,23 @@
@args = @args[0,1,2];
}
- # Kill sql_maker/_sql_maker_opts, so we get a fresh one with only
- # the new set of options
- $self->_sql_maker(undef);
- $self->_sql_maker_opts({});
+ $info{arguments} = \@args;
- if(keys %attrs) {
- for my $storage_opt (@storage_options, 'cursor_class') { # @storage_options is declared at the top of the module
- if(my $value = delete $attrs{$storage_opt}) {
- $self->$storage_opt($value);
- }
- }
- for my $sql_maker_opt (qw/limit_dialect quote_char name_sep/) {
- if(my $opt_val = delete $attrs{$sql_maker_opt}) {
- $self->_sql_maker_opts->{$sql_maker_opt} = $opt_val;
- }
- }
- }
+ my @storage_opts = grep exists $attrs{$_},
+ @storage_options, 'cursor_class';
- if (ref $args[0] eq 'CODE') {
- # _connect() never looks past $args[0] in this case
- %attrs = ()
- } else {
- %attrs = (
- %{ $self->_default_dbi_connect_attributes || {} },
- %attrs,
- );
- }
+ @{ $info{storage_options} }{@storage_opts} =
+ delete @attrs{@storage_opts} if @storage_opts;
- $self->_dbi_connect_info([@args, keys %attrs ? \%attrs : ()]);
- $self->_connect_info;
+ my @sql_maker_opts = grep exists $attrs{$_},
+ qw/limit_dialect quote_char name_sep/;
+
+ @{ $info{sql_maker_options} }{@sql_maker_opts} =
+ delete @attrs{@sql_maker_opts} if @sql_maker_opts;
+
+ $info{attributes} = \%attrs if %attrs;
+
+ return \%info;
}
sub _default_dbi_connect_attributes {
@@ -713,7 +770,6 @@
# Storage subclasses should override this
sub with_deferred_fk_checks {
my ($self, $sub) = @_;
-
$sub->();
}
@@ -994,7 +1050,7 @@
eval {
if(ref $info[0] eq 'CODE') {
- $dbh = &{$info[0]}
+ $dbh = $info[0]->();
}
else {
$dbh = DBI->connect(@info);
@@ -1116,6 +1172,11 @@
sub txn_begin {
my $self = shift;
+
+ # this means we have not yet connected and do not know the AC status
+ # (e.g. coderef $dbh)
+ $self->ensure_connected if (! defined $self->_dbh_autocommit);
+
if($self->{transaction_depth} == 0) {
$self->debugobj->txn_begin()
if $self->debug;
@@ -1145,7 +1206,6 @@
sub txn_commit {
my $self = shift;
if ($self->{transaction_depth} == 1) {
- my $dbh = $self->_dbh;
$self->debugobj->txn_commit()
if ($self->debug);
$self->_dbh_commit;
@@ -1161,7 +1221,9 @@
sub _dbh_commit {
my $self = shift;
- $self->_dbh->commit;
+ my $dbh = $self->_dbh
+ or $self->throw_exception('cannot COMMIT on a disconnected handle');
+ $dbh->commit;
}
sub txn_rollback {
@@ -1198,7 +1260,9 @@
sub _dbh_rollback {
my $self = shift;
- $self->_dbh->rollback;
+ my $dbh = $self->_dbh
+ or $self->throw_exception('cannot ROLLBACK on a disconnected handle');
+ $dbh->rollback;
}
# This used to be the top-half of _execute. It was split out to make it
@@ -1301,12 +1365,6 @@
sub insert {
my ($self, $source, $to_insert) = @_;
-# redispatch to insert method of storage we reblessed into, if necessary
- if (not $self->_driver_determined) {
- $self->_determine_driver;
- goto $self->can('insert');
- }
-
my $ident = $source->from;
my $bind_attributes = $self->source_bind_attributes($source);
@@ -1331,19 +1389,12 @@
return $updated_cols;
}
-## Still not quite perfect, and EXPERIMENTAL
## Currently it is assumed that all values passed will be "normal", i.e. not
## scalar refs, or at least, all the same type as the first set, the statement is
## only prepped once.
sub insert_bulk {
my ($self, $source, $cols, $data) = @_;
-# redispatch to insert_bulk method of storage we reblessed into, if necessary
- if (not $self->_driver_determined) {
- $self->_determine_driver;
- goto $self->can('insert_bulk');
- }
-
my %colvalues;
@colvalues{@$cols} = (0..$#$cols);
@@ -1417,9 +1468,13 @@
);
}
+ # neither _execute_array, nor _execute_inserts_with_no_binds are
+ # atomic (even if _execute _array is a single call). Thus a safety
+ # scope guard
+ my $guard = $self->txn_scope_guard unless $self->{transaction_depth} != 0;
+
$self->_query_start( $sql, ['__BULK__'] );
my $sth = $self->sth($sql);
-
my $rv = do {
if ($empty_bind) {
# bind_param_array doesn't work if there are no binds
@@ -1433,14 +1488,15 @@
$self->_query_end( $sql, ['__BULK__'] );
+
+ $guard->commit if $guard;
+
return (wantarray ? ($rv, $sth, @bind) : $rv);
}
sub _execute_array {
my ($self, $source, $sth, $bind, $cols, $data, @extra) = @_;
- my $guard = $self->txn_scope_guard unless $self->{transaction_depth} != 0;
-
## This must be an arrayref, else nothing works!
my $tuple_status = [];
@@ -1489,9 +1545,6 @@
}),
);
}
-
- $guard->commit if $guard;
-
return $rv;
}
@@ -1504,8 +1557,6 @@
sub _dbh_execute_inserts_with_no_binds {
my ($self, $sth, $count) = @_;
- my $guard = $self->txn_scope_guard unless $self->{transaction_depth} != 0;
-
eval {
my $dbh = $self->_get_dbh;
local $dbh->{RaiseError} = 1;
@@ -1521,40 +1572,31 @@
$self->throw_exception($exception) if $exception;
- $guard->commit if $guard;
-
return $count;
}
sub update {
- my ($self, $source, @args) = @_;
+ my ($self, $source, @args) = @_;
-# redispatch to update method of storage we reblessed into, if necessary
- if (not $self->_driver_determined) {
- $self->_determine_driver;
- goto $self->can('update');
- }
+ my $bind_attrs = $self->source_bind_attributes($source);
- my $bind_attributes = $self->source_bind_attributes($source);
-
- return $self->_execute('update' => [], $source, $bind_attributes, @args);
+ return $self->_execute('update' => [], $source, $bind_attrs, @args);
}
sub delete {
- my $self = shift @_;
- my $source = shift @_;
- $self->_determine_driver;
+ my ($self, $source, @args) = @_;
+
my $bind_attrs = $self->source_bind_attributes($source);
- return $self->_execute('delete' => [], $source, $bind_attrs, @_);
+ return $self->_execute('delete' => [], $source, $bind_attrs, @args);
}
# We were sent here because the $rs contains a complex search
# which will require a subquery to select the correct rows
-# (i.e. joined or limited resultsets)
+# (i.e. joined or limited resultsets, or non-introspectable conditions)
#
-# Genarating a single PK column subquery is trivial and supported
+# Generating a single PK column subquery is trivial and supported
# by all RDBMS. However if we have a multicolumn PK, things get ugly.
# Look at _multipk_update_delete()
sub _subq_update_delete {
@@ -1563,14 +1605,27 @@
my $rsrc = $rs->result_source;
- # we already check this, but double check naively just in case. Should be removed soon
+ # quick check if we got a sane rs on our hands
+ my @pcols = $rsrc->primary_columns;
+ unless (@pcols) {
+ $self->throw_exception (
+ sprintf (
+ "You must declare primary key(s) on source '%s' (via set_primary_key) in order to update or delete complex resultsets",
+ $rsrc->source_name || $rsrc->from
+ )
+ );
+ }
+
my $sel = $rs->_resolved_attrs->{select};
$sel = [ $sel ] unless ref $sel eq 'ARRAY';
- my @pcols = $rsrc->primary_columns;
- if (@$sel != @pcols) {
+
+ if (
+ join ("\x00", map { join '.', $rs->{attrs}{alias}, $_ } sort @pcols)
+ ne
+ join ("\x00", sort @$sel )
+ ) {
$self->throw_exception (
- 'Subquery update/delete can not be called on resultsets selecting a'
- .' number of columns different than the number of primary keys'
+ '_subq_update_delete can not be called on resultsets selecting columns other than the primary keys'
);
}
@@ -1620,11 +1675,12 @@
my $row_cnt = '0E0';
my $subrs_cur = $rs->cursor;
- while (my @pks = $subrs_cur->next) {
+ my @all_pk = $subrs_cur->all;
+ for my $pks ( @all_pk) {
my $cond;
for my $i (0.. $#pcols) {
- $cond->{$pcols[$i]} = $pks[$i];
+ $cond->{$pcols[$i]} = $pks->[$i];
}
$self->$op (
@@ -1688,7 +1744,7 @@
select => $select,
from => $ident,
where => $where,
- $rs_alias
+ $rs_alias && $alias2source->{$rs_alias}
? ( _source_handle => $alias2source->{$rs_alias}->handle )
: ()
,
@@ -1739,21 +1795,76 @@
my @limit;
- # see if we need to tear the prefetch apart (either limited has_many or grouped prefetch)
- # otherwise delegate the limiting to the storage, unless software limit was requested
+ # see if we need to tear the prefetch apart otherwise delegate the limiting to the
+ # storage, unless software limit was requested
if (
+ #limited has_many
( $attrs->{rows} && keys %{$attrs->{collapse}} )
||
- ( $attrs->{group_by} && @{$attrs->{group_by}} &&
- $attrs->{_prefetch_select} && @{$attrs->{_prefetch_select}} )
+ # limited prefetch with RNO subqueries
+ (
+ $attrs->{rows}
+ &&
+ $sql_maker->limit_dialect eq 'RowNumberOver'
+ &&
+ $attrs->{_prefetch_select}
+ &&
+ @{$attrs->{_prefetch_select}}
+ )
+ ||
+ # grouped prefetch
+ ( $attrs->{group_by}
+ &&
+ @{$attrs->{group_by}}
+ &&
+ $attrs->{_prefetch_select}
+ &&
+ @{$attrs->{_prefetch_select}}
+ )
) {
($ident, $select, $where, $attrs)
= $self->_adjust_select_args_for_complex_prefetch ($ident, $select, $where, $attrs);
}
+
+ elsif (
+ ($attrs->{rows} || $attrs->{offset})
+ &&
+ $sql_maker->limit_dialect eq 'RowNumberOver'
+ &&
+ (ref $ident eq 'ARRAY' && @$ident > 1) # indicates a join
+ &&
+ scalar $self->_parse_order_by ($attrs->{order_by})
+ ) {
+ # the RNO limit dialect above mangles the SQL such that the join gets lost
+ # wrap a subquery here
+
+ push @limit, delete @{$attrs}{qw/rows offset/};
+
+ my $subq = $self->_select_args_to_query (
+ $ident,
+ $select,
+ $where,
+ $attrs,
+ );
+
+ $ident = {
+ -alias => $attrs->{alias},
+ -source_handle => $ident->[0]{-source_handle},
+ $attrs->{alias} => $subq,
+ };
+
+ # all part of the subquery now
+ delete @{$attrs}{qw/order_by group_by having/};
+ $where = undef;
+ }
+
elsif (! $attrs->{software_limit} ) {
push @limit, $attrs->{rows}, $attrs->{offset};
}
+ # try to simplify the joinmap further (prune unreferenced type-single joins)
+ $ident = $self->_prune_unused_joins ($ident, $select, $where, $attrs);
+
###
# This would be the point to deflate anything found in $where
# (and leave $attrs->{bind} intact). Problem is - inflators historically
@@ -1772,324 +1883,6 @@
return ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $where, $order, @limit);
}
-#
-# This is the code producing joined subqueries like:
-# SELECT me.*, other.* FROM ( SELECT me.* FROM ... ) JOIN other ON ...
-#
-sub _adjust_select_args_for_complex_prefetch {
- my ($self, $from, $select, $where, $attrs) = @_;
-
- $self->throw_exception ('Nothing to prefetch... how did we get here?!')
- if not @{$attrs->{_prefetch_select}};
-
- $self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute')
- if (ref $from ne 'ARRAY' || ref $from->[0] ne 'HASH' || ref $from->[1] ne 'ARRAY');
-
-
- # generate inner/outer attribute lists, remove stuff that doesn't apply
- my $outer_attrs = { %$attrs };
- delete $outer_attrs->{$_} for qw/where bind rows offset group_by having/;
-
- my $inner_attrs = { %$attrs };
- delete $inner_attrs->{$_} for qw/for collapse _prefetch_select _collapse_order_by select as/;
-
-
- # bring over all non-collapse-induced order_by into the inner query (if any)
- # the outer one will have to keep them all
- delete $inner_attrs->{order_by};
- if (my $ord_cnt = @{$outer_attrs->{order_by}} - @{$outer_attrs->{_collapse_order_by}} ) {
- $inner_attrs->{order_by} = [
- @{$outer_attrs->{order_by}}[ 0 .. $ord_cnt - 1]
- ];
- }
-
-
- # generate the inner/outer select lists
- # for inside we consider only stuff *not* brought in by the prefetch
- # on the outside we substitute any function for its alias
- my $outer_select = [ @$select ];
- my $inner_select = [];
- for my $i (0 .. ( @$outer_select - @{$outer_attrs->{_prefetch_select}} - 1) ) {
- my $sel = $outer_select->[$i];
-
- if (ref $sel eq 'HASH' ) {
- $sel->{-as} ||= $attrs->{as}[$i];
- $outer_select->[$i] = join ('.', $attrs->{alias}, ($sel->{-as} || "inner_column_$i") );
- }
-
- push @$inner_select, $sel;
- }
-
- # normalize a copy of $from, so it will be easier to work with further
- # down (i.e. promote the initial hashref to an AoH)
- $from = [ @$from ];
- $from->[0] = [ $from->[0] ];
- my %original_join_info = map { $_->[0]{-alias} => $_->[0] } (@$from);
-
-
- # decide which parts of the join will remain in either part of
- # the outer/inner query
-
- # First we compose a list of which aliases are used in restrictions
- # (i.e. conditions/order/grouping/etc). Since we do not have
- # introspectable SQLA, we fall back to ugly scanning of raw SQL for
- # WHERE, and for pieces of ORDER BY in order to determine which aliases
- # need to appear in the resulting sql.
- # It may not be very efficient, but it's a reasonable stop-gap
- # Also unqualified column names will not be considered, but more often
- # than not this is actually ok
- #
- # In the same loop we enumerate part of the selection aliases, as
- # it requires the same sqla hack for the time being
- my ($restrict_aliases, $select_aliases, $prefetch_aliases);
- {
- # produce stuff unquoted, so it can be scanned
- my $sql_maker = $self->sql_maker;
- local $sql_maker->{quote_char};
- my $sep = $self->_sql_maker_opts->{name_sep} || '.';
- $sep = "\Q$sep\E";
-
- my $non_prefetch_select_sql = $sql_maker->_recurse_fields ($inner_select);
- my $prefetch_select_sql = $sql_maker->_recurse_fields ($outer_attrs->{_prefetch_select});
- my $where_sql = $sql_maker->where ($where);
- my $group_by_sql = $sql_maker->_order_by({
- map { $_ => $inner_attrs->{$_} } qw/group_by having/
- });
- my @non_prefetch_order_by_chunks = (map
- { ref $_ ? $_->[0] : $_ }
- $sql_maker->_order_by_chunks ($inner_attrs->{order_by})
- );
-
-
- for my $alias (keys %original_join_info) {
- my $seen_re = qr/\b $alias $sep/x;
-
- for my $piece ($where_sql, $group_by_sql, @non_prefetch_order_by_chunks ) {
- if ($piece =~ $seen_re) {
- $restrict_aliases->{$alias} = 1;
- }
- }
-
- if ($non_prefetch_select_sql =~ $seen_re) {
- $select_aliases->{$alias} = 1;
- }
-
- if ($prefetch_select_sql =~ $seen_re) {
- $prefetch_aliases->{$alias} = 1;
- }
-
- }
- }
-
- # Add any non-left joins to the restriction list (such joins are indeed restrictions)
- for my $j (values %original_join_info) {
- my $alias = $j->{-alias} or next;
- $restrict_aliases->{$alias} = 1 if (
- (not $j->{-join_type})
- or
- ($j->{-join_type} !~ /^left (?: \s+ outer)? $/xi)
- );
- }
-
- # mark all join parents as mentioned
- # (e.g. join => { cds => 'tracks' } - tracks will need to bring cds too )
- for my $collection ($restrict_aliases, $select_aliases) {
- for my $alias (keys %$collection) {
- $collection->{$_} = 1
- for (@{ $original_join_info{$alias}{-join_path} || [] });
- }
- }
-
- # construct the inner $from for the subquery
- my %inner_joins = (map { %{$_ || {}} } ($restrict_aliases, $select_aliases) );
- my @inner_from;
- for my $j (@$from) {
- push @inner_from, $j if $inner_joins{$j->[0]{-alias}};
- }
-
- # if a multi-type join was needed in the subquery ("multi" is indicated by
- # presence in {collapse}) - add a group_by to simulate the collapse in the subq
- unless ($inner_attrs->{group_by}) {
- for my $alias (keys %inner_joins) {
-
- # the dot comes from some weirdness in collapse
- # remove after the rewrite
- if ($attrs->{collapse}{".$alias"}) {
- $inner_attrs->{group_by} ||= $inner_select;
- last;
- }
- }
- }
-
- # demote the inner_from head
- $inner_from[0] = $inner_from[0][0];
-
- # generate the subquery
- my $subq = $self->_select_args_to_query (
- \@inner_from,
- $inner_select,
- $where,
- $inner_attrs,
- );
-
- my $subq_joinspec = {
- -alias => $attrs->{alias},
- -source_handle => $inner_from[0]{-source_handle},
- $attrs->{alias} => $subq,
- };
-
- # Generate the outer from - this is relatively easy (really just replace
- # the join slot with the subquery), with a major caveat - we can not
- # join anything that is non-selecting (not part of the prefetch), but at
- # the same time is a multi-type relationship, as it will explode the result.
- #
- # There are two possibilities here
- # - either the join is non-restricting, in which case we simply throw it away
- # - it is part of the restrictions, in which case we need to collapse the outer
- # result by tackling yet another group_by to the outside of the query
-
- # so first generate the outer_from, up to the substitution point
- my @outer_from;
- while (my $j = shift @$from) {
- if ($j->[0]{-alias} eq $attrs->{alias}) { # time to swap
- push @outer_from, [
- $subq_joinspec,
- @{$j}[1 .. $#$j],
- ];
- last; # we'll take care of what's left in $from below
- }
- else {
- push @outer_from, $j;
- }
- }
-
- # see what's left - throw away if not selecting/restricting
- # also throw in a group_by if restricting to guard against
- # cross-join explosions
- #
- while (my $j = shift @$from) {
- my $alias = $j->[0]{-alias};
-
- if ($select_aliases->{$alias} || $prefetch_aliases->{$alias}) {
- push @outer_from, $j;
- }
- elsif ($restrict_aliases->{$alias}) {
- push @outer_from, $j;
-
- # FIXME - this should be obviated by SQLA2, as I'll be able to
- # have restrict_inner and restrict_outer... or something to that
- # effect... I think...
-
- # FIXME2 - I can't find a clean way to determine if a particular join
- # is a multi - instead I am just treating everything as a potential
- # explosive join (ribasushi)
- #
- # if (my $handle = $j->[0]{-source_handle}) {
- # my $rsrc = $handle->resolve;
- # ... need to bail out of the following if this is not a multi,
- # as it will be much easier on the db ...
-
- $outer_attrs->{group_by} ||= $outer_select;
- # }
- }
- }
-
- # demote the outer_from head
- $outer_from[0] = $outer_from[0][0];
-
- # This is totally horrific - the $where ends up in both the inner and outer query
- # Unfortunately not much can be done until SQLA2 introspection arrives, and even
- # then if where conditions apply to the *right* side of the prefetch, you may have
- # to both filter the inner select (e.g. to apply a limit) and then have to re-filter
- # the outer select to exclude joins you didin't want in the first place
- #
- # OTOH it can be seen as a plus: <ash> (notes that this query would make a DBA cry ;)
- return (\@outer_from, $outer_select, $where, $outer_attrs);
-}
-
-sub _resolve_ident_sources {
- my ($self, $ident) = @_;
-
- my $alias2source = {};
- my $rs_alias;
-
- # the reason this is so contrived is that $ident may be a {from}
- # structure, specifying multiple tables to join
- if ( Scalar::Util::blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
- # this is compat mode for insert/update/delete which do not deal with aliases
- $alias2source->{me} = $ident;
- $rs_alias = 'me';
- }
- elsif (ref $ident eq 'ARRAY') {
-
- for (@$ident) {
- my $tabinfo;
- if (ref $_ eq 'HASH') {
- $tabinfo = $_;
- $rs_alias = $tabinfo->{-alias};
- }
- if (ref $_ eq 'ARRAY' and ref $_->[0] eq 'HASH') {
- $tabinfo = $_->[0];
- }
-
- $alias2source->{$tabinfo->{-alias}} = $tabinfo->{-source_handle}->resolve
- if ($tabinfo->{-source_handle});
- }
- }
-
- return ($alias2source, $rs_alias);
-}
-
-# Takes $ident, \@column_names
-#
-# returns { $column_name => \%column_info, ... }
-# also note: this adds -result_source => $rsrc to the column info
-#
-# usage:
-# my $col_sources = $self->_resolve_column_info($ident, @column_names);
-sub _resolve_column_info {
- my ($self, $ident, $colnames) = @_;
- my ($alias2src, $root_alias) = $self->_resolve_ident_sources($ident);
-
- my $sep = $self->_sql_maker_opts->{name_sep} || '.';
- $sep = "\Q$sep\E";
-
- my (%return, %seen_cols);
-
- # compile a global list of column names, to be able to properly
- # disambiguate unqualified column names (if at all possible)
- for my $alias (keys %$alias2src) {
- my $rsrc = $alias2src->{$alias};
- for my $colname ($rsrc->columns) {
- push @{$seen_cols{$colname}}, $alias;
- }
- }
-
- COLUMN:
- foreach my $col (@$colnames) {
- my ($alias, $colname) = $col =~ m/^ (?: ([^$sep]+) $sep)? (.+) $/x;
-
- unless ($alias) {
- # see if the column was seen exactly once (so we know which rsrc it came from)
- if ($seen_cols{$colname} and @{$seen_cols{$colname}} == 1) {
- $alias = $seen_cols{$colname}[0];
- }
- else {
- next COLUMN;
- }
- }
-
- my $rsrc = $alias2src->{$alias};
- $return{$col} = $rsrc && {
- %{$rsrc->column_info($colname)},
- -result_source => $rsrc,
- -source_alias => $alias,
- };
- }
-
- return \%return;
-}
-
# Returns a counting SELECT for a simple count
# query. Abstracted so that a storage could override
# this to { count => 'firstcol' } or whatever makes
@@ -2260,18 +2053,14 @@
=cut
sub _dbh_last_insert_id {
- # All Storage's need to register their own _dbh_last_insert_id
- # the old SQLite-based method was highly inappropriate
+ my ($self, $dbh, $source, $col) = @_;
- my $self = shift;
- my $class = ref $self;
- $self->throw_exception (<<EOE);
+ my $id = eval { $dbh->last_insert_id (undef, undef, $source->name, $col) };
-No _dbh_last_insert_id() method found in $class.
-Since the method of obtaining the autoincrement id of the last insert
-operation varies greatly between different databases, this method must be
-individually implemented for every storage class.
-EOE
+ return $id if defined $id;
+
+ my $class = ref $self;
+ $self->throw_exception ("No storage specific _dbh_last_insert_id() method implemented in $class, and the generic DBI::last_insert_id() failed");
}
sub last_insert_id {
@@ -2289,7 +2078,7 @@
This API is B<EXPERIMENTAL>, will almost definitely change in the future, and
currently only used by L<::AutoCast|DBIx::Class::Storage::DBI::AutoCast> and
-L<::Sybase|DBIx::Class::Storage::DBI::Sybase>.
+L<::Sybase::ASE|DBIx::Class::Storage::DBI::Sybase::ASE>.
The default implementation returns C<undef>, implement in your Storage driver if
you need this functionality.
@@ -2347,14 +2136,7 @@
=cut
sub sqlt_type {
- my ($self) = @_;
-
- if (not $self->_driver_determined) {
- $self->_determine_driver;
- goto $self->can ('sqlt_type');
- }
-
- $self->_get_dbh->{Driver}->{Name};
+ shift->_get_dbh->{Driver}->{Name};
}
=head2 bind_attribute_by_data_type
@@ -2392,7 +2174,7 @@
}
-=head2 create_ddl_dir (EXPERIMENTAL)
+=head2 create_ddl_dir
=over 4
@@ -2444,11 +2226,9 @@
{ ignore_constraint_names => 0, # ... other options }
-Note that this feature is currently EXPERIMENTAL and may not work correctly
-across all databases, or fully handle complex relationships.
+WARNING: You are strongly advised to check all SQL files created, before applying
+them.
-WARNING: Please check all SQL files created, before applying them.
-
=cut
sub create_ddl_dir {
@@ -2629,10 +2409,19 @@
data => $schema,
);
- my $ret = $tr->translate
- or $self->throw_exception( 'Unable to produce deployment statements: ' . $tr->error);
+ my @ret;
+ my $wa = wantarray;
+ if ($wa) {
+ @ret = $tr->translate;
+ }
+ else {
+ $ret[0] = $tr->translate;
+ }
- return $ret;
+ $self->throw_exception( 'Unable to produce deployment statements: ' . $tr->error)
+ unless (@ret && defined $ret[0]);
+
+ return $wa ? @ret : $ret[0];
}
sub deploy {
@@ -2698,11 +2487,6 @@
=cut
sub build_datetime_parser {
- if (not $_[0]->_driver_determined) {
- $_[0]->_determine_driver;
- goto $_[0]->can('build_datetime_parser');
- }
-
my $self = shift;
my $type = $self->datetime_parser_type(@_);
$self->ensure_class_loaded ($type);
@@ -2762,6 +2546,34 @@
sub _sqlt_minimum_version { $minimum_sqlt_version };
}
+=head2 relname_to_table_alias
+
+=over 4
+
+=item Arguments: $relname, $join_count
+
+=back
+
+L<DBIx::Class> uses L<DBIx::Class::Relationship> names as table aliases in
+queries.
+
+This hook is to allow specific L<DBIx::Class::Storage> drivers to change the
+way these aliases are named.
+
+The default behavior is C<"$relname_$join_count" if $join_count > 1>, otherwise
+C<"$relname">.
+
+=cut
+
+sub relname_to_table_alias {
+ my ($self, $relname, $join_count) = @_;
+
+ my $alias = ($join_count && $join_count > 1 ?
+ join('_', $relname, $join_count) : $relname);
+
+ return $alias;
+}
+
sub DESTROY {
my $self = shift;
@@ -2770,7 +2582,10 @@
# some databases need this to stop spewing warnings
if (my $dbh = $self->_dbh) {
local $@;
- eval { $dbh->disconnect };
+ eval {
+ %{ $dbh->{CachedKids} } = ();
+ $dbh->disconnect;
+ };
}
$self->_dbh(undef);
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBIHacks.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBIHacks.pm (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/Storage/DBIHacks.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,504 @@
+package #hide from PAUSE
+ DBIx::Class::Storage::DBIHacks;
+
+#
+# This module contains code that should never have seen the light of day,
+# does not belong in the Storage, or is otherwise unfit for public
+# display. The arrival of SQLA2 should immediately oboslete 90% of this
+#
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Storage';
+use mro 'c3';
+
+use Carp::Clan qw/^DBIx::Class/;
+
+#
+# This code will remove non-selecting/non-restricting joins from
+# {from} specs, aiding the RDBMS query optimizer
+#
+sub _prune_unused_joins {
+ my ($self) = shift;
+
+ my ($from, $select, $where, $attrs) = @_;
+
+ if (ref $from ne 'ARRAY' || ref $from->[0] ne 'HASH' || ref $from->[1] ne 'ARRAY') {
+ return $from; # only standard {from} specs are supported
+ }
+
+ my $aliastypes = $self->_resolve_aliastypes_from_select_args(@_);
+
+ # a grouped set will not be affected by amount of rows. Thus any
+ # {multiplying} joins can go
+ delete $aliastypes->{multiplying} if $attrs->{group_by};
+
+
+ my @newfrom = $from->[0]; # FROM head is always present
+
+ my %need_joins = (map { %{$_||{}} } (values %$aliastypes) );
+ for my $j (@{$from}[1..$#$from]) {
+ push @newfrom, $j if (
+ (! $j->[0]{-alias}) # legacy crap
+ ||
+ $need_joins{$j->[0]{-alias}}
+ );
+ }
+
+ return \@newfrom;
+}
+
+#
+# This is the code producing joined subqueries like:
+# SELECT me.*, other.* FROM ( SELECT me.* FROM ... ) JOIN other ON ...
+#
+sub _adjust_select_args_for_complex_prefetch {
+ my ($self, $from, $select, $where, $attrs) = @_;
+
+ $self->throw_exception ('Nothing to prefetch... how did we get here?!')
+ if not @{$attrs->{_prefetch_select}};
+
+ $self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute')
+ if (ref $from ne 'ARRAY' || ref $from->[0] ne 'HASH' || ref $from->[1] ne 'ARRAY');
+
+
+ # generate inner/outer attribute lists, remove stuff that doesn't apply
+ my $outer_attrs = { %$attrs };
+ delete $outer_attrs->{$_} for qw/where bind rows offset group_by having/;
+
+ my $inner_attrs = { %$attrs };
+ delete $inner_attrs->{$_} for qw/for collapse _prefetch_select _collapse_order_by select as/;
+
+
+ # bring over all non-collapse-induced order_by into the inner query (if any)
+ # the outer one will have to keep them all
+ delete $inner_attrs->{order_by};
+ if (my $ord_cnt = @{$outer_attrs->{order_by}} - @{$outer_attrs->{_collapse_order_by}} ) {
+ $inner_attrs->{order_by} = [
+ @{$outer_attrs->{order_by}}[ 0 .. $ord_cnt - 1]
+ ];
+ }
+
+ # generate the inner/outer select lists
+ # for inside we consider only stuff *not* brought in by the prefetch
+ # on the outside we substitute any function for its alias
+ my $outer_select = [ @$select ];
+ my $inner_select = [];
+ for my $i (0 .. ( @$outer_select - @{$outer_attrs->{_prefetch_select}} - 1) ) {
+ my $sel = $outer_select->[$i];
+
+ if (ref $sel eq 'HASH' ) {
+ $sel->{-as} ||= $attrs->{as}[$i];
+ $outer_select->[$i] = join ('.', $attrs->{alias}, ($sel->{-as} || "inner_column_$i") );
+ }
+
+ push @$inner_select, $sel;
+ }
+
+ # construct the inner $from for the subquery
+ # we need to prune first, because this will determine if we need a group_bu below
+ my $inner_from = $self->_prune_unused_joins ($from, $inner_select, $where, $inner_attrs);
+
+ # if a multi-type join was needed in the subquery - add a group_by to simulate the
+ # collapse in the subq
+ $inner_attrs->{group_by} ||= $inner_select
+ if List::Util::first
+ { ! $_->[0]{-is_single} }
+ (@{$inner_from}[1 .. $#$inner_from])
+ ;
+
+ # generate the subquery
+ my $subq = $self->_select_args_to_query (
+ $inner_from,
+ $inner_select,
+ $where,
+ $inner_attrs,
+ );
+
+ my $subq_joinspec = {
+ -alias => $attrs->{alias},
+ -source_handle => $inner_from->[0]{-source_handle},
+ $attrs->{alias} => $subq,
+ };
+
+ # Generate the outer from - this is relatively easy (really just replace
+ # the join slot with the subquery), with a major caveat - we can not
+ # join anything that is non-selecting (not part of the prefetch), but at
+ # the same time is a multi-type relationship, as it will explode the result.
+ #
+ # There are two possibilities here
+ # - either the join is non-restricting, in which case we simply throw it away
+ # - it is part of the restrictions, in which case we need to collapse the outer
+ # result by tackling yet another group_by to the outside of the query
+
+ # normalize a copy of $from, so it will be easier to work with further
+ # down (i.e. promote the initial hashref to an AoH)
+ $from = [ @$from ];
+ $from->[0] = [ $from->[0] ];
+
+ # so first generate the outer_from, up to the substitution point
+ my @outer_from;
+ while (my $j = shift @$from) {
+ if ($j->[0]{-alias} eq $attrs->{alias}) { # time to swap
+ push @outer_from, [
+ $subq_joinspec,
+ @{$j}[1 .. $#$j],
+ ];
+ last; # we'll take care of what's left in $from below
+ }
+ else {
+ push @outer_from, $j;
+ }
+ }
+
+ # scan the from spec against different attributes, and see which joins are needed
+ # in what role
+ my $outer_aliastypes =
+ $self->_resolve_aliastypes_from_select_args( $from, $outer_select, $where, $outer_attrs );
+
+ # see what's left - throw away if not selecting/restricting
+ # also throw in a group_by if restricting to guard against
+ # cross-join explosions
+ #
+ while (my $j = shift @$from) {
+ my $alias = $j->[0]{-alias};
+
+ if ($outer_aliastypes->{select}{$alias}) {
+ push @outer_from, $j;
+ }
+ elsif ($outer_aliastypes->{restrict}{$alias}) {
+ push @outer_from, $j;
+ $outer_attrs->{group_by} ||= $outer_select unless $j->[0]{-is_single};
+ }
+ }
+
+ # demote the outer_from head
+ $outer_from[0] = $outer_from[0][0];
+
+ # This is totally horrific - the $where ends up in both the inner and outer query
+ # Unfortunately not much can be done until SQLA2 introspection arrives, and even
+ # then if where conditions apply to the *right* side of the prefetch, you may have
+ # to both filter the inner select (e.g. to apply a limit) and then have to re-filter
+ # the outer select to exclude joins you didin't want in the first place
+ #
+ # OTOH it can be seen as a plus: <ash> (notes that this query would make a DBA cry ;)
+ return (\@outer_from, $outer_select, $where, $outer_attrs);
+}
+
+# Due to a lack of SQLA2 we fall back to crude scans of all the
+# select/where/order/group attributes, in order to determine what
+# aliases are neded to fulfill the query. This information is used
+# throughout the code to prune unnecessary JOINs from the queries
+# in an attempt to reduce the execution time.
+# Although the method is pretty horrific, the worst thing that can
+# happen is for it to fail due to an unqualified column, which in
+# turn will result in a vocal exception. Qualifying the column will
+# invariably solve the problem.
+sub _resolve_aliastypes_from_select_args {
+ my ( $self, $from, $select, $where, $attrs ) = @_;
+
+ $self->throw_exception ('Unable to analyze custom {from}')
+ if ref $from ne 'ARRAY';
+
+ # what we will return
+ my $aliases_by_type;
+
+ # see what aliases are there to work with
+ my $alias_list;
+ for (@$from) {
+ my $j = $_;
+ $j = $j->[0] if ref $j eq 'ARRAY';
+ my $al = $j->{-alias}
+ or next;
+
+ $alias_list->{$al} = $j;
+ $aliases_by_type->{multiplying}{$al} = 1
+ unless $j->{-is_single};
+ }
+
+ # set up a botched SQLA
+ my $sql_maker = $self->sql_maker;
+ my $sep = quotemeta ($self->_sql_maker_opts->{name_sep} || '.');
+ local $sql_maker->{quote_char}; # so that we can regex away
+
+
+ my $select_sql = $sql_maker->_recurse_fields ($select);
+ my $where_sql = $sql_maker->where ($where);
+ my $group_by_sql = $sql_maker->_order_by({
+ map { $_ => $attrs->{$_} } qw/group_by having/
+ });
+ my @order_by_chunks = ($self->_parse_order_by ($attrs->{order_by}) );
+
+ # match every alias to the sql chunks above
+ for my $alias (keys %$alias_list) {
+ my $al_re = qr/\b $alias $sep/x;
+
+ for my $piece ($where_sql, $group_by_sql) {
+ $aliases_by_type->{restrict}{$alias} = 1 if ($piece =~ $al_re);
+ }
+
+ for my $piece ($select_sql, @order_by_chunks ) {
+ $aliases_by_type->{select}{$alias} = 1 if ($piece =~ $al_re);
+ }
+ }
+
+ # Add any non-left joins to the restriction list (such joins are indeed restrictions)
+ for my $j (values %$alias_list) {
+ my $alias = $j->{-alias} or next;
+ $aliases_by_type->{restrict}{$alias} = 1 if (
+ (not $j->{-join_type})
+ or
+ ($j->{-join_type} !~ /^left (?: \s+ outer)? $/xi)
+ );
+ }
+
+ # mark all join parents as mentioned
+ # (e.g. join => { cds => 'tracks' } - tracks will need to bring cds too )
+ for my $type (keys %$aliases_by_type) {
+ for my $alias (keys %{$aliases_by_type->{$type}}) {
+ $aliases_by_type->{$type}{$_} = 1
+ for (map { keys %$_ } @{ $alias_list->{$alias}{-join_path} || [] });
+ }
+ }
+
+ return $aliases_by_type;
+}
+
+sub _resolve_ident_sources {
+ my ($self, $ident) = @_;
+
+ my $alias2source = {};
+ my $rs_alias;
+
+ # the reason this is so contrived is that $ident may be a {from}
+ # structure, specifying multiple tables to join
+ if ( Scalar::Util::blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
+ # this is compat mode for insert/update/delete which do not deal with aliases
+ $alias2source->{me} = $ident;
+ $rs_alias = 'me';
+ }
+ elsif (ref $ident eq 'ARRAY') {
+
+ for (@$ident) {
+ my $tabinfo;
+ if (ref $_ eq 'HASH') {
+ $tabinfo = $_;
+ $rs_alias = $tabinfo->{-alias};
+ }
+ if (ref $_ eq 'ARRAY' and ref $_->[0] eq 'HASH') {
+ $tabinfo = $_->[0];
+ }
+
+ $alias2source->{$tabinfo->{-alias}} = $tabinfo->{-source_handle}->resolve
+ if ($tabinfo->{-source_handle});
+ }
+ }
+
+ return ($alias2source, $rs_alias);
+}
+
+# Takes $ident, \@column_names
+#
+# returns { $column_name => \%column_info, ... }
+# also note: this adds -result_source => $rsrc to the column info
+#
+# If no columns_names are supplied returns info about *all* columns
+# for all sources
+sub _resolve_column_info {
+ my ($self, $ident, $colnames) = @_;
+ my ($alias2src, $root_alias) = $self->_resolve_ident_sources($ident);
+
+ my $sep = $self->_sql_maker_opts->{name_sep} || '.';
+ my $qsep = quotemeta $sep;
+
+ my (%return, %seen_cols, @auto_colnames);
+
+ # compile a global list of column names, to be able to properly
+ # disambiguate unqualified column names (if at all possible)
+ for my $alias (keys %$alias2src) {
+ my $rsrc = $alias2src->{$alias};
+ for my $colname ($rsrc->columns) {
+ push @{$seen_cols{$colname}}, $alias;
+ push @auto_colnames, "$alias$sep$colname" unless $colnames;
+ }
+ }
+
+ $colnames ||= [
+ @auto_colnames,
+ grep { @{$seen_cols{$_}} == 1 } (keys %seen_cols),
+ ];
+
+ COLUMN:
+ foreach my $col (@$colnames) {
+ my ($alias, $colname) = $col =~ m/^ (?: ([^$qsep]+) $qsep)? (.+) $/x;
+
+ unless ($alias) {
+ # see if the column was seen exactly once (so we know which rsrc it came from)
+ if ($seen_cols{$colname} and @{$seen_cols{$colname}} == 1) {
+ $alias = $seen_cols{$colname}[0];
+ }
+ else {
+ next COLUMN;
+ }
+ }
+
+ my $rsrc = $alias2src->{$alias};
+ $return{$col} = $rsrc && {
+ %{$rsrc->column_info($colname)},
+ -result_source => $rsrc,
+ -source_alias => $alias,
+ };
+ }
+
+ return \%return;
+}
+
+# The DBIC relationship chaining implementation is pretty simple - every
+# new related_relationship is pushed onto the {from} stack, and the {select}
+# window simply slides further in. This means that when we count somewhere
+# in the middle, we got to make sure that everything in the join chain is an
+# actual inner join, otherwise the count will come back with unpredictable
+# results (a resultset may be generated with _some_ rows regardless of if
+# the relation which the $rs currently selects has rows or not). E.g.
+# $artist_rs->cds->count - normally generates:
+# SELECT COUNT( * ) FROM artist me LEFT JOIN cd cds ON cds.artist = me.artistid
+# which actually returns the number of artists * (number of cds || 1)
+#
+# So what we do here is crawl {from}, determine if the current alias is at
+# the top of the stack, and if not - make sure the chain is inner-joined down
+# to the root.
+#
+sub _straight_join_to_node {
+ my ($self, $from, $alias) = @_;
+
+ # subqueries and other oddness are naturally not supported
+ return $from if (
+ ref $from ne 'ARRAY'
+ ||
+ @$from <= 1
+ ||
+ ref $from->[0] ne 'HASH'
+ ||
+ ! $from->[0]{-alias}
+ ||
+ $from->[0]{-alias} eq $alias # this last bit means $alias is the head of $from - nothing to do
+ );
+
+ # find the current $alias in the $from structure
+ my $switch_branch;
+ JOINSCAN:
+ for my $j (@{$from}[1 .. $#$from]) {
+ if ($j->[0]{-alias} eq $alias) {
+ $switch_branch = $j->[0]{-join_path};
+ last JOINSCAN;
+ }
+ }
+
+ # something else went quite wrong
+ return $from unless $switch_branch;
+
+ # So it looks like we will have to switch some stuff around.
+ # local() is useless here as we will be leaving the scope
+ # anyway, and deep cloning is just too fucking expensive
+ # So replace the first hashref in the node arrayref manually
+ my @new_from = ($from->[0]);
+ my $sw_idx = { map { values %$_ => 1 } @$switch_branch };
+
+ for my $j (@{$from}[1 .. $#$from]) {
+ my $jalias = $j->[0]{-alias};
+
+ if ($sw_idx->{$jalias}) {
+ my %attrs = %{$j->[0]};
+ delete $attrs{-join_type};
+ push @new_from, [
+ \%attrs,
+ @{$j}[ 1 .. $#$j ],
+ ];
+ }
+ else {
+ push @new_from, $j;
+ }
+ }
+
+ return \@new_from;
+}
+
+# Most databases do not allow aliasing of tables in UPDATE/DELETE. Thus
+# a condition containing 'me' or other table prefixes will not work
+# at all. What this code tries to do (badly) is introspect the condition
+# and remove all column qualifiers. If it bails out early (returns undef)
+# the calling code should try another approach (e.g. a subquery)
+sub _strip_cond_qualifiers {
+ my ($self, $where) = @_;
+
+ my $cond = {};
+
+ # No-op. No condition, we're updating/deleting everything
+ return $cond unless $where;
+
+ if (ref $where eq 'ARRAY') {
+ $cond = [
+ map {
+ my %hash;
+ foreach my $key (keys %{$_}) {
+ $key =~ /([^.]+)$/;
+ $hash{$1} = $_->{$key};
+ }
+ \%hash;
+ } @$where
+ ];
+ }
+ elsif (ref $where eq 'HASH') {
+ if ( (keys %$where) == 1 && ( (keys %{$where})[0] eq '-and' )) {
+ $cond->{-and} = [];
+ my @cond = @{$where->{-and}};
+ for (my $i = 0; $i < @cond; $i++) {
+ my $entry = $cond[$i];
+ my $hash;
+ my $ref = ref $entry;
+ if ($ref eq 'HASH' or $ref eq 'ARRAY') {
+ $hash = $self->_strip_cond_qualifiers($entry);
+ }
+ elsif (! $ref) {
+ $entry =~ /([^.]+)$/;
+ $hash->{$1} = $cond[++$i];
+ }
+ else {
+ $self->throw_exception ("_strip_cond_qualifiers() is unable to handle a condition reftype $ref");
+ }
+ push @{$cond->{-and}}, $hash;
+ }
+ }
+ else {
+ foreach my $key (keys %$where) {
+ $key =~ /([^.]+)$/;
+ $cond->{$1} = $where->{$key};
+ }
+ }
+ }
+ else {
+ return undef;
+ }
+
+ return $cond;
+}
+
+sub _parse_order_by {
+ my ($self, $order_by) = @_;
+
+ return scalar $self->sql_maker->_order_by_chunks ($order_by)
+ unless wantarray;
+
+ my $sql_maker = $self->sql_maker;
+ local $sql_maker->{quote_char}; #disable quoting
+ my @chunks;
+ for my $chunk (map { ref $_ ? @$_ : $_ } ($sql_maker->_order_by_chunks ($order_by) ) ) {
+ $chunk =~ s/\s+ (?: ASC|DESC ) \s* $//ix;
+ push @chunks, $chunk;
+ }
+
+ return @chunks;
+}
+
+1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/UTF8Columns.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/UTF8Columns.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class/UTF8Columns.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -3,17 +3,6 @@
use warnings;
use base qw/DBIx::Class/;
-BEGIN {
-
- # Perl 5.8.0 doesn't have utf8::is_utf8()
- # Yes, 5.8.0 support for Unicode is suboptimal, but things like RHEL3 ship with it.
- if ($] <= 5.008000) {
- require Encode;
- } else {
- require utf8;
- }
-}
-
__PACKAGE__->mk_classdata( '_utf8_columns' );
=head1 NAME
@@ -23,7 +12,9 @@
=head1 SYNOPSIS
package Artist;
- __PACKAGE__->load_components(qw/UTF8Columns Core/);
+ use base 'DBIx::Class::Core';
+
+ __PACKAGE__->load_components(qw/UTF8Columns/);
__PACKAGE__->utf8_columns(qw/name description/);
# then belows return strings with utf8 flag
@@ -34,6 +25,15 @@
This module allows you to get columns data that have utf8 (Unicode) flag.
+=head2 Warning
+
+Note that this module overloads L<DBIx::Class::Row/store_column> in a way
+that may prevent other components overloading the same method from working
+correctly. This component must be the last one before L<DBIx::Class::Row>
+(which is provided by L<DBIx::Class::Core>). DBIx::Class will detect such
+incorrect component order and issue an appropriate warning, advising which
+components need to be loaded differently.
+
=head1 SEE ALSO
L<Template::Stash::ForceUTF8>, L<DBIx::Class::UUIDColumns>.
@@ -50,7 +50,7 @@
foreach my $col (@_) {
$self->throw_exception("column $col doesn't exist")
unless $self->has_column($col);
- }
+ }
return $self->_utf8_columns({ map { $_ => 1 } @_ });
} else {
return $self->_utf8_columns;
@@ -67,17 +67,11 @@
my ( $self, $column ) = @_;
my $value = $self->next::method($column);
- my $cols = $self->_utf8_columns;
- if ( $cols and defined $value and $cols->{$column} ) {
+ utf8::decode($value) if (
+ defined $value and $self->_is_utf8_column($column) and ! utf8::is_utf8($value)
+ );
- if ($] <= 5.008000) {
- Encode::_utf8_on($value) unless Encode::is_utf8($value);
- } else {
- utf8::decode($value) unless utf8::is_utf8($value);
- }
- }
-
- $value;
+ return $value;
}
=head2 get_columns
@@ -88,16 +82,13 @@
my $self = shift;
my %data = $self->next::method(@_);
- foreach my $col (grep { defined $data{$_} } keys %{ $self->_utf8_columns || {} }) {
-
- if ($] <= 5.008000) {
- Encode::_utf8_on($data{$col}) unless Encode::is_utf8($data{$col});
- } else {
- utf8::decode($data{$col}) unless utf8::is_utf8($data{$col});
- }
+ foreach my $col (keys %data) {
+ utf8::decode($data{$col}) if (
+ exists $data{$col} and defined $data{$col} and $self->_is_utf8_column($col) and ! utf8::is_utf8($data{$col})
+ );
}
- %data;
+ return %data;
}
=head2 store_column
@@ -107,32 +98,33 @@
sub store_column {
my ( $self, $column, $value ) = @_;
- my $cols = $self->_utf8_columns;
- if ( $cols and defined $value and $cols->{$column} ) {
+ # the dirtyness comparison must happen on the non-encoded value
+ my $copy;
- if ($] <= 5.008000) {
- Encode::_utf8_off($value) if Encode::is_utf8($value);
- } else {
- utf8::encode($value) if utf8::is_utf8($value);
- }
+ if ( defined $value and $self->_is_utf8_column($column) and utf8::is_utf8($value) ) {
+ $copy = $value;
+ utf8::encode($value);
}
$self->next::method( $column, $value );
+
+ return $copy || $value;
}
-=head1 AUTHOR
+# override this if you want to force everything to be encoded/decoded
+sub _is_utf8_column {
+ # my ($self, $col) = @_;
+ return ($_[0]->utf8_columns || {})->{$_[1]};
+}
-Daisuke Murase <typester at cpan.org>
+=head1 AUTHORS
-=head1 COPYRIGHT
+See L<DBIx::Class/CONTRIBUTORS>.
-This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
+=head1 LICENSE
-The full text of the license can be found in the
-LICENSE file included with this module.
+You may distribute this code under the same terms as Perl itself.
=cut
1;
-
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/DBIx/Class.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -4,9 +4,10 @@
use warnings;
use MRO::Compat;
+use mro 'c3';
use vars qw($VERSION);
-use base qw/Class::C3::Componentised Class::Accessor::Grouped/;
+use base qw/DBIx::Class::Componentised Class::Accessor::Grouped/;
use DBIx::Class::StartupCheck;
sub mk_classdata {
@@ -24,7 +25,7 @@
# Always remember to do all digits for the version even if they're 0
# i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports
# brain damage and presumably various other packaging systems too
-$VERSION = '0.08112';
+$VERSION = '0.08118_01';
$VERSION = eval $VERSION; # numify for warning-free dev releases
@@ -78,9 +79,8 @@
See L<DBIx::Class::ResultSource> for docs on defining result classes.
package MyDB::Schema::Result::Artist;
- use base qw/DBIx::Class/;
+ use base qw/DBIx::Class::Core/;
- __PACKAGE__->load_components(qw/Core/);
__PACKAGE__->table('artist');
__PACKAGE__->add_columns(qw/ artistid name /);
__PACKAGE__->set_primary_key('artistid');
@@ -92,9 +92,9 @@
MyDB/Schema/Result/CD.pm:
package MyDB::Schema::Result::CD;
- use base qw/DBIx::Class/;
+ use base qw/DBIx::Class::Core/;
- __PACKAGE__->load_components(qw/Core/);
+ __PACKAGE__->load_components(qw/InflateColumn::DateTime/);
__PACKAGE__->table('cd');
__PACKAGE__->add_columns(qw/ cdid artistid title year /);
__PACKAGE__->set_primary_key('cdid');
@@ -115,9 +115,9 @@
my $all_artists_rs = $schema->resultset('Artist');
# Output all artists names
- # $artist here is a DBIx::Class::Row, which has accessors
+ # $artist here is a DBIx::Class::Row, which has accessors
# for all its columns. Rows are also subclasses of your Result class.
- foreach $artist (@artists) {
+ foreach $artist (@all_artists) {
print $artist->name, "\n";
}
@@ -227,6 +227,8 @@
bluefeet: Aran Deltac <bluefeet at cpan.org>
+boghead: Bryan Beeley <cpan at beeley.org>
+
bricas: Brian Cassidy <bricas at cpan.org>
brunov: Bruno Vecchi <vecchi.b at gmail.com>
@@ -267,6 +269,8 @@
jguenther: Justin Guenther <jguenther at cpan.org>
+jhannah: Jay Hannah <jay at jays.net>
+
jnapiorkowski: John Napiorkowski <jjn1056 at yahoo.com>
jon: Jon Schutz <jjschutz at cpan.org>
@@ -295,6 +299,8 @@
Numa: Dan Sully <daniel at cpan.org>
+ovid: Curtis "Ovid" Poe <ovid at cpan.org>
+
oyse: Øystein Torget <oystein.torget at dnv.com>
paulm: Paul Makepeace
@@ -317,12 +323,14 @@
rdj: Ryan D Johnson <ryan at innerfence.com>
-ribasushi: Peter Rabbitson <rabbit+dbic at rabbit.us>
+ribasushi: Peter Rabbitson <ribasushi at cpan.org>
rjbs: Ricardo Signes <rjbs at cpan.org>
robkinyon: Rob Kinyon <rkinyon at cpan.org>
+Roman: Roman Filippov <romanf at cpan.org>
+
sc_: Just Another Perl Hacker
scotty: Scotty Allen <scotty at scottyallen.com>
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/SQL/Translator/Parser/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/SQL/Translator/Parser/DBIx/Class.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/lib/SQL/Translator/Parser/DBIx/Class.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -15,6 +15,7 @@
use Exporter;
use SQL::Translator::Utils qw(debug normalize_name);
use Carp::Clan qw/^SQL::Translator|^DBIx::Class/;
+use Scalar::Util ();
use base qw(Exporter);
@@ -30,6 +31,10 @@
# We're working with DBIx::Class Schemas, not data streams.
# -------------------------------------------------------------------
sub parse {
+ # this is a hack to prevent schema leaks due to a retarded SQLT implementation
+ # DO NOT REMOVE (until SQLT2 is out, the all of this will be rewritten anyway)
+ Scalar::Util::weaken ($_[1]);
+
my ($tr, $data) = @_;
my $args = $tr->parser_args;
my $dbicschema = $args->{'DBIx::Class::Schema'} || $args->{"DBIx::Schema"} ||$data;
@@ -65,19 +70,19 @@
}
- my(@table_monikers, @view_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);
+ $table_monikers{$moniker}++;
} elsif( $source->isa('DBIx::Class::ResultSource::View') ){
next if $source->is_virtual;
- push(@view_monikers, $moniker);
+ $view_monikers{$moniker}++;
}
}
my %tables;
- foreach my $moniker (sort @table_monikers)
+ foreach my $moniker (sort keys %table_monikers)
{
my $source = $dbicschema->source($moniker);
my $table_name = $source->name;
@@ -86,7 +91,7 @@
# support quoting properly to be signaled about this
$table_name = $$table_name if ref $table_name eq 'SCALAR';
- # Its possible to have multiple DBIC sources using the same table
+ # It's possible to have multiple DBIC sources using the same table
next if $tables{$table_name};
$tables{$table_name}{source} = $source;
@@ -112,9 +117,11 @@
my $f = $table->add_field(%colinfo)
|| $dbicschema->throw_exception ($table->error);
}
- $table->primary_key($source->primary_columns);
my @primary = $source->primary_columns;
+
+ $table->primary_key(@primary) if @primary;
+
my %unique_constraints = $source->unique_constraints;
foreach my $uniq (sort keys %unique_constraints) {
if (!$source->_compare_relationship_keys($unique_constraints{$uniq}, \@primary)) {
@@ -131,18 +138,23 @@
my %created_FK_rels;
# global add_fk_index set in parser_args
- my $add_fk_index = (exists $args->{add_fk_index} && ($args->{add_fk_index} == 0)) ? 0 : 1;
+ my $add_fk_index = (exists $args->{add_fk_index} && ! $args->{add_fk_index}) ? 0 : 1;
foreach my $rel (sort @rels)
{
+
my $rel_info = $source->relationship_info($rel);
# Ignore any rel cond that isn't a straight hash
next unless ref $rel_info->{cond} eq 'HASH';
- my $othertable = $source->related_source($rel);
- my $rel_table = $othertable->name;
+ my $relsource = $source->related_source($rel);
+ # related sources might be excluded via a {sources} filter or might be views
+ next unless exists $table_monikers{$relsource->source_name};
+
+ my $rel_table = $relsource->name;
+
# FIXME - this isn't the right way to do it, but sqlt does not
# support quoting properly to be signaled about this
$rel_table = $$rel_table if ref $rel_table eq 'SCALAR';
@@ -152,7 +164,7 @@
# Force the order of @cond to match the order of ->add_columns
my $idx;
- my %other_columns_idx = map {'foreign.'.$_ => ++$idx } $othertable->columns;
+ my %other_columns_idx = map {'foreign.'.$_ => ++$idx } $relsource->columns;
my @cond = sort { $other_columns_idx{$a} cmp $other_columns_idx{$b} } keys(%{$rel_info->{cond}});
# Get the key information, mapping off the foreign/self markers
@@ -194,47 +206,53 @@
}
}
- if($rel_table)
- {
+ if($rel_table) {
# Constraints are added only if applicable
next unless $fk_constraint;
# Make sure we dont create the same foreign key constraint twice
- my $key_test = join("\x00", @keys);
+ my $key_test = join("\x00", sort @keys);
next if $created_FK_rels{$rel_table}->{$key_test};
if (scalar(@keys)) {
-
$created_FK_rels{$rel_table}->{$key_test} = 1;
my $is_deferrable = $rel_info->{attrs}{is_deferrable};
- # do not consider deferrable constraints and self-references
- # for dependency calculations
+ # calculate dependencies: do not consider deferrable constraints and
+ # self-references for dependency calculations
if (! $is_deferrable and $rel_table ne $table_name) {
$tables{$table_name}{foreign_table_deps}{$rel_table}++;
}
$table->add_constraint(
- type => 'foreign_key',
- name => join('_', $table_name, 'fk', @keys),
- fields => \@keys,
- reference_fields => \@refkeys,
- reference_table => $rel_table,
- on_delete => uc ($cascade->{delete} || ''),
- on_update => uc ($cascade->{update} || ''),
- (defined $is_deferrable ? ( deferrable => $is_deferrable ) : ()),
+ type => 'foreign_key',
+ name => join('_', $table_name, 'fk', @keys),
+ fields => \@keys,
+ reference_fields => \@refkeys,
+ reference_table => $rel_table,
+ on_delete => uc ($cascade->{delete} || ''),
+ on_update => uc ($cascade->{update} || ''),
+ (defined $is_deferrable ? ( deferrable => $is_deferrable ) : ()),
);
# global parser_args add_fk_index param can be overridden on the rel def
my $add_fk_index_rel = (exists $rel_info->{attrs}{add_fk_index}) ? $rel_info->{attrs}{add_fk_index} : $add_fk_index;
+ # Check that we do not create an index identical to the PK index
+ # (some RDBMS croak on this, and it generally doesn't make much sense)
+ # NOTE: we do not sort the key columns because the order of
+ # columns is important for indexes and two indexes with the
+ # same cols but different order are allowed and sometimes
+ # needed
+ next if join("\x00", @keys) eq join("\x00", @primary);
+
if ($add_fk_index_rel) {
my $index = $table->add_index(
- name => join('_', $table_name, 'idx', @keys),
- fields => \@keys,
- type => 'NORMAL',
- );
+ name => join('_', $table_name, 'idx', @keys),
+ fields => \@keys,
+ type => 'NORMAL',
+ );
}
}
}
@@ -274,7 +292,7 @@
}
my %views;
- foreach my $moniker (sort @view_monikers)
+ foreach my $moniker (sort keys %view_monikers)
{
my $source = $dbicschema->source($moniker);
my $view_name = $source->name;
@@ -289,6 +307,9 @@
# Its possible to have multiple DBIC source using same table
next if $views{$view_name}++;
+ $dbicschema->throw_exception ("view $view_name is missing a view_definition")
+ unless $source->view_definition;
+
my $view = $schema->add_view (
name => $view_name,
fields => [ $source->columns ],
@@ -364,7 +385,14 @@
my $schema = MyApp::Schema->connect;
my $trans = SQL::Translator->new (
parser => 'SQL::Translator::Parser::DBIx::Class',
- parser_args => { package => $schema },
+ parser_args => {
+ package => $schema,
+ add_fk_index => 0,
+ sources => [qw/
+ Artist
+ CD
+ /],
+ },
producer => 'SQLite',
) or die SQL::Translator->error;
my $out = $trans->translate() or die $trans->error;
@@ -386,14 +414,34 @@
have SQL::Translator installed. To do this see
L<DBIx::Class::Schema/create_ddl_dir>.
+=head1 PARSER OPTIONS
+
+=head2 add_fk_index
+
+Create an index for each foreign key.
+Enabled by default, as having indexed foreign key columns is normally the
+sensible thing to do.
+
+=head2 sources
+
+=over 4
+
+=item Arguments: \@class_names
+
+=back
+
+Limit the amount of parsed sources by supplying an explicit list of source names.
+
=head1 SEE ALSO
L<SQL::Translator>, L<DBIx::Class::Schema>
=head1 AUTHORS
-Jess Robinson
+See L<DBIx::Class/CONTRIBUTORS>.
-Matt S Trout
+=head1 LICENSE
-Ash Berlin
+You may distribute this code under the same terms as Perl itself.
+
+=cut
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/maint/gen-schema.pl
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/maint/gen-schema.pl 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/maint/gen-schema.pl 2010-02-10 22:41:54 UTC (rev 8606)
@@ -8,4 +8,10 @@
use SQL::Translator;
my $schema = DBICTest::Schema->connect;
-print scalar ($schema->storage->deployment_statements($schema, 'SQLite'));
+print scalar ($schema->storage->deployment_statements(
+ $schema,
+ 'SQLite',
+ undef,
+ undef,
+ { producer_args => { no_transaction => 1 } }
+));
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/maint/svn-log.perl
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/maint/svn-log.perl 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/maint/svn-log.perl 2010-02-10 22:41:54 UTC (rev 8606)
@@ -17,8 +17,8 @@
use XML::Parser;
my %month = qw(
- Jan 01 Feb 02 Mar 03 Apr 04 May 05 Jun 06
- Jul 07 Aug 08 Sep 09 Oct 10 Nov 11 Dec 12
+ Jan 01 Feb 02 Mar 03 Apr 04 May 05 Jun 06
+ Jul 07 Aug 08 Sep 09 Oct 10 Nov 11 Dec 12
);
$Text::Wrap::huge = "wrap";
@@ -48,28 +48,28 @@
GetOptions(
"age=s" => \$days_back,
"repo=s" => \$svn_repo,
- "help" => \$send_help,
+ "help" => \$send_help,
) or exit;
# Find the trunk for the current repository if one isn't specified.
unless (defined $svn_repo) {
- $svn_repo = `svn info . | grep '^URL: '`;
- if (length $svn_repo) {
- chomp $svn_repo;
- $svn_repo =~ s{^URL\:\s+(.+?)/trunk/?.*$}{$1};
- }
- else {
- $send_help = 1;
- }
+ $svn_repo = `svn info . | grep '^URL: '`;
+ if (length $svn_repo) {
+ chomp $svn_repo;
+ $svn_repo =~ s{^URL\:\s+(.+?)/trunk/?.*$}{$1};
+ }
+ else {
+ $send_help = 1;
+ }
}
die(
- "$0 usage:\n",
- " --repo REPOSITORY\n",
- " [--age DAYS]\n",
- "\n",
- "REPOSITORY must have a trunk subdirectory and a tags directory where\n",
- "release tags are kept.\n",
+ "$0 usage:\n",
+ " --repo REPOSITORY\n",
+ " [--age DAYS]\n",
+ "\n",
+ "REPOSITORY must have a trunk subdirectory and a tags directory where\n",
+ "release tags are kept.\n",
) if $send_help;
my $earliest_date = strftime "%F", gmtime(time() - $days_back * 86400);
@@ -81,31 +81,31 @@
open(TAG, "svn -v list $svn_repo/tags|") or die $!;
while (<TAG>) {
- # The date is unused, however.
- next unless (
- my ($rev, $date, $tag) = m{
- (\d+).*?(\S\S\S\s+\d\d\s+(?:\d\d\d\d|\d\d:\d\d))\s+(v[0-9_.]+)
- }x
- );
+ # The date is unused, however.
+ next unless (
+ my ($rev, $date, $tag) = m{
+ (\d+).*?(\S\S\S\s+\d\d\s+(?:\d\d\d\d|\d\d:\d\d))\s+(v[0-9_.]+)
+ }x
+ );
- my @tag_log = gather_log("$svn_repo/tags/$tag", "--stop-on-copy");
- die "Tag $tag has changes after tagging!\n" if @tag_log > 1;
+ my @tag_log = gather_log("$svn_repo/tags/$tag", "--stop-on-copy");
+ die "Tag $tag has changes after tagging!\n" if @tag_log > 1;
- my $timestamp = $tag_log[0][LOG_DATE];
- $tag{$timestamp} = [
- $rev, # TAG_REV
- $tag, # TAG_TAG
- [ ], # TAG_LOG
- ];
+ my $timestamp = $tag_log[0][LOG_DATE];
+ $tag{$timestamp} = [
+ $rev, # TAG_REV
+ $tag, # TAG_TAG
+ [ ], # TAG_LOG
+ ];
}
close TAG;
# Fictitious "HEAD" tag for revisions that came after the last tag.
$tag{+MAX_TIMESTAMP} = [
- "HEAD", # TAG_REV
- "(untagged)", # TAG_TAG
- undef, # TAG_LOG
+ "HEAD", # TAG_REV
+ "(untagged)", # TAG_TAG
+ undef, # TAG_LOG
];
### 2. Gather the log for the trunk. Place log entries under their
@@ -114,184 +114,184 @@
my @tag_dates = sort keys %tag;
while (my $date = pop(@tag_dates)) {
- # We're done if this date's before our earliest date.
- if ($date lt $earliest_date) {
- delete $tag{$date};
- next;
- }
+ # We're done if this date's before our earliest date.
+ if ($date lt $earliest_date) {
+ delete $tag{$date};
+ next;
+ }
- my $tag = $tag{$date}[TAG_TAG];
- #warn "Gathering information for tag $tag...\n";
+ my $tag = $tag{$date}[TAG_TAG];
+ #warn "Gathering information for tag $tag...\n";
- my $this_rev = $tag{$date}[TAG_REV];
- my $prev_rev;
- if (@tag_dates) {
- $prev_rev = $tag{$tag_dates[-1]}[TAG_REV];
- }
- else {
- $prev_rev = 0;
- }
+ my $this_rev = $tag{$date}[TAG_REV];
+ my $prev_rev;
+ if (@tag_dates) {
+ $prev_rev = $tag{$tag_dates[-1]}[TAG_REV];
+ }
+ else {
+ $prev_rev = 0;
+ }
- my @log = gather_log("$svn_repo/trunk", "-r", "$this_rev:$prev_rev");
+ my @log = gather_log("$svn_repo/trunk", "-r", "$this_rev:$prev_rev");
- $tag{$date}[TAG_LOG] = \@log;
+ $tag{$date}[TAG_LOG] = \@log;
}
### 3. PROFIT! No, wait... generate the nice log file.
foreach my $timestamp (sort { $b cmp $a } keys %tag) {
- my $tag_rec = $tag{$timestamp};
+ my $tag_rec = $tag{$timestamp};
- # Skip this tag if there are no log entries.
- next unless @{$tag_rec->[TAG_LOG]};
+ # Skip this tag if there are no log entries.
+ next unless @{$tag_rec->[TAG_LOG]};
- my $tag_line = "$timestamp $tag_rec->[TAG_TAG]";
- my $tag_bar = "=" x length($tag_line);
- print $tag_bar, "\n", $tag_line, "\n", $tag_bar, "\n\n";
+ my $tag_line = "$timestamp $tag_rec->[TAG_TAG]";
+ my $tag_bar = "=" x length($tag_line);
+ print $tag_bar, "\n", $tag_line, "\n", $tag_bar, "\n\n";
- foreach my $log_rec (@{$tag_rec->[TAG_LOG]}) {
+ foreach my $log_rec (@{$tag_rec->[TAG_LOG]}) {
- my @paths = @{$log_rec->[LOG_PATHS]};
- if (@paths > 1) {
- @paths = grep {
- $_->[PATH_PATH] ne "/trunk" or $_->[PATH_ACTION] ne "M"
- } @paths;
- }
+ my @paths = @{$log_rec->[LOG_PATHS]};
+ if (@paths > 1) {
+ @paths = grep {
+ $_->[PATH_PATH] ne "/trunk" or $_->[PATH_ACTION] ne "M"
+ } @paths;
+ }
- my $time_line = wrap(
- " ", " ",
- join(
- "; ",
- "$log_rec->[LOG_DATE] (r$log_rec->[LOG_REV]) by $log_rec->[LOG_WHO]",
- map { "$_->[PATH_PATH] $_->[PATH_ACTION]" } @paths
- )
- );
+ my $time_line = wrap(
+ " ", " ",
+ join(
+ "; ",
+ "$log_rec->[LOG_DATE] (r$log_rec->[LOG_REV]) by $log_rec->[LOG_WHO]",
+ map { "$_->[PATH_PATH] $_->[PATH_ACTION]" } @paths
+ )
+ );
- if ($time_line =~ /\n/) {
- $time_line = wrap(
- " ", " ",
- "$log_rec->[LOG_DATE] (r$log_rec->[LOG_REV]) by $log_rec->[LOG_WHO]\n"
- ) .
- wrap(
- " ", " ",
- join(
- "; ",
- map { "$_->[PATH_PATH] $_->[PATH_ACTION]" } @paths
- )
- );
- }
+ if ($time_line =~ /\n/) {
+ $time_line = wrap(
+ " ", " ",
+ "$log_rec->[LOG_DATE] (r$log_rec->[LOG_REV]) by $log_rec->[LOG_WHO]\n"
+ ) .
+ wrap(
+ " ", " ",
+ join(
+ "; ",
+ map { "$_->[PATH_PATH] $_->[PATH_ACTION]" } @paths
+ )
+ );
+ }
- print $time_line, "\n\n";
+ print $time_line, "\n\n";
- # Blank lines should have the indent level of whitespace. This
- # makes it easier for other utilities to parse them.
+ # Blank lines should have the indent level of whitespace. This
+ # makes it easier for other utilities to parse them.
- my @paragraphs = split /\n\s*\n/, $log_rec->[LOG_MESSAGE];
- foreach my $paragraph (@paragraphs) {
+ my @paragraphs = split /\n\s*\n/, $log_rec->[LOG_MESSAGE];
+ foreach my $paragraph (@paragraphs) {
- # Trim off identical leading space from every line.
- my ($whitespace) = $paragraph =~ /^(\s*)/;
- if (length $whitespace) {
- $paragraph =~ s/^$whitespace//mg;
- }
+ # Trim off identical leading space from every line.
+ my ($whitespace) = $paragraph =~ /^(\s*)/;
+ if (length $whitespace) {
+ $paragraph =~ s/^$whitespace//mg;
+ }
- # Re-flow the paragraph if it isn't indented from the norm.
- # This should preserve indented quoted text, wiki-style.
- unless ($paragraph =~ /^\s/) {
- $paragraph = fill(" ", " ", $paragraph);
- }
- }
+ # Re-flow the paragraph if it isn't indented from the norm.
+ # This should preserve indented quoted text, wiki-style.
+ unless ($paragraph =~ /^\s/) {
+ $paragraph = fill(" ", " ", $paragraph);
+ }
+ }
- print join("\n \n", @paragraphs), "\n\n";
- }
+ print join("\n \n", @paragraphs), "\n\n";
+ }
}
print(
- "==============\n",
- "End of Excerpt\n",
- "==============\n",
+ "==============\n",
+ "End of Excerpt\n",
+ "==============\n",
);
### Z. Helper functions.
sub gather_log {
- my ($url, @flags) = @_;
+ my ($url, @flags) = @_;
- my (@log, @stack);
+ my (@log, @stack);
- my $parser = XML::Parser->new(
- Handlers => {
- Start => sub {
- my ($self, $tag, %att) = @_;
- push @stack, [ $tag, \%att ];
- if ($tag eq "logentry") {
- push @log, [ ];
- $log[-1][LOG_WHO] = "(nobody)";
- }
- },
- Char => sub {
- my ($self, $text) = @_;
- $stack[-1][1]{0} .= $text;
- },
- End => sub {
- my ($self, $tag) = @_;
- die "close $tag w/out open" unless @stack;
- my ($pop_tag, $att) = @{pop @stack};
+ my $parser = XML::Parser->new(
+ Handlers => {
+ Start => sub {
+ my ($self, $tag, %att) = @_;
+ push @stack, [ $tag, \%att ];
+ if ($tag eq "logentry") {
+ push @log, [ ];
+ $log[-1][LOG_WHO] = "(nobody)";
+ }
+ },
+ Char => sub {
+ my ($self, $text) = @_;
+ $stack[-1][1]{0} .= $text;
+ },
+ End => sub {
+ my ($self, $tag) = @_;
+ die "close $tag w/out open" unless @stack;
+ my ($pop_tag, $att) = @{pop @stack};
- die "$tag ne $pop_tag" if $tag ne $pop_tag;
+ die "$tag ne $pop_tag" if $tag ne $pop_tag;
- if ($tag eq "date") {
- my $timestamp = $att->{0};
- my ($date, $time) = split /[T.]/, $timestamp;
- $log[-1][LOG_DATE] = "$date $time";
- return;
- }
+ if ($tag eq "date") {
+ my $timestamp = $att->{0};
+ my ($date, $time) = split /[T.]/, $timestamp;
+ $log[-1][LOG_DATE] = "$date $time";
+ return;
+ }
- if ($tag eq "logentry") {
- $log[-1][LOG_REV] = $att->{revision};
- return;
- }
+ if ($tag eq "logentry") {
+ $log[-1][LOG_REV] = $att->{revision};
+ return;
+ }
- if ($tag eq "msg") {
- $log[-1][LOG_MESSAGE] = $att->{0};
- return;
- }
+ if ($tag eq "msg") {
+ $log[-1][LOG_MESSAGE] = $att->{0};
+ return;
+ }
- if ($tag eq "author") {
- $log[-1][LOG_WHO] = $att->{0};
- return;
- }
+ if ($tag eq "author") {
+ $log[-1][LOG_WHO] = $att->{0};
+ return;
+ }
- if ($tag eq "path") {
- my $path = $att->{0};
- $path =~ s{^/trunk/}{};
- push(
- @{$log[-1][LOG_PATHS]}, [
- $path, # PATH_PATH
- $att->{action}, # PATH_ACTION
- ]
- );
+ if ($tag eq "path") {
+ my $path = $att->{0};
+ $path =~ s{^/trunk/}{};
+ push(
+ @{$log[-1][LOG_PATHS]}, [
+ $path, # PATH_PATH
+ $att->{action}, # PATH_ACTION
+ ]
+ );
- $log[-1][LOG_PATHS][-1][PATH_CPF_PATH] = $att->{"copyfrom-path"} if (
- exists $att->{"copyfrom-path"}
- );
+ $log[-1][LOG_PATHS][-1][PATH_CPF_PATH] = $att->{"copyfrom-path"} if (
+ exists $att->{"copyfrom-path"}
+ );
- $log[-1][LOG_PATHS][-1][PATH_CPF_REV] = $att->{"copyfrom-rev"} if (
- exists $att->{"copyfrom-rev"}
- );
- return;
- }
+ $log[-1][LOG_PATHS][-1][PATH_CPF_REV] = $att->{"copyfrom-rev"} if (
+ exists $att->{"copyfrom-rev"}
+ );
+ return;
+ }
- }
- }
- );
+ }
+ }
+ );
- my $cmd = "svn -v --xml @flags log $url";
- #warn "Command: $cmd\n";
+ my $cmd = "svn -v --xml @flags log $url";
+ #warn "Command: $cmd\n";
- open(LOG, "$cmd|") or die $!;
- $parser->parse(*LOG);
- close LOG;
+ open(LOG, "$cmd|") or die $!;
+ $parser->parse(*LOG);
+ close LOG;
- return @log;
+ return @log;
}
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/06notabs.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/06notabs.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/06notabs.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,30 @@
+use warnings;
+use strict;
+
+use Test::More;
+use lib 't/lib';
+use DBICTest;
+
+my @MODULES = (
+ 'Test::NoTabs 0.9',
+);
+
+plan skip_all => 'Does not work with done_testing, temp disabled';
+
+# Don't run tests for installs
+unless ( DBICTest::AuthorCheck->is_author || $ENV{AUTOMATED_TESTING} || $ENV{RELEASE_TESTING} ) {
+ plan( skip_all => "Author tests not required for installation" );
+}
+# Load the testing modules
+foreach my $MODULE ( @MODULES ) {
+ eval "use $MODULE";
+ if ( $@ ) {
+ $ENV{RELEASE_TESTING}
+ ? die( "Failed to load required release-testing module $MODULE" )
+ : plan( skip_all => "$MODULE not available for testing" );
+ }
+}
+
+all_perl_files_ok(qw/t lib script maint/);
+
+done_testing;
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/07eol.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/07eol.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/07eol.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,33 @@
+use warnings;
+use strict;
+
+use Test::More;
+use lib 't/lib';
+use DBICTest;
+
+my @MODULES = (
+ 'Test::EOL 0.6',
+);
+
+plan skip_all => 'Does not work with done_testing, temp disabled';
+
+# Don't run tests for installs
+unless ( DBICTest::AuthorCheck->is_author || $ENV{AUTOMATED_TESTING} || $ENV{RELEASE_TESTING} ) {
+ plan( skip_all => "Author tests not required for installation" );
+}
+# Load the testing modules
+foreach my $MODULE ( @MODULES ) {
+ eval "use $MODULE";
+ if ( $@ ) {
+ $ENV{RELEASE_TESTING}
+ ? die( "Failed to load required release-testing module $MODULE" )
+ : plan( skip_all => "$MODULE not available for testing" );
+ }
+}
+
+TODO: {
+ local $TODO = 'Do not fix those yet - we have way too many branches out there, merging will be hell';
+ all_perl_files_ok({ trailing_whitespace => 1}, qw/t lib script maint/);
+}
+
+done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/100populate.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/100populate.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/100populate.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -296,4 +296,24 @@
ok ($row, "Stringification test row '$_' properly inserted");
}
+lives_ok {
+ $schema->resultset('TwoKeys')->populate([{
+ artist => 1,
+ cd => 5,
+ fourkeys_to_twokeys => [{
+ f_foo => 1,
+ f_bar => 1,
+ f_hello => 1,
+ f_goodbye => 1,
+ autopilot => 'a',
+ },{
+ f_foo => 2,
+ f_bar => 2,
+ f_hello => 2,
+ f_goodbye => 2,
+ autopilot => 'b',
+ }]
+ }])
+} 'multicol-PK has_many populate works';
+
done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/101populate_rs.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/101populate_rs.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/101populate_rs.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -15,17 +15,17 @@
use lib qw(t/lib);
use DBICTest;
-plan tests => 142;
-
## ----------------------------------------------------------------------------
## Get a Schema and some ResultSets we can play with.
## ----------------------------------------------------------------------------
-my $schema = DBICTest->init_schema();
-my $art_rs = $schema->resultset('Artist');
-my $cd_rs = $schema->resultset('CD');
+my $schema = DBICTest->init_schema();
+my $art_rs = $schema->resultset('Artist');
+my $cd_rs = $schema->resultset('CD');
+my $restricted_art_rs = $art_rs->search({rank => 42});
+
ok( $schema, 'Got a Schema object');
ok( $art_rs, 'Got Good Artist Resultset');
ok( $cd_rs, 'Got Good CD Resultset');
@@ -37,87 +37,87 @@
SCHEMA_POPULATE1: {
- ## Test to make sure that the old $schema->populate is using the new method
- ## for $resultset->populate when in void context and with sub objects.
-
- $schema->populate('Artist', [
-
- [qw/name cds/],
- ["001First Artist", [
- {title=>"001Title1", year=>2000},
- {title=>"001Title2", year=>2001},
- {title=>"001Title3", year=>2002},
- ]],
- ["002Second Artist", []],
- ["003Third Artist", [
- {title=>"003Title1", year=>2005},
- ]],
- [undef, [
- {title=>"004Title1", year=>2010}
- ]],
- ]);
-
- isa_ok $schema, 'DBIx::Class::Schema';
-
- my ($undef, $artist1, $artist2, $artist3 ) = $schema->resultset('Artist')->search({
- name=>["001First Artist","002Second Artist","003Third Artist", undef]},
- {order_by=>'name ASC'})->all;
-
- isa_ok $artist1, 'DBICTest::Artist';
- isa_ok $artist2, 'DBICTest::Artist';
- isa_ok $artist3, 'DBICTest::Artist';
- isa_ok $undef, 'DBICTest::Artist';
-
- ok $artist1->name eq '001First Artist', "Got Expected Artist Name for Artist001";
- ok $artist2->name eq '002Second Artist', "Got Expected Artist Name for Artist002";
- ok $artist3->name eq '003Third Artist', "Got Expected Artist Name for Artist003";
- ok !defined $undef->name, "Got Expected Artist Name for Artist004";
-
- ok $artist1->cds->count eq 3, "Got Right number of CDs for Artist1";
- ok $artist2->cds->count eq 0, "Got Right number of CDs for Artist2";
- ok $artist3->cds->count eq 1, "Got Right number of CDs for Artist3";
- ok $undef->cds->count eq 1, "Got Right number of CDs for Artist4";
-
- ARTIST1CDS: {
-
- my ($cd1, $cd2, $cd3) = $artist1->cds->search(undef, {order_by=>'year ASC'});
-
- isa_ok $cd1, 'DBICTest::CD';
- isa_ok $cd2, 'DBICTest::CD';
- isa_ok $cd3, 'DBICTest::CD';
-
- ok $cd1->year == 2000;
- ok $cd2->year == 2001;
- ok $cd3->year == 2002;
-
- ok $cd1->title eq '001Title1';
- ok $cd2->title eq '001Title2';
- ok $cd3->title eq '001Title3';
- }
-
- ARTIST3CDS: {
-
- my ($cd1) = $artist3->cds->search(undef, {order_by=>'year ASC'});
-
- isa_ok $cd1, 'DBICTest::CD';
+ ## Test to make sure that the old $schema->populate is using the new method
+ ## for $resultset->populate when in void context and with sub objects.
- ok $cd1->year == 2005;
- ok $cd1->title eq '003Title1';
- }
+ $schema->populate('Artist', [
- ARTIST4CDS: {
-
- my ($cd1) = $undef->cds->search(undef, {order_by=>'year ASC'});
-
- isa_ok $cd1, 'DBICTest::CD';
+ [qw/name cds/],
+ ["001First Artist", [
+ {title=>"001Title1", year=>2000},
+ {title=>"001Title2", year=>2001},
+ {title=>"001Title3", year=>2002},
+ ]],
+ ["002Second Artist", []],
+ ["003Third Artist", [
+ {title=>"003Title1", year=>2005},
+ ]],
+ [undef, [
+ {title=>"004Title1", year=>2010}
+ ]],
+ ]);
- ok $cd1->year == 2010;
- ok $cd1->title eq '004Title1';
- }
-
- ## Need to do some cleanup so that later tests don't get borked
-
- $undef->delete;
+ isa_ok $schema, 'DBIx::Class::Schema';
+
+ my ($undef, $artist1, $artist2, $artist3 ) = $schema->resultset('Artist')->search({
+ name=>["001First Artist","002Second Artist","003Third Artist", undef]},
+ {order_by=>'name ASC'})->all;
+
+ isa_ok $artist1, 'DBICTest::Artist';
+ isa_ok $artist2, 'DBICTest::Artist';
+ isa_ok $artist3, 'DBICTest::Artist';
+ isa_ok $undef, 'DBICTest::Artist';
+
+ ok $artist1->name eq '001First Artist', "Got Expected Artist Name for Artist001";
+ ok $artist2->name eq '002Second Artist', "Got Expected Artist Name for Artist002";
+ ok $artist3->name eq '003Third Artist', "Got Expected Artist Name for Artist003";
+ ok !defined $undef->name, "Got Expected Artist Name for Artist004";
+
+ ok $artist1->cds->count eq 3, "Got Right number of CDs for Artist1";
+ ok $artist2->cds->count eq 0, "Got Right number of CDs for Artist2";
+ ok $artist3->cds->count eq 1, "Got Right number of CDs for Artist3";
+ ok $undef->cds->count eq 1, "Got Right number of CDs for Artist4";
+
+ ARTIST1CDS: {
+
+ my ($cd1, $cd2, $cd3) = $artist1->cds->search(undef, {order_by=>'year ASC'});
+
+ isa_ok $cd1, 'DBICTest::CD';
+ isa_ok $cd2, 'DBICTest::CD';
+ isa_ok $cd3, 'DBICTest::CD';
+
+ ok $cd1->year == 2000;
+ ok $cd2->year == 2001;
+ ok $cd3->year == 2002;
+
+ ok $cd1->title eq '001Title1';
+ ok $cd2->title eq '001Title2';
+ ok $cd3->title eq '001Title3';
+ }
+
+ ARTIST3CDS: {
+
+ my ($cd1) = $artist3->cds->search(undef, {order_by=>'year ASC'});
+
+ isa_ok $cd1, 'DBICTest::CD';
+
+ ok $cd1->year == 2005;
+ ok $cd1->title eq '003Title1';
+ }
+
+ ARTIST4CDS: {
+
+ my ($cd1) = $undef->cds->search(undef, {order_by=>'year ASC'});
+
+ isa_ok $cd1, 'DBICTest::CD';
+
+ ok $cd1->year == 2010;
+ ok $cd1->title eq '004Title1';
+ }
+
+ ## Need to do some cleanup so that later tests don't get borked
+
+ $undef->delete;
}
@@ -127,212 +127,224 @@
ARRAY_CONTEXT: {
- ## These first set of tests are cake because array context just delegates
- ## all it's processing to $resultset->create
-
- HAS_MANY_NO_PKS: {
-
- ## This first group of tests checks to make sure we can call populate
- ## with the parent having many children and let the keys be automatic
+ ## These first set of tests are cake because array context just delegates
+ ## all it's processing to $resultset->create
- my $artists = [
- {
- name => 'Angsty-Whiny Girl',
- cds => [
- { title => 'My First CD', year => 2006 },
- { title => 'Yet More Tweeny-Pop crap', year => 2007 },
- ],
- },
- {
- name => 'Manufactured Crap',
- },
- {
- name => 'Like I Give a Damn',
- cds => [
- { title => 'My parents sold me to a record company' ,year => 2005 },
- { title => 'Why Am I So Ugly?', year => 2006 },
- { title => 'I Got Surgery and am now Popular', year => 2007 }
- ],
- },
- {
- name => 'Formerly Named',
- cds => [
- { title => 'One Hit Wonder', year => 2006 },
- ],
- },
- ];
-
- ## Get the result row objects.
-
- my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists);
-
- ## Do we have the right object?
-
- isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
- isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
- isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
- isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
-
- ## Find the expected information?
+ HAS_MANY_NO_PKS: {
- ok( $crap->name eq 'Manufactured Crap', "Got Correct name for result object");
- ok( $girl->name eq 'Angsty-Whiny Girl', "Got Correct name for result object");
- ok( $damn->name eq 'Like I Give a Damn', "Got Correct name for result object");
- ok( $formerly->name eq 'Formerly Named', "Got Correct name for result object");
-
- ## Create the expected children sub objects?
-
- ok( $crap->cds->count == 0, "got Expected Number of Cds");
- ok( $girl->cds->count == 2, "got Expected Number of Cds");
- ok( $damn->cds->count == 3, "got Expected Number of Cds");
- ok( $formerly->cds->count == 1, "got Expected Number of Cds");
+ ## This first group of tests checks to make sure we can call populate
+ ## with the parent having many children and let the keys be automatic
- ## Did the cds get expected information?
-
- my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
-
- ok( $cd1->title eq "My First CD", "Got Expected CD Title");
- ok( $cd2->title eq "Yet More Tweeny-Pop crap", "Got Expected CD Title");
- }
-
- HAS_MANY_WITH_PKS: {
-
- ## This group tests the ability to specify the PK in the parent and let
- ## DBIC transparently pass the PK down to the Child and also let's the
- ## child create any other needed PK's for itself.
-
- my $aid = $art_rs->get_column('artistid')->max || 0;
-
- my $first_aid = ++$aid;
-
- my $artists = [
- {
- artistid => $first_aid,
- name => 'PK_Angsty-Whiny Girl',
- cds => [
- { artist => $first_aid, title => 'PK_My First CD', year => 2006 },
- { artist => $first_aid, title => 'PK_Yet More Tweeny-Pop crap', year => 2007 },
- ],
- },
- {
- artistid => ++$aid,
- name => 'PK_Manufactured Crap',
- },
- {
- artistid => ++$aid,
- name => 'PK_Like I Give a Damn',
- cds => [
- { title => 'PK_My parents sold me to a record company' ,year => 2005 },
- { title => 'PK_Why Am I So Ugly?', year => 2006 },
- { title => 'PK_I Got Surgery and am now Popular', year => 2007 }
- ],
- },
- {
- artistid => ++$aid,
- name => 'PK_Formerly Named',
- cds => [
- { title => 'PK_One Hit Wonder', year => 2006 },
- ],
- },
- ];
-
- ## Get the result row objects.
-
- my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists);
-
- ## Do we have the right object?
-
- isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
- isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
- isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
- isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
-
- ## Find the expected information?
+ my $artists = [
+ {
+ name => 'Angsty-Whiny Girl',
+ cds => [
+ { title => 'My First CD', year => 2006 },
+ { title => 'Yet More Tweeny-Pop crap', year => 2007 },
+ ],
+ },
+ {
+ name => 'Manufactured Crap',
+ },
+ {
+ name => 'Like I Give a Damn',
+ cds => [
+ { title => 'My parents sold me to a record company' ,year => 2005 },
+ { title => 'Why Am I So Ugly?', year => 2006 },
+ { title => 'I Got Surgery and am now Popular', year => 2007 }
+ ],
+ },
+ {
+ name => 'Formerly Named',
+ cds => [
+ { title => 'One Hit Wonder', year => 2006 },
+ ],
+ },
+ ];
- ok( $crap->name eq 'PK_Manufactured Crap', "Got Correct name for result object");
- ok( $girl->name eq 'PK_Angsty-Whiny Girl', "Got Correct name for result object");
- ok( $girl->artistid == $first_aid, "Got Correct artist PK for result object");
- ok( $damn->name eq 'PK_Like I Give a Damn', "Got Correct name for result object");
- ok( $formerly->name eq 'PK_Formerly Named', "Got Correct name for result object");
-
- ## Create the expected children sub objects?
-
- ok( $crap->cds->count == 0, "got Expected Number of Cds");
- ok( $girl->cds->count == 2, "got Expected Number of Cds");
- ok( $damn->cds->count == 3, "got Expected Number of Cds");
- ok( $formerly->cds->count == 1, "got Expected Number of Cds");
+ ## Get the result row objects.
- ## Did the cds get expected information?
-
- my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
-
- ok( $cd1->title eq "PK_My First CD", "Got Expected CD Title");
- ok( $cd2->title eq "PK_Yet More Tweeny-Pop crap", "Got Expected CD Title");
- }
-
- BELONGS_TO_NO_PKs: {
+ my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists);
- ## Test from a belongs_to perspective, should create artist first,
- ## then CD with artistid. This test we let the system automatically
- ## create the PK's. Chances are good you'll use it this way mostly.
-
- my $cds = [
- {
- title => 'Some CD3',
- year => '1997',
- artist => { name => 'Fred BloggsC'},
- },
- {
- title => 'Some CD4',
- year => '1997',
- artist => { name => 'Fred BloggsD'},
- },
- ];
-
- my ($cdA, $cdB) = $cd_rs->populate($cds);
-
+ ## Do we have the right object?
- isa_ok($cdA, 'DBICTest::CD', 'Created CD');
- isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
- is($cdA->artist->name, 'Fred BloggsC', 'Set Artist to FredC');
+ isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
+ isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
+ isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
+ isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
-
- isa_ok($cdB, 'DBICTest::CD', 'Created CD');
- isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
- is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD');
- }
+ ## Find the expected information?
- BELONGS_TO_WITH_PKs: {
+ ok( $crap->name eq 'Manufactured Crap', "Got Correct name for result object");
+ ok( $girl->name eq 'Angsty-Whiny Girl', "Got Correct name for result object");
+ ok( $damn->name eq 'Like I Give a Damn', "Got Correct name for result object");
+ ok( $formerly->name eq 'Formerly Named', "Got Correct name for result object");
- ## Test from a belongs_to perspective, should create artist first,
- ## then CD with artistid. This time we try setting the PK's
-
- my $aid = $art_rs->get_column('artistid')->max || 0;
+ ## Create the expected children sub objects?
- my $cds = [
- {
- title => 'Some CD3',
- year => '1997',
- artist => { artistid=> ++$aid, name => 'Fred BloggsC'},
- },
- {
- title => 'Some CD4',
- year => '1997',
- artist => { artistid=> ++$aid, name => 'Fred BloggsD'},
- },
- ];
-
- my ($cdA, $cdB) = $cd_rs->populate($cds);
-
- isa_ok($cdA, 'DBICTest::CD', 'Created CD');
- isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
- is($cdA->artist->name, 'Fred BloggsC', 'Set Artist to FredC');
-
- isa_ok($cdB, 'DBICTest::CD', 'Created CD');
- isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
- is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD');
- ok($cdB->artist->artistid == $aid, "Got Expected Artist ID");
- }
+ ok( $crap->cds->count == 0, "got Expected Number of Cds");
+ ok( $girl->cds->count == 2, "got Expected Number of Cds");
+ ok( $damn->cds->count == 3, "got Expected Number of Cds");
+ ok( $formerly->cds->count == 1, "got Expected Number of Cds");
+
+ ## Did the cds get expected information?
+
+ my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year'});
+
+ ok( $cd1->title eq "My First CD", "Got Expected CD Title");
+ ok( $cd2->title eq "Yet More Tweeny-Pop crap", "Got Expected CD Title");
+ }
+
+ HAS_MANY_WITH_PKS: {
+
+ ## This group tests the ability to specify the PK in the parent and let
+ ## DBIC transparently pass the PK down to the Child and also let's the
+ ## child create any other needed PK's for itself.
+
+ my $aid = $art_rs->get_column('artistid')->max || 0;
+
+ my $first_aid = ++$aid;
+
+ my $artists = [
+ {
+ artistid => $first_aid,
+ name => 'PK_Angsty-Whiny Girl',
+ cds => [
+ { artist => $first_aid, title => 'PK_My First CD', year => 2006 },
+ { artist => $first_aid, title => 'PK_Yet More Tweeny-Pop crap', year => 2007 },
+ ],
+ },
+ {
+ artistid => ++$aid,
+ name => 'PK_Manufactured Crap',
+ },
+ {
+ artistid => ++$aid,
+ name => 'PK_Like I Give a Damn',
+ cds => [
+ { title => 'PK_My parents sold me to a record company' ,year => 2005 },
+ { title => 'PK_Why Am I So Ugly?', year => 2006 },
+ { title => 'PK_I Got Surgery and am now Popular', year => 2007 }
+ ],
+ },
+ {
+ artistid => ++$aid,
+ name => 'PK_Formerly Named',
+ cds => [
+ { title => 'PK_One Hit Wonder', year => 2006 },
+ ],
+ },
+ ];
+
+ ## Get the result row objects.
+
+ my ($girl, $crap, $damn, $formerly) = $art_rs->populate($artists);
+
+ ## Do we have the right object?
+
+ isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
+ isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
+ isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
+ isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
+
+ ## Find the expected information?
+
+ ok( $crap->name eq 'PK_Manufactured Crap', "Got Correct name for result object");
+ ok( $girl->name eq 'PK_Angsty-Whiny Girl', "Got Correct name for result object");
+ ok( $girl->artistid == $first_aid, "Got Correct artist PK for result object");
+ ok( $damn->name eq 'PK_Like I Give a Damn', "Got Correct name for result object");
+ ok( $formerly->name eq 'PK_Formerly Named', "Got Correct name for result object");
+
+ ## Create the expected children sub objects?
+
+ ok( $crap->cds->count == 0, "got Expected Number of Cds");
+ ok( $girl->cds->count == 2, "got Expected Number of Cds");
+ ok( $damn->cds->count == 3, "got Expected Number of Cds");
+ ok( $formerly->cds->count == 1, "got Expected Number of Cds");
+
+ ## Did the cds get expected information?
+
+ my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
+
+ ok( $cd1->title eq "PK_My First CD", "Got Expected CD Title");
+ ok( $cd2->title eq "PK_Yet More Tweeny-Pop crap", "Got Expected CD Title");
+ }
+
+ BELONGS_TO_NO_PKs: {
+
+ ## Test from a belongs_to perspective, should create artist first,
+ ## then CD with artistid. This test we let the system automatically
+ ## create the PK's. Chances are good you'll use it this way mostly.
+
+ my $cds = [
+ {
+ title => 'Some CD3',
+ year => '1997',
+ artist => { name => 'Fred BloggsC'},
+ },
+ {
+ title => 'Some CD4',
+ year => '1997',
+ artist => { name => 'Fred BloggsD'},
+ },
+ ];
+
+ my ($cdA, $cdB) = $cd_rs->populate($cds);
+
+
+ isa_ok($cdA, 'DBICTest::CD', 'Created CD');
+ isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
+ is($cdA->artist->name, 'Fred BloggsC', 'Set Artist to FredC');
+
+
+ isa_ok($cdB, 'DBICTest::CD', 'Created CD');
+ isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
+ is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD');
+ }
+
+ BELONGS_TO_WITH_PKs: {
+
+ ## Test from a belongs_to perspective, should create artist first,
+ ## then CD with artistid. This time we try setting the PK's
+
+ my $aid = $art_rs->get_column('artistid')->max || 0;
+
+ my $cds = [
+ {
+ title => 'Some CD3',
+ year => '1997',
+ artist => { artistid=> ++$aid, name => 'Fred BloggsC'},
+ },
+ {
+ title => 'Some CD4',
+ year => '1997',
+ artist => { artistid=> ++$aid, name => 'Fred BloggsD'},
+ },
+ ];
+
+ my ($cdA, $cdB) = $cd_rs->populate($cds);
+
+ isa_ok($cdA, 'DBICTest::CD', 'Created CD');
+ isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
+ is($cdA->artist->name, 'Fred BloggsC', 'Set Artist to FredC');
+
+ isa_ok($cdB, 'DBICTest::CD', 'Created CD');
+ isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
+ is($cdB->artist->name, 'Fred BloggsD', 'Set Artist to FredD');
+ ok($cdB->artist->artistid == $aid, "Got Expected Artist ID");
+ }
+
+ WITH_COND_FROM_RS: {
+
+ my ($more_crap) = $restricted_art_rs->populate([
+ {
+ name => 'More Manufactured Crap',
+ },
+ ]);
+
+ ## Did it use the condition in the resultset?
+ cmp_ok( $more_crap->rank, '==', 42, "Got Correct rank for result object");
+ }
}
@@ -342,265 +354,280 @@
VOID_CONTEXT: {
- ## All these tests check the ability to use populate without asking for
- ## any returned resultsets. This uses bulk_insert as much as possible
- ## in order to increase speed.
-
- HAS_MANY_WITH_PKS: {
-
- ## This first group of tests checks to make sure we can call populate
- ## with the parent having many children and the parent PK is set
+ ## All these tests check the ability to use populate without asking for
+ ## any returned resultsets. This uses bulk_insert as much as possible
+ ## in order to increase speed.
- my $aid = $art_rs->get_column('artistid')->max || 0;
-
- my $first_aid = ++$aid;
-
- my $artists = [
- {
- artistid => $first_aid,
- name => 'VOID_PK_Angsty-Whiny Girl',
- cds => [
- { artist => $first_aid, title => 'VOID_PK_My First CD', year => 2006 },
- { artist => $first_aid, title => 'VOID_PK_Yet More Tweeny-Pop crap', year => 2007 },
- ],
- },
- {
- artistid => ++$aid,
- name => 'VOID_PK_Manufactured Crap',
- },
- {
- artistid => ++$aid,
- name => 'VOID_PK_Like I Give a Damn',
- cds => [
- { title => 'VOID_PK_My parents sold me to a record company' ,year => 2005 },
- { title => 'VOID_PK_Why Am I So Ugly?', year => 2006 },
- { title => 'VOID_PK_I Got Surgery and am now Popular', year => 2007 }
- ],
- },
- {
- artistid => ++$aid,
- name => 'VOID_PK_Formerly Named',
- cds => [
- { title => 'VOID_PK_One Hit Wonder', year => 2006 },
- ],
- },
- {
- artistid => ++$aid,
- name => undef,
- cds => [
- { title => 'VOID_PK_Zundef test', year => 2006 },
- ],
- },
- ];
-
- ## Get the result row objects.
-
- $art_rs->populate($artists);
-
- my ($undef, $girl, $formerly, $damn, $crap) = $art_rs->search(
-
- {name=>[ map { $_->{name} } @$artists]},
- {order_by=>'name ASC'},
- );
-
- ## Do we have the right object?
-
- isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
- isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
- isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
- isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
- isa_ok( $undef, 'DBICTest::Artist', "Got 'Artist'");
-
- ## Find the expected information?
+ HAS_MANY_WITH_PKS: {
- ok( $crap->name eq 'VOID_PK_Manufactured Crap', "Got Correct name 'VOID_PK_Manufactured Crap' for result object");
- ok( $girl->name eq 'VOID_PK_Angsty-Whiny Girl', "Got Correct name for result object");
- ok( $damn->name eq 'VOID_PK_Like I Give a Damn', "Got Correct name for result object");
- ok( $formerly->name eq 'VOID_PK_Formerly Named', "Got Correct name for result object");
- ok( !defined $undef->name, "Got Correct name 'is undef' for result object");
-
- ## Create the expected children sub objects?
- ok( $crap->can('cds'), "Has cds relationship");
- ok( $girl->can('cds'), "Has cds relationship");
- ok( $damn->can('cds'), "Has cds relationship");
- ok( $formerly->can('cds'), "Has cds relationship");
- ok( $undef->can('cds'), "Has cds relationship");
-
- ok( $crap->cds->count == 0, "got Expected Number of Cds");
- ok( $girl->cds->count == 2, "got Expected Number of Cds");
- ok( $damn->cds->count == 3, "got Expected Number of Cds");
- ok( $formerly->cds->count == 1, "got Expected Number of Cds");
- ok( $undef->cds->count == 1, "got Expected Number of Cds");
-
- ## Did the cds get expected information?
-
- my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
-
- ok( $cd1->title eq "VOID_PK_My First CD", "Got Expected CD Title");
- ok( $cd2->title eq "VOID_PK_Yet More Tweeny-Pop crap", "Got Expected CD Title");
- }
-
-
- BELONGS_TO_WITH_PKs: {
+ ## This first group of tests checks to make sure we can call populate
+ ## with the parent having many children and the parent PK is set
- ## Test from a belongs_to perspective, should create artist first,
- ## then CD with artistid. This time we try setting the PK's
-
- my $aid = $art_rs->get_column('artistid')->max || 0;
+ my $aid = $art_rs->get_column('artistid')->max || 0;
- my $cds = [
- {
- title => 'Some CD3B',
- year => '1997',
- artist => { artistid=> ++$aid, name => 'Fred BloggsCB'},
- },
- {
- title => 'Some CD4B',
- year => '1997',
- artist => { artistid=> ++$aid, name => 'Fred BloggsDB'},
- },
- ];
-
- $cd_rs->populate($cds);
-
- my ($cdA, $cdB) = $cd_rs->search(
- {title=>[sort map {$_->{title}} @$cds]},
- {order_by=>'title ASC'},
- );
-
- isa_ok($cdA, 'DBICTest::CD', 'Created CD');
- isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
- is($cdA->artist->name, 'Fred BloggsCB', 'Set Artist to FredCB');
-
- isa_ok($cdB, 'DBICTest::CD', 'Created CD');
- isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
- is($cdB->artist->name, 'Fred BloggsDB', 'Set Artist to FredDB');
- ok($cdB->artist->artistid == $aid, "Got Expected Artist ID");
- }
+ my $first_aid = ++$aid;
- BELONGS_TO_NO_PKs: {
+ my $artists = [
+ {
+ artistid => $first_aid,
+ name => 'VOID_PK_Angsty-Whiny Girl',
+ cds => [
+ { artist => $first_aid, title => 'VOID_PK_My First CD', year => 2006 },
+ { artist => $first_aid, title => 'VOID_PK_Yet More Tweeny-Pop crap', year => 2007 },
+ ],
+ },
+ {
+ artistid => ++$aid,
+ name => 'VOID_PK_Manufactured Crap',
+ },
+ {
+ artistid => ++$aid,
+ name => 'VOID_PK_Like I Give a Damn',
+ cds => [
+ { title => 'VOID_PK_My parents sold me to a record company' ,year => 2005 },
+ { title => 'VOID_PK_Why Am I So Ugly?', year => 2006 },
+ { title => 'VOID_PK_I Got Surgery and am now Popular', year => 2007 }
+ ],
+ },
+ {
+ artistid => ++$aid,
+ name => 'VOID_PK_Formerly Named',
+ cds => [
+ { title => 'VOID_PK_One Hit Wonder', year => 2006 },
+ ],
+ },
+ {
+ artistid => ++$aid,
+ name => undef,
+ cds => [
+ { title => 'VOID_PK_Zundef test', year => 2006 },
+ ],
+ },
+ ];
- ## Test from a belongs_to perspective, should create artist first,
- ## then CD with artistid.
-
- my $cds = [
- {
- title => 'Some CD3BB',
- year => '1997',
- artist => { name => 'Fred BloggsCBB'},
- },
- {
- title => 'Some CD4BB',
- year => '1997',
- artist => { name => 'Fred BloggsDBB'},
- },
- {
- title => 'Some CD5BB',
- year => '1997',
- artist => { name => undef},
- },
- ];
-
- $cd_rs->populate($cds);
-
- my ($cdA, $cdB, $cdC) = $cd_rs->search(
- {title=>[sort map {$_->{title}} @$cds]},
- {order_by=>'title ASC'},
- );
-
- isa_ok($cdA, 'DBICTest::CD', 'Created CD');
- isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
- is($cdA->title, 'Some CD3BB', 'Found Expected title');
- is($cdA->artist->name, 'Fred BloggsCBB', 'Set Artist to FredCBB');
-
- isa_ok($cdB, 'DBICTest::CD', 'Created CD');
- isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
- is($cdB->title, 'Some CD4BB', 'Found Expected title');
- is($cdB->artist->name, 'Fred BloggsDBB', 'Set Artist to FredDBB');
-
- isa_ok($cdC, 'DBICTest::CD', 'Created CD');
- isa_ok($cdC->artist, 'DBICTest::Artist', 'Set Artist');
- is($cdC->title, 'Some CD5BB', 'Found Expected title');
- is( $cdC->artist->name, undef, 'Set Artist to something undefined');
- }
-
-
- HAS_MANY_NO_PKS: {
-
- ## This first group of tests checks to make sure we can call populate
- ## with the parent having many children and let the keys be automatic
+ ## Get the result row objects.
- my $artists = [
- {
- name => 'VOID_Angsty-Whiny Girl',
- cds => [
- { title => 'VOID_My First CD', year => 2006 },
- { title => 'VOID_Yet More Tweeny-Pop crap', year => 2007 },
- ],
- },
- {
- name => 'VOID_Manufactured Crap',
- },
- {
- name => 'VOID_Like I Give a Damn',
- cds => [
- { title => 'VOID_My parents sold me to a record company' ,year => 2005 },
- { title => 'VOID_Why Am I So Ugly?', year => 2006 },
- { title => 'VOID_I Got Surgery and am now Popular', year => 2007 }
- ],
- },
- {
- name => 'VOID_Formerly Named',
- cds => [
- { title => 'VOID_One Hit Wonder', year => 2006 },
- ],
- },
- ];
-
- ## Get the result row objects.
-
- $art_rs->populate($artists);
-
- my ($girl, $formerly, $damn, $crap) = $art_rs->search(
- {name=>[sort map {$_->{name}} @$artists]},
- {order_by=>'name ASC'},
- );
-
- ## Do we have the right object?
-
- isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
- isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
- isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
- isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
-
- ## Find the expected information?
+ $art_rs->populate($artists);
- ok( $crap->name eq 'VOID_Manufactured Crap', "Got Correct name for result object");
- ok( $girl->name eq 'VOID_Angsty-Whiny Girl', "Got Correct name for result object");
- ok( $damn->name eq 'VOID_Like I Give a Damn', "Got Correct name for result object");
- ok( $formerly->name eq 'VOID_Formerly Named', "Got Correct name for result object");
-
- ## Create the expected children sub objects?
- ok( $crap->can('cds'), "Has cds relationship");
- ok( $girl->can('cds'), "Has cds relationship");
- ok( $damn->can('cds'), "Has cds relationship");
- ok( $formerly->can('cds'), "Has cds relationship");
-
- ok( $crap->cds->count == 0, "got Expected Number of Cds");
- ok( $girl->cds->count == 2, "got Expected Number of Cds");
- ok( $damn->cds->count == 3, "got Expected Number of Cds");
- ok( $formerly->cds->count == 1, "got Expected Number of Cds");
+ my ($undef, $girl, $formerly, $damn, $crap) = $art_rs->search(
- ## Did the cds get expected information?
-
- my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
+ {name=>[ map { $_->{name} } @$artists]},
+ {order_by=>'name ASC'},
+ );
- ok($cd1, "Got a got CD");
- ok($cd2, "Got a got CD");
- ok( $cd1->title eq "VOID_My First CD", "Got Expected CD Title");
- ok( $cd2->title eq "VOID_Yet More Tweeny-Pop crap", "Got Expected CD Title");
- }
+ ## Do we have the right object?
+ isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
+ isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
+ isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
+ isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
+ isa_ok( $undef, 'DBICTest::Artist', "Got 'Artist'");
+
+ ## Find the expected information?
+
+ ok( $crap->name eq 'VOID_PK_Manufactured Crap', "Got Correct name 'VOID_PK_Manufactured Crap' for result object");
+ ok( $girl->name eq 'VOID_PK_Angsty-Whiny Girl', "Got Correct name for result object");
+ ok( $damn->name eq 'VOID_PK_Like I Give a Damn', "Got Correct name for result object");
+ ok( $formerly->name eq 'VOID_PK_Formerly Named', "Got Correct name for result object");
+ ok( !defined $undef->name, "Got Correct name 'is undef' for result object");
+
+ ## Create the expected children sub objects?
+ ok( $crap->can('cds'), "Has cds relationship");
+ ok( $girl->can('cds'), "Has cds relationship");
+ ok( $damn->can('cds'), "Has cds relationship");
+ ok( $formerly->can('cds'), "Has cds relationship");
+ ok( $undef->can('cds'), "Has cds relationship");
+
+ ok( $crap->cds->count == 0, "got Expected Number of Cds");
+ ok( $girl->cds->count == 2, "got Expected Number of Cds");
+ ok( $damn->cds->count == 3, "got Expected Number of Cds");
+ ok( $formerly->cds->count == 1, "got Expected Number of Cds");
+ ok( $undef->cds->count == 1, "got Expected Number of Cds");
+
+ ## Did the cds get expected information?
+
+ my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
+
+ ok( $cd1->title eq "VOID_PK_My First CD", "Got Expected CD Title");
+ ok( $cd2->title eq "VOID_PK_Yet More Tweeny-Pop crap", "Got Expected CD Title");
+ }
+
+
+ BELONGS_TO_WITH_PKs: {
+
+ ## Test from a belongs_to perspective, should create artist first,
+ ## then CD with artistid. This time we try setting the PK's
+
+ my $aid = $art_rs->get_column('artistid')->max || 0;
+
+ my $cds = [
+ {
+ title => 'Some CD3B',
+ year => '1997',
+ artist => { artistid=> ++$aid, name => 'Fred BloggsCB'},
+ },
+ {
+ title => 'Some CD4B',
+ year => '1997',
+ artist => { artistid=> ++$aid, name => 'Fred BloggsDB'},
+ },
+ ];
+
+ $cd_rs->populate($cds);
+
+ my ($cdA, $cdB) = $cd_rs->search(
+ {title=>[sort map {$_->{title}} @$cds]},
+ {order_by=>'title ASC'},
+ );
+
+ isa_ok($cdA, 'DBICTest::CD', 'Created CD');
+ isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
+ is($cdA->artist->name, 'Fred BloggsCB', 'Set Artist to FredCB');
+
+ isa_ok($cdB, 'DBICTest::CD', 'Created CD');
+ isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
+ is($cdB->artist->name, 'Fred BloggsDB', 'Set Artist to FredDB');
+ ok($cdB->artist->artistid == $aid, "Got Expected Artist ID");
+ }
+
+ BELONGS_TO_NO_PKs: {
+
+ ## Test from a belongs_to perspective, should create artist first,
+ ## then CD with artistid.
+
+ my $cds = [
+ {
+ title => 'Some CD3BB',
+ year => '1997',
+ artist => { name => 'Fred BloggsCBB'},
+ },
+ {
+ title => 'Some CD4BB',
+ year => '1997',
+ artist => { name => 'Fred BloggsDBB'},
+ },
+ {
+ title => 'Some CD5BB',
+ year => '1997',
+ artist => { name => undef},
+ },
+ ];
+
+ $cd_rs->populate($cds);
+
+ my ($cdA, $cdB, $cdC) = $cd_rs->search(
+ {title=>[sort map {$_->{title}} @$cds]},
+ {order_by=>'title ASC'},
+ );
+
+ isa_ok($cdA, 'DBICTest::CD', 'Created CD');
+ isa_ok($cdA->artist, 'DBICTest::Artist', 'Set Artist');
+ is($cdA->title, 'Some CD3BB', 'Found Expected title');
+ is($cdA->artist->name, 'Fred BloggsCBB', 'Set Artist to FredCBB');
+
+ isa_ok($cdB, 'DBICTest::CD', 'Created CD');
+ isa_ok($cdB->artist, 'DBICTest::Artist', 'Set Artist');
+ is($cdB->title, 'Some CD4BB', 'Found Expected title');
+ is($cdB->artist->name, 'Fred BloggsDBB', 'Set Artist to FredDBB');
+
+ isa_ok($cdC, 'DBICTest::CD', 'Created CD');
+ isa_ok($cdC->artist, 'DBICTest::Artist', 'Set Artist');
+ is($cdC->title, 'Some CD5BB', 'Found Expected title');
+ is( $cdC->artist->name, undef, 'Set Artist to something undefined');
+ }
+
+
+ HAS_MANY_NO_PKS: {
+
+ ## This first group of tests checks to make sure we can call populate
+ ## with the parent having many children and let the keys be automatic
+
+ my $artists = [
+ {
+ name => 'VOID_Angsty-Whiny Girl',
+ cds => [
+ { title => 'VOID_My First CD', year => 2006 },
+ { title => 'VOID_Yet More Tweeny-Pop crap', year => 2007 },
+ ],
+ },
+ {
+ name => 'VOID_Manufactured Crap',
+ },
+ {
+ name => 'VOID_Like I Give a Damn',
+ cds => [
+ { title => 'VOID_My parents sold me to a record company' ,year => 2005 },
+ { title => 'VOID_Why Am I So Ugly?', year => 2006 },
+ { title => 'VOID_I Got Surgery and am now Popular', year => 2007 }
+ ],
+ },
+ {
+ name => 'VOID_Formerly Named',
+ cds => [
+ { title => 'VOID_One Hit Wonder', year => 2006 },
+ ],
+ },
+ ];
+
+ ## Get the result row objects.
+
+ $art_rs->populate($artists);
+
+ my ($girl, $formerly, $damn, $crap) = $art_rs->search(
+ {name=>[sort map {$_->{name}} @$artists]},
+ {order_by=>'name ASC'},
+ );
+
+ ## Do we have the right object?
+
+ isa_ok( $crap, 'DBICTest::Artist', "Got 'Artist'");
+ isa_ok( $girl, 'DBICTest::Artist', "Got 'Artist'");
+ isa_ok( $damn, 'DBICTest::Artist', "Got 'Artist'");
+ isa_ok( $formerly, 'DBICTest::Artist', "Got 'Artist'");
+
+ ## Find the expected information?
+
+ ok( $crap->name eq 'VOID_Manufactured Crap', "Got Correct name for result object");
+ ok( $girl->name eq 'VOID_Angsty-Whiny Girl', "Got Correct name for result object");
+ ok( $damn->name eq 'VOID_Like I Give a Damn', "Got Correct name for result object");
+ ok( $formerly->name eq 'VOID_Formerly Named', "Got Correct name for result object");
+
+ ## Create the expected children sub objects?
+ ok( $crap->can('cds'), "Has cds relationship");
+ ok( $girl->can('cds'), "Has cds relationship");
+ ok( $damn->can('cds'), "Has cds relationship");
+ ok( $formerly->can('cds'), "Has cds relationship");
+
+ ok( $crap->cds->count == 0, "got Expected Number of Cds");
+ ok( $girl->cds->count == 2, "got Expected Number of Cds");
+ ok( $damn->cds->count == 3, "got Expected Number of Cds");
+ ok( $formerly->cds->count == 1, "got Expected Number of Cds");
+
+ ## Did the cds get expected information?
+
+ my ($cd1, $cd2) = $girl->cds->search({},{order_by=>'year ASC'});
+
+ ok($cd1, "Got a got CD");
+ ok($cd2, "Got a got CD");
+ ok( $cd1->title eq "VOID_My First CD", "Got Expected CD Title");
+ ok( $cd2->title eq "VOID_Yet More Tweeny-Pop crap", "Got Expected CD Title");
+ }
+
+ WITH_COND_FROM_RS: {
+
+ $restricted_art_rs->populate([
+ {
+ name => 'VOID More Manufactured Crap',
+ },
+ ]);
+
+ my $more_crap = $art_rs->search({
+ name => 'VOID More Manufactured Crap'
+ })->first;
+
+ ## Did it use the condition in the resultset?
+ cmp_ok( $more_crap->rank, '==', 42, "Got Correct rank for result object");
+ }
}
ARRAYREF_OF_ARRAYREF_STYLE: {
@@ -610,21 +637,53 @@
[1001, 'A singer that jumped the shark two albums ago'],
[1002, 'An actually cool singer.'],
]);
-
+
ok my $unknown = $art_rs->find(1000), "got Unknown";
ok my $jumped = $art_rs->find(1001), "got Jumped";
ok my $cool = $art_rs->find(1002), "got Cool";
-
+
is $unknown->name, 'A Formally Unknown Singer', 'Correct Name';
is $jumped->name, 'A singer that jumped the shark two albums ago', 'Correct Name';
is $cool->name, 'An actually cool singer.', 'Correct Name';
-
- my ($cooler, $lamer) = $art_rs->populate([
+
+ my ($cooler, $lamer) = $restricted_art_rs->populate([
[qw/artistid name/],
[1003, 'Cooler'],
- [1004, 'Lamer'],
+ [1004, 'Lamer'],
]);
-
+
is $cooler->name, 'Cooler', 'Correct Name';
is $lamer->name, 'Lamer', 'Correct Name';
-}
\ No newline at end of file
+
+ cmp_ok $cooler->rank, '==', 42, 'Correct Rank';
+
+ ARRAY_CONTEXT_WITH_COND_FROM_RS: {
+
+ my ($mega_lamer) = $restricted_art_rs->populate([
+ {
+ name => 'Mega Lamer',
+ },
+ ]);
+
+ ## Did it use the condition in the resultset?
+ cmp_ok( $mega_lamer->rank, '==', 42, "Got Correct rank for result object");
+ }
+
+ VOID_CONTEXT_WITH_COND_FROM_RS: {
+
+ $restricted_art_rs->populate([
+ {
+ name => 'VOID Mega Lamer',
+ },
+ ]);
+
+ my $mega_lamer = $art_rs->search({
+ name => 'VOID Mega Lamer'
+ })->first;
+
+ ## Did it use the condition in the resultset?
+ cmp_ok( $mega_lamer->rank, '==', 42, "Got Correct rank for result object");
+ }
+}
+
+done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/104view.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/104view.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/104view.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,5 +1,5 @@
use strict;
-use warnings;
+use warnings;
use Test::More;
use Test::Exception;
@@ -8,8 +8,6 @@
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');
@@ -24,5 +22,50 @@
is($cds_rs_1999->count, $year1999cds_rs->count, 'View Year1999CDs sees all CDs in year 1999');
+# Test if relationships work correctly
+is_deeply (
+ [
+ $schema->resultset('Year1999CDs')->search (
+ {},
+ {
+ result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+ prefetch => ['artist', { tracks => [qw/cd year1999cd year2000cd/] } ],
+ },
+ )->all
+ ],
+ [
+ $schema->resultset('CD')->search (
+ { 'me.year' => '1999'},
+ {
+ result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+ prefetch => ['artist', { tracks => [qw/cd year1999cd year2000cd/] } ],
+ columns => [qw/cdid single_track title/], # to match the columns retrieved by the virtview
+ },
+ )->all
+ ],
+ 'Prefetch over virtual view gives expected result',
+);
+is_deeply (
+ [
+ $schema->resultset('Year2000CDs')->search (
+ {},
+ {
+ result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+ prefetch => ['artist', { tracks => [qw/cd year1999cd year2000cd/] } ],
+ },
+ )->all
+ ],
+ [
+ $schema->resultset('CD')->search (
+ { 'me.year' => '2000'},
+ {
+ result_class => 'DBIx::Class::ResultClass::HashRefInflator',
+ prefetch => ['artist', { tracks => [qw/cd year1999cd year2000cd/] } ],
+ },
+ )->all
+ ],
+ 'Prefetch over regular view gives expected result',
+);
+done_testing;
Deleted: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/19quotes.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/19quotes.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/19quotes.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,75 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use IO::File;
-
-use lib qw(t/lib);
-use DBIC::SqlMakerTest;
-
-BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 7 );
-}
-
-
-use_ok('DBICTest');
-use_ok('DBIC::DebugObj');
-my $schema = DBICTest->init_schema();
-
-#diag('Testing against ' . join(' ', map { $schema->storage->dbh->get_info($_) } qw/17 18/));
-
-$schema->storage->sql_maker->quote_char('`');
-$schema->storage->sql_maker->name_sep('.');
-
-my ($sql, @bind);
-$schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind));
-$schema->storage->debug(1);
-
-my $rs;
-
-$rs = $schema->resultset('CD')->search(
- { 'me.year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
- { join => 'artist' });
-eval { $rs->count };
-is_same_sql_bind(
- $sql, \@bind,
- "SELECT COUNT( * ) FROM cd `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )", ["'Caterwauler McCrae'", "'2001'"],
- 'got correct SQL for count query with quoting'
-);
-
-my $order = 'year DESC';
-$rs = $schema->resultset('CD')->search({},
- { 'order_by' => $order });
-eval { $rs->first };
-like($sql, qr/ORDER BY `\Q${order}\E`/, 'quoted ORDER BY with DESC (should use a scalarref anyway)');
-
-$rs = $schema->resultset('CD')->search({},
- { 'order_by' => \$order });
-eval { $rs->first };
-like($sql, qr/ORDER BY \Q${order}\E/, 'did not quote ORDER BY with scalarref');
-
-$schema->storage->sql_maker->quote_char([qw/[ ]/]);
-$schema->storage->sql_maker->name_sep('.');
-
-$rs = $schema->resultset('CD')->search(
- { 'me.year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
- { join => 'artist' });
-eval { $rs->count };
-is_same_sql_bind(
- $sql, \@bind,
- "SELECT COUNT( * ) FROM cd [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )", ["'Caterwauler McCrae'", "'2001'"],
- 'got correct SQL for count query with bracket quoting'
-);
-
-my %data = (
- name => 'Bill',
- order => '12'
-);
-
-$schema->storage->sql_maker->quote_char('`');
-$schema->storage->sql_maker->name_sep('.');
-
-is($schema->storage->sql_maker->update('group', \%data), 'UPDATE `group` SET `name` = ?, `order` = ?', 'quoted table names for UPDATE');
Deleted: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/19quotes_newstyle.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/19quotes_newstyle.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/19quotes_newstyle.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,92 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use IO::File;
-
-use lib qw(t/lib);
-use DBIC::SqlMakerTest;
-
-BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 7 );
-}
-
-use_ok('DBICTest');
-use_ok('DBIC::DebugObj');
-
-my $schema = DBICTest->init_schema();
-
-#diag('Testing against ' . join(' ', map { $schema->storage->dbh->get_info($_) } qw/17 18/));
-
-my $dsn = $schema->storage->_dbi_connect_info->[0];
-$schema->connection(
- $dsn,
- undef,
- undef,
- { AutoCommit => 1 },
- { quote_char => '`', name_sep => '.' },
-);
-
-my ($sql, @bind);
-$schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind)),
-$schema->storage->debug(1);
-
-my $rs;
-
-$rs = $schema->resultset('CD')->search(
- { 'me.year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
- { join => 'artist' });
-eval { $rs->count };
-is_same_sql_bind(
- $sql, \@bind,
- "SELECT COUNT( * ) FROM cd `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )", ["'Caterwauler McCrae'", "'2001'"],
- 'got correct SQL for count query with quoting'
-);
-
-my $order = 'year DESC';
-$rs = $schema->resultset('CD')->search({},
- { 'order_by' => $order });
-eval { $rs->first };
-like($sql, qr/ORDER BY `\Q${order}\E`/, 'quoted ORDER BY with DESC (should use a scalarref anyway)');
-
-$rs = $schema->resultset('CD')->search({},
- { 'order_by' => \$order });
-eval { $rs->first };
-like($sql, qr/ORDER BY \Q${order}\E/, 'did not quote ORDER BY with scalarref');
-
-$schema->connection(
- $dsn,
- undef,
- undef,
- { AutoCommit => 1, quote_char => [qw/[ ]/], name_sep => '.' }
-);
-
-$schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind)),
-$schema->storage->debug(1);
-
-$rs = $schema->resultset('CD')->search(
- { 'me.year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
- { join => 'artist' });
-eval { $rs->count };
-is_same_sql_bind(
- $sql, \@bind,
- "SELECT COUNT( * ) FROM cd [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )", ["'Caterwauler McCrae'", "'2001'"],
- 'got correct SQL for count query with bracket quoting'
-);
-
-my %data = (
- name => 'Bill',
- order => '12'
-);
-
-$schema->connection(
- $dsn,
- undef,
- undef,
- { AutoCommit => 1, quote_char => '`', name_sep => '.' }
-);
-
-is($schema->storage->sql_maker->update('group', \%data), 'UPDATE `group` SET `name` = ?, `order` = ?', 'quoted table names for UPDATE');
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/20setuperrors.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/20setuperrors.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/20setuperrors.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,15 +1,19 @@
-#!/usr/bin/perl
+use warnings;
+use strict;
-use Test::More tests => 1;
+use Test::More;
+use Test::Exception;
-eval {
- package BuggyTable;
- use base 'DBIx::Class';
+throws_ok (
+ sub {
+ package BuggyTable;
+ use base 'DBIx::Class::Core';
- __PACKAGE__->load_components qw/Core/;
- __PACKAGE__->table('buggy_table');
- __PACKAGE__->columns qw/this doesnt work as expected/;
-};
+ __PACKAGE__->table('buggy_table');
+ __PACKAGE__->columns qw/this doesnt work as expected/;
+ },
+ qr/\bcolumns\(\) is a read-only/,
+ 'columns() error when apparently misused',
+);
-like($@,qr/\bcolumns\(\) is a read-only/,
- "columns() error when apparently misused");
+done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/26dumper.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/26dumper.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/26dumper.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,6 +1,5 @@
use strict;
use Test::More;
-use IO::File;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
Deleted: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/42toplimit.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/42toplimit.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/42toplimit.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,152 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use lib qw(t/lib);
-use DBICTest;
-use DBIC::SqlMakerTest;
-
-my $schema = DBICTest->init_schema;
-
-# Trick the sqlite DB to use Top limit emulation
-# We could test all of this via $sq->$op directly,
-# but some conditions need a $rsrc
-delete $schema->storage->_sql_maker->{_cached_syntax};
-$schema->storage->_sql_maker->limit_dialect ('Top');
-
-my $rs = $schema->resultset ('BooksInLibrary')->search ({}, { prefetch => 'owner', rows => 1, offset => 3 });
-
-sub default_test_order {
- my $order_by = shift;
- is_same_sql_bind(
- $rs->search ({}, {order_by => $order_by})->as_query,
- "(SELECT
- TOP 1 me__id, source, owner, title, price, owner__id, name FROM
- (SELECT
- TOP 4 me.id AS me__id, me.source, me.owner, me.title, me.price, owner.id AS owner__id, owner.name
- FROM books me
- JOIN owners owner ON
- owner.id = me.owner
- WHERE ( source = ? )
- ORDER BY me__id ASC
- ) me ORDER BY me__id DESC
- )",
- [ [ source => 'Library' ] ],
- );
-}
-
-sub test_order {
- my $args = shift;
-
- my $req_order = $args->{order_req}
- ? "ORDER BY $args->{order_req}"
- : ''
- ;
-
- is_same_sql_bind(
- $rs->search ({}, {order_by => $args->{order_by}})->as_query,
- "(SELECT
- me__id, source, owner, title, price, owner__id, name FROM
- (SELECT
- TOP 1 me__id, source, owner, title, price, owner__id, name FROM
- (SELECT
- TOP 4 me.id AS me__id, me.source, me.owner, me.title, me.price, owner.id AS owner__id, owner.name FROM
- books me
- JOIN owners owner ON owner.id = me.owner
- WHERE ( source = ? )
- ORDER BY $args->{order_inner}
- ) me ORDER BY $args->{order_outer}
- ) me $req_order
- )",
- [ [ source => 'Library' ] ],
- );
-}
-
-my @tests = (
- {
- order_by => \'foo DESC',
- order_req => 'foo DESC',
- order_inner => 'foo DESC',
- order_outer => 'foo ASC'
- },
- {
- order_by => { -asc => 'foo' },
- order_req => 'foo ASC',
- order_inner => 'foo ASC',
- order_outer => 'foo DESC',
- },
- {
- order_by => 'foo',
- order_req => 'foo',
- order_inner => 'foo ASC',
- order_outer => 'foo DESC',
- },
- {
- order_by => [ qw{ foo bar} ],
- order_req => 'foo, bar',
- order_inner => 'foo ASC,bar ASC',
- order_outer => 'foo DESC, bar DESC',
- },
- {
- order_by => { -desc => 'foo' },
- order_req => 'foo DESC',
- order_inner => 'foo DESC',
- order_outer => 'foo ASC',
- },
- {
- order_by => ['foo', { -desc => 'bar' } ],
- order_req => 'foo, bar DESC',
- order_inner => 'foo ASC, bar DESC',
- order_outer => 'foo DESC, bar ASC',
- },
- {
- order_by => { -asc => [qw{ foo bar }] },
- order_req => 'foo ASC, bar ASC',
- order_inner => 'foo ASC, bar ASC',
- order_outer => 'foo DESC, bar DESC',
- },
- {
- order_by => [
- { -asc => 'foo' },
- { -desc => [qw{bar}] },
- { -asc => [qw{hello sensors}]},
- ],
- order_req => 'foo ASC, bar DESC, hello ASC, sensors ASC',
- order_inner => 'foo ASC, bar DESC, hello ASC, sensors ASC',
- order_outer => 'foo DESC, bar ASC, hello DESC, sensors DESC',
- },
-);
-
-my @default_tests = ( undef, '', {}, [] );
-
-plan (tests => scalar @tests + scalar @default_tests + 1);
-
-test_order ($_) for @tests;
-default_test_order ($_) for @default_tests;
-
-
-is_same_sql_bind (
- $rs->search ({}, { group_by => 'title', order_by => 'title' })->as_query,
-'(SELECT
-me.id, me.source, me.owner, me.title, me.price, owner.id, owner.name FROM
- ( SELECT
- id, source, owner, title, price FROM
- ( SELECT
- TOP 1 id, source, owner, title, price FROM
- ( SELECT
- TOP 4 me.id, me.source, me.owner, me.title, me.price FROM
- books me JOIN
- owners owner ON owner.id = me.owner
- WHERE ( source = ? )
- GROUP BY title
- ORDER BY title ASC
- ) me
- ORDER BY title DESC
- ) me
- ORDER BY title
- ) me JOIN
- owners owner ON owner.id = me.owner WHERE
- ( source = ? )
- ORDER BY title)' ,
- [ [ source => 'Library' ], [ source => 'Library' ] ],
-);
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/51threads.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/51threads.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/51threads.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -8,7 +8,7 @@
BEGIN {
plan skip_all => 'Your perl does not support ithreads'
- if !$Config{useithreads} || $] < 5.008;
+ if !$Config{useithreads};
}
use threads;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/51threadtxn.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/51threadtxn.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/51threadtxn.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -8,7 +8,7 @@
BEGIN {
plan skip_all => 'Your perl does not support ithreads'
- if !$Config{useithreads} || $] < 5.008;
+ if !$Config{useithreads};
}
use threads;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/52cycle.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/52cycle.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/52cycle.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -8,16 +8,36 @@
eval { require Test::Memory::Cycle; require Devel::Cycle };
if ($@ or Devel::Cycle->VERSION < 1.10) {
plan skip_all => "leak test needs Test::Memory::Cycle and Devel::Cycle >= 1.10";
- } else {
- plan tests => 1;
- }
+ };
}
use DBICTest;
use DBICTest::Schema;
+use Scalar::Util ();
import Test::Memory::Cycle;
-my $s = DBICTest::Schema->clone;
+my $weak;
-memory_cycle_ok($s, 'No cycles in schema');
+{
+ my $s = $weak->{schema} = DBICTest->init_schema;
+ memory_cycle_ok($s, 'No cycles in schema');
+
+ my $rs = $weak->{resultset} = $s->resultset ('Artist');
+ memory_cycle_ok($rs, 'No cycles in resultset');
+
+ my $rsrc = $weak->{resultsource} = $rs->result_source;
+ memory_cycle_ok($rsrc, 'No cycles in resultsource');
+
+ my $row = $weak->{row} = $rs->first;
+ memory_cycle_ok($row, 'No cycles in row');
+
+ Scalar::Util::weaken ($_) for values %$weak;
+ memory_cycle_ok($weak, 'No cycles in weak object collection');
+}
+
+for (keys %$weak) {
+ ok (! $weak->{$_}, "No $_ leaks");
+}
+
+done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/60core.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/60core.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/60core.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,5 +1,5 @@
use strict;
-use warnings;
+use warnings;
use Test::More;
use Test::Exception;
@@ -65,7 +65,7 @@
is(@art, 2, 'And then there were two');
-ok(!$art->in_storage, "It knows it's dead");
+is($art->in_storage, 0, "It knows it's dead");
dies_ok ( sub { $art->delete }, "Can't delete twice");
@@ -109,10 +109,12 @@
{
ok(my $artist = $schema->resultset('Artist')->create({name => 'store_column test'}));
is($artist->name, 'X store_column test'); # used to be 'X X store...'
-
+
# call store_column even though the column doesn't seem to be dirty
- ok($artist->update({name => 'X store_column test'}));
+ $artist->name($artist->name);
is($artist->name, 'X X store_column test');
+ ok($artist->is_column_changed('name'), 'changed column marked as dirty');
+
$artist->delete;
}
@@ -144,7 +146,7 @@
});
is($new_obj->name, 'find_or_new', 'find_or_new: instantiated a new artist');
- ok(! $new_obj->in_storage, 'new artist is not in storage');
+ is($new_obj->in_storage, 0, 'new artist is not in storage');
}
my $cd = $schema->resultset("CD")->find(1);
@@ -419,9 +421,9 @@
# make sure we got rid of the compat shims
SKIP: {
- skip "Remove in 0.09", 5 if $DBIx::Class::VERSION < 0.09;
+ skip "Remove in 0.082", 3 if $DBIx::Class::VERSION < 0.082;
- for (qw/compare_relationship_keys pk_depends_on resolve_condition resolve_join resolve_prefetch/) {
+ for (qw/compare_relationship_keys pk_depends_on resolve_condition/) {
ok (! DBIx::Class::ResultSource->can ($_), "$_ no longer provided by DBIx::Class::ResultSource");
}
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/71mysql.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/71mysql.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/71mysql.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -25,7 +25,7 @@
$dbh->do("DROP TABLE IF EXISTS cd;");
-$dbh->do("CREATE TABLE cd (cdid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, artist INTEGER, title TEXT, year INTEGER, genreid INTEGER, single_track INTEGER);");
+$dbh->do("CREATE TABLE cd (cdid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, artist INTEGER, title TEXT, year DATE, genreid INTEGER, single_track INTEGER);");
$dbh->do("DROP TABLE IF EXISTS producer;");
@@ -160,8 +160,6 @@
my $type_info = $schema->storage->columns_info_for('artist');
is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
-
-
}
my $cd = $schema->resultset ('CD')->create ({});
@@ -227,4 +225,78 @@
=> 'Nothing Found!';
}
+# check for proper grouped counts
+{
+ my $ansi_schema = DBICTest::Schema->connect ($dsn, $user, $pass, { on_connect_call => 'set_strict_mode' });
+ my $rs = $ansi_schema->resultset('CD');
+
+ my $years;
+ $years->{$_->year|| scalar keys %$years}++ for $rs->all; # NULL != NULL, thus the keys eval
+
+ lives_ok ( sub {
+ is (
+ $rs->search ({}, { group_by => 'year'})->count,
+ scalar keys %$years,
+ 'grouped count correct',
+ );
+ }, 'Grouped count does not throw');
+}
+
+ZEROINSEARCH: {
+ my $cds_per_year = {
+ 2001 => 2,
+ 2002 => 1,
+ 2005 => 3,
+ };
+
+ my $rs = $schema->resultset ('CD');
+ $rs->delete;
+ for my $y (keys %$cds_per_year) {
+ for my $c (1 .. $cds_per_year->{$y} ) {
+ $rs->create ({ title => "CD $y-$c", artist => 1, year => "$y-01-01" });
+ }
+ }
+
+ is ($rs->count, 6, 'CDs created successfully');
+
+ $rs = $rs->search ({}, {
+ select => [ \ 'YEAR(year)' ], as => ['y'], distinct => 1,
+ });
+
+ is_deeply (
+ [ sort ($rs->get_column ('y')->all) ],
+ [ sort keys %$cds_per_year ],
+ 'Years group successfully',
+ );
+
+ $rs->create ({ artist => 1, year => '0-1-1', title => 'Jesus Rap' });
+
+ is_deeply (
+ [ sort $rs->get_column ('y')->all ],
+ [ 0, sort keys %$cds_per_year ],
+ 'Zero-year groups successfully',
+ );
+
+ # convoluted search taken verbatim from list
+ my $restrict_rs = $rs->search({ -and => [
+ year => { '!=', 0 },
+ year => { '!=', undef }
+ ]});
+
+ is_deeply (
+ [ $restrict_rs->get_column('y')->all ],
+ [ $rs->get_column ('y')->all ],
+ 'Zero year was correctly excluded from resultset',
+ );
+}
+
+## If find() is the first query after connect()
+## DBI::Storage::sql_maker() will be called before
+## _determine_driver() and so the ::SQLHacks class for MySQL
+## will not be used
+
+my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass);
+$schema2->resultset("Artist")->find(4);
+isa_ok($schema2->storage->sql_maker, 'DBIx::Class::SQLAHacks::MySQL');
+
done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/72pg.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/72pg.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/72pg.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -126,9 +126,8 @@
use strict;
use warnings;
- use base 'DBIx::Class';
+ use base 'DBIx::Class::Core';
- __PACKAGE__->load_components(qw/Core/);
__PACKAGE__->table('dbic_t_schema.array_test');
__PACKAGE__->add_columns(qw/id arrayfield/);
__PACKAGE__->column_info_from_storage(1);
@@ -173,9 +172,8 @@
use strict;
use warnings;
- use base 'DBIx::Class';
+ use base 'DBIx::Class::Core';
- __PACKAGE__->load_components(qw/Core/);
__PACKAGE__->table('dbic_t_schema.casecheck');
__PACKAGE__->add_columns(qw/id name NAME uc_name/);
__PACKAGE__->column_info_from_storage(1);
@@ -455,9 +453,8 @@
use strict;
use warnings;
- use base 'DBIx::Class';
+ use base 'DBIx::Class::Core';
- __PACKAGE__->load_components(qw/Core/);
__PACKAGE__->table('apk');
@eapk_id_columns = qw( id1 id2 id3 id4 );
@@ -472,6 +469,7 @@
my @eapk_schemas;
BEGIN{ @eapk_schemas = map "dbic_apk_$_", 0..5 }
+my %seqs; #< hash of schema.table.col => currval of its (DBIC) primary key sequence
sub run_extended_apk_tests {
my $schema = shift;
@@ -489,10 +487,18 @@
for @eapk_schemas;
$dbh->do("CREATE SEQUENCE $eapk_schemas[5].fooseq");
+ $dbh->do("SELECT setval('$eapk_schemas[5].fooseq',400)");
+ $seqs{"$eapk_schemas[1].apk.id2"} = 400;
+
$dbh->do("CREATE SEQUENCE $eapk_schemas[4].fooseq");
+ $dbh->do("SELECT setval('$eapk_schemas[4].fooseq',300)");
+ $seqs{"$eapk_schemas[3].apk.id2"} = 300;
+
$dbh->do("CREATE SEQUENCE $eapk_schemas[3].fooseq");
+ $dbh->do("SELECT setval('$eapk_schemas[3].fooseq',200)");
+ $seqs{"$eapk_schemas[4].apk.id2"} = 200;
- $dbh->do("SET search_path = ".join ',', @eapk_schemas );
+ $dbh->do("SET search_path = ".join ',', reverse @eapk_schemas );
});
# clear our search_path cache
@@ -519,12 +525,14 @@
qualify_table => 4,
);
+ eapk_poke( $schema );
eapk_poke( $schema, 0 );
eapk_poke( $schema, 2 );
eapk_poke( $schema, 4 );
eapk_poke( $schema, 1 );
eapk_poke( $schema, 0 );
eapk_poke( $schema, 1 );
+ eapk_poke( $schema );
eapk_poke( $schema, 4 );
eapk_poke( $schema, 3 );
eapk_poke( $schema, 1 );
@@ -538,8 +546,6 @@
# do a DBIC create on the apk table in the given schema number (which is an
# index of @eapk_schemas)
-my %seqs; #< sanity-check hash of schema.table.col => currval of its sequence
-
sub eapk_poke {
my ($s, $schema_num) = @_;
@@ -547,7 +553,7 @@
? $eapk_schemas[$schema_num]
: '';
- my $schema_name_actual = $schema_name || eapk_get_search_path($s)->[0];
+ my $schema_name_actual = $schema_name || eapk_find_visible_schema($s);
$s->source('ExtAPK')->name($schema_name ? $schema_name.'.apk' : 'apk');
#< clear sequence name cache
@@ -558,12 +564,13 @@
lives_ok {
my $new;
for my $inc (1,2,3) {
- $new = $schema->resultset('ExtAPK')->create({});
+ $new = $schema->resultset('ExtAPK')->create({ id1 => 1});
my $proper_seqval = ++$seqs{"$schema_name_actual.apk.id2"};
is( $new->id2, $proper_seqval, "$schema_name_actual.apk.id2 correct inc $inc" )
or eapk_seq_diag($s,$schema_name);
$new->discard_changes;
- for my $id (grep $_ ne 'id2', @eapk_id_columns) {
+ is( $new->id1, 1 );
+ for my $id ('id3','id4') {
my $proper_seqval = ++$seqs{"$schema_name_actual.apk.$id"};
is( $new->$id, $proper_seqval, "$schema_name_actual.apk.$id correct inc $inc" )
or eapk_seq_diag($s,$schema_name);
@@ -577,7 +584,7 @@
# class
sub eapk_seq_diag {
my $s = shift;
- my $schema = shift || eapk_get_search_path($s)->[0];
+ my $schema = shift || eapk_find_visible_schema($s);
diag "$schema.apk sequences: ",
join(', ',
@@ -633,13 +640,13 @@
local $_[1]->{Warn} = 0;
my $id_def = $a{nextval}
- ? "integer primary key not null default nextval('$a{nextval}'::regclass)"
- : 'serial primary key';
+ ? "integer not null default nextval('$a{nextval}'::regclass)"
+ : 'serial';
$dbh->do(<<EOS);
CREATE TABLE $table_name (
id1 serial
, id2 $id_def
- , id3 serial
+ , id3 serial primary key
, id4 serial
)
EOS
@@ -667,3 +674,19 @@
});
}
+
+sub eapk_find_visible_schema {
+ my ($s) = @_;
+
+ my ($schema) =
+ $s->storage->dbh_do(sub {
+ $_[1]->selectrow_array(<<EOS);
+SELECT n.nspname
+FROM pg_catalog.pg_namespace n
+JOIN pg_catalog.pg_class c ON c.relnamespace = n.oid
+WHERE c.relname = 'apk'
+ AND pg_catalog.pg_table_is_visible(c.oid)
+EOS
+ });
+ return $schema;
+}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/73oracle.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/73oracle.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/73oracle.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -26,7 +26,7 @@
}
use strict;
-use warnings;
+use warnings;
use Test::Exception;
use Test::More;
@@ -40,8 +40,6 @@
' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\''
unless ($dsn && $user && $pass);
-plan tests => 35;
-
DBICTest::Schema->load_classes('ArtistFQN');
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
@@ -49,6 +47,7 @@
eval {
$dbh->do("DROP SEQUENCE artist_seq");
+ $dbh->do("DROP SEQUENCE cd_seq");
$dbh->do("DROP SEQUENCE pkid1_seq");
$dbh->do("DROP SEQUENCE pkid2_seq");
$dbh->do("DROP SEQUENCE nonpkid_seq");
@@ -58,15 +57,17 @@
$dbh->do("DROP TABLE track");
};
$dbh->do("CREATE SEQUENCE artist_seq START WITH 1 MAXVALUE 999999 MINVALUE 0");
+$dbh->do("CREATE SEQUENCE cd_seq START WITH 1 MAXVALUE 999999 MINVALUE 0");
$dbh->do("CREATE SEQUENCE pkid1_seq START WITH 1 MAXVALUE 999999 MINVALUE 0");
$dbh->do("CREATE SEQUENCE pkid2_seq START WITH 10 MAXVALUE 999999 MINVALUE 0");
$dbh->do("CREATE SEQUENCE nonpkid_seq START WITH 20 MAXVALUE 999999 MINVALUE 0");
$dbh->do("CREATE TABLE artist (artistid NUMBER(12), name VARCHAR(255), rank NUMBER(38), charfield VARCHAR2(10))");
$dbh->do("CREATE TABLE sequence_test (pkid1 NUMBER(12), pkid2 NUMBER(12), nonpkid NUMBER(12), name VARCHAR(255))");
-$dbh->do("CREATE TABLE cd (cdid NUMBER(12), artist NUMBER(12), title VARCHAR(255), year VARCHAR(4))");
+$dbh->do("CREATE TABLE cd (cdid NUMBER(12), artist NUMBER(12), title VARCHAR(255), year VARCHAR(4), genreid NUMBER(12), single_track NUMBER(12))");
$dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12), position NUMBER(12), title VARCHAR(255), last_updated_on DATE, last_updated_at DATE, small_dt DATE)");
$dbh->do("ALTER TABLE artist ADD (CONSTRAINT artist_pk PRIMARY KEY (artistid))");
+$dbh->do("ALTER TABLE cd ADD (CONSTRAINT cd_pk PRIMARY KEY (cdid))");
$dbh->do("ALTER TABLE sequence_test ADD (CONSTRAINT sequence_test_constraint PRIMARY KEY (pkid1, pkid2))");
$dbh->do(qq{
CREATE OR REPLACE TRIGGER artist_insert_trg
@@ -80,6 +81,18 @@
END IF;
END;
});
+$dbh->do(qq{
+ CREATE OR REPLACE TRIGGER cd_insert_trg
+ BEFORE INSERT ON cd
+ FOR EACH ROW
+ BEGIN
+ IF :new.cdid IS NULL THEN
+ SELECT cd_seq.nextval
+ INTO :new.cdid
+ FROM DUAL;
+ END IF;
+ END;
+});
{
# Swiped from t/bindtype_columns.t to avoid creating my own Resultset.
@@ -88,7 +101,7 @@
eval { $dbh->do('DROP TABLE bindtype_test') };
$dbh->do(qq[
- CREATE TABLE bindtype_test
+ CREATE TABLE bindtype_test
(
id integer NOT NULL PRIMARY KEY,
bytea integer NULL,
@@ -108,13 +121,42 @@
my $new = $schema->resultset('Artist')->create({ name => 'foo' });
is($new->artistid, 1, "Oracle Auto-PK worked");
+my $cd = $schema->resultset('CD')->create({ artist => 1, title => 'EP C', year => '2003' });
+is($cd->cdid, 1, "Oracle Auto-PK worked - using scalar ref as table name");
+
# test again with fully-qualified table name
$new = $schema->resultset('ArtistFQN')->create( { name => 'bar' } );
is( $new->artistid, 2, "Oracle Auto-PK worked with fully-qualified tablename" );
+# test rel names over the 30 char limit
+my $query = $schema->resultset('Artist')->search({
+ artistid => 1
+}, {
+ prefetch => 'cds_very_very_very_long_relationship_name'
+});
+
+lives_and {
+ is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1
+} 'query with rel name over 30 chars survived and worked';
+
+# rel name over 30 char limit with user condition
+# This requires walking the SQLA data structure.
+{
+ local $TODO = 'user condition on rel longer than 30 chars';
+
+ $query = $schema->resultset('Artist')->search({
+ 'cds_very_very_very_long_relationship_name.title' => 'EP C'
+ }, {
+ prefetch => 'cds_very_very_very_long_relationship_name'
+ });
+
+ lives_and {
+ is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1
+ } 'query with rel name over 30 chars and user condition survived and worked';
+}
+
# test join with row count ambiguity
-my $cd = $schema->resultset('CD')->create({ cdid => 1, artist => 1, title => 'EP C', year => '2003' });
my $track = $schema->resultset('Track')->create({ trackid => 1, cd => 1,
position => 1, title => 'Track1' });
my $tjoin = $schema->resultset('Track')->search({ 'me.title' => 'Track1'},
@@ -149,7 +191,7 @@
$tcount = $schema->resultset('Track')->search(
{},
- {
+ {
group_by => [ qw/position title/ ]
}
);
@@ -186,32 +228,44 @@
my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 });
is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually");
-{
- my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
- $binstr{'large'} = $binstr{'small'} x 1024;
+SKIP: {
+ my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
+ $binstr{'large'} = $binstr{'small'} x 1024;
- my $maxloblen = length $binstr{'large'};
- note "Localizing LongReadLen to $maxloblen to avoid truncation of test data";
- local $dbh->{'LongReadLen'} = $maxloblen;
+ my $maxloblen = length $binstr{'large'};
+ note "Localizing LongReadLen to $maxloblen to avoid truncation of test data";
+ local $dbh->{'LongReadLen'} = $maxloblen;
- my $rs = $schema->resultset('BindType');
- my $id = 0;
+ my $rs = $schema->resultset('BindType');
+ my $id = 0;
- foreach my $type (qw( blob clob )) {
- foreach my $size (qw( small large )) {
- $id++;
+ if ($DBD::Oracle::VERSION eq '1.23') {
+ throws_ok { $rs->create({ id => 1, blob => $binstr{large} }) }
+ qr/broken/,
+ 'throws on blob insert with DBD::Oracle == 1.23';
- lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
- "inserted $size $type without dying";
- ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" );
- }
- }
+ skip 'buggy BLOB support in DBD::Oracle 1.23', 7;
+ }
+
+ foreach my $type (qw( blob clob )) {
+ foreach my $size (qw( small large )) {
+ $id++;
+
+ lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
+ "inserted $size $type without dying";
+
+ ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" );
+ }
+ }
}
+done_testing;
+
# clean up our mess
END {
if($schema && ($dbh = $schema->storage->dbh)) {
$dbh->do("DROP SEQUENCE artist_seq");
+ $dbh->do("DROP SEQUENCE cd_seq");
$dbh->do("DROP SEQUENCE pkid1_seq");
$dbh->do("DROP SEQUENCE pkid2_seq");
$dbh->do("DROP SEQUENCE nonpkid_seq");
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/745db2.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/745db2.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/745db2.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,7 +1,8 @@
use strict;
-use warnings;
+use warnings;
use Test::More;
+use Test::Exception;
use lib qw(t/lib);
use DBICTest;
@@ -12,8 +13,6 @@
plan skip_all => 'Set $ENV{DBICTEST_DB2_DSN}, _USER and _PASS to run this test'
unless ($dsn && $user);
-plan tests => 9;
-
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
my $dbh = $schema->storage->dbh;
@@ -22,40 +21,58 @@
$dbh->do("CREATE TABLE artist (artistid INTEGER GENERATED BY DEFAULT AS IDENTITY (START WITH 1, INCREMENT BY 1), name VARCHAR(255), charfield CHAR(10), rank INTEGER DEFAULT 13);");
-# This is in core, just testing that it still loads ok
-$schema->class('Artist')->load_components('PK::Auto');
-
my $ars = $schema->resultset('Artist');
+is ( $ars->count, 0, 'No rows at first' );
# test primary key handling
my $new = $ars->create({ name => 'foo' });
ok($new->artistid, "Auto-PK worked");
-my $init_count = $ars->count;
-for (1..6) {
- $ars->create({ name => 'Artist ' . $_ });
-}
-is ($ars->count, $init_count + 6, 'Simple count works');
+# test explicit key spec
+$new = $ars->create ({ name => 'bar', artistid => 66 });
+is($new->artistid, 66, 'Explicit PK worked');
+$new->discard_changes;
+is($new->artistid, 66, 'Explicit PK assigned');
+# test populate
+lives_ok (sub {
+ my @pop;
+ for (1..2) {
+ push @pop, { name => "Artist_$_" };
+ }
+ $ars->populate (\@pop);
+});
+
+# test populate with explicit key
+lives_ok (sub {
+ my @pop;
+ for (1..2) {
+ push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
+ }
+ $ars->populate (\@pop);
+});
+
+# count what we did so far
+is ($ars->count, 6, 'Simple count works');
+
# test LIMIT support
-my $it = $ars->search( {},
+my $lim = $ars->search( {},
{
rows => 3,
+ offset => 4,
order_by => 'artistid'
}
);
-is( $it->count, 3, "LIMIT count ok" );
+is( $lim->count, 2, 'ROWS+OFFSET count ok' );
+is( $lim->all, 2, 'Number of ->all objects matches count' );
-my @all = $it->all;
-is (@all, 3, 'Number of ->all objects matches count');
+# test iterator
+$lim->reset;
+is( $lim->next->artistid, 101, "iterator->next ok" );
+is( $lim->next->artistid, 102, "iterator->next ok" );
+is( $lim->next, undef, "next past end of resultset ok" );
-$it->reset;
-is( $it->next->name, "foo", "iterator->next ok" );
-is( $it->next->name, "Artist 1", "iterator->next ok" );
-is( $it->next->name, "Artist 2", "iterator->next ok" );
-is( $it->next, undef, "next past end of resultset ok" ); # this can not succeed if @all > 3
-
my $test_type_info = {
'artistid' => {
'data_type' => 'INTEGER',
@@ -70,12 +87,12 @@
'charfield' => {
'data_type' => 'CHAR',
'is_nullable' => 1,
- 'size' => 10
+ 'size' => 10
},
'rank' => {
'data_type' => 'INTEGER',
'is_nullable' => 1,
- 'size' => 10
+ 'size' => 10
},
};
@@ -83,6 +100,8 @@
my $type_info = $schema->storage->columns_info_for('artist');
is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
+done_testing;
+
# clean up our mess
END {
my $dbh = eval { $schema->storage->_dbh };
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/746mssql.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/746mssql.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/746mssql.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -28,6 +28,11 @@
isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' );
+{
+ my $schema2 = $schema->connect ($schema->storage->connect_info);
+ ok (! $schema2->storage->connected, 'a re-connected cloned schema starts unconnected');
+}
+
$schema->storage->dbh_do (sub {
my ($storage, $dbh) = @_;
eval { $dbh->do("DROP TABLE artist") };
@@ -173,10 +178,10 @@
$schema->storage->dbh_do (sub {
my ($storage, $dbh) = @_;
- eval { $dbh->do("DROP TABLE Owners") };
- eval { $dbh->do("DROP TABLE Books") };
+ eval { $dbh->do("DROP TABLE owners") };
+ eval { $dbh->do("DROP TABLE books") };
$dbh->do(<<'SQL');
-CREATE TABLE Books (
+CREATE TABLE books (
id INT IDENTITY (1, 1) NOT NULL,
source VARCHAR(100),
owner INT,
@@ -184,7 +189,7 @@
price INT NULL
)
-CREATE TABLE Owners (
+CREATE TABLE owners (
id INT IDENTITY (1, 1) NOT NULL,
name VARCHAR(100),
)
@@ -200,10 +205,10 @@
[qw/1 wiggle/],
[qw/2 woggle/],
[qw/3 boggle/],
- [qw/4 fREW/],
- [qw/5 fRIOUX/],
- [qw/6 fROOH/],
- [qw/7 fRUE/],
+ [qw/4 fRIOUX/],
+ [qw/5 fRUE/],
+ [qw/6 fREW/],
+ [qw/7 fROOH/],
[qw/8 fISMBoC/],
[qw/9 station/],
[qw/10 mirror/],
@@ -215,11 +220,12 @@
]);
}, 'populate with PKs supplied ok' );
+
lives_ok (sub {
# start a new connection, make sure rebless works
# test an insert with a supplied identity, followed by one without
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
- for (1..2) {
+ for (2, 1) {
my $id = $_ * 20 ;
$schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" });
$schema->resultset ('Owners')->create ({ name => "troglodoogle " . ($id + 1) });
@@ -249,6 +255,129 @@
]);
}, 'populate without PKs supplied ok' );
+# plain ordered subqueries throw
+throws_ok (sub {
+ $schema->resultset('Owners')->search ({}, { order_by => 'name' })->as_query
+}, qr/ordered subselect encountered/, 'Ordered Subselect detection throws ok');
+
+# make sure ordered subselects *somewhat* work
+{
+ my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 });
+
+ my $al = $owners->current_source_alias;
+ my $sealed_owners = $owners->result_source->resultset->search (
+ {},
+ {
+ alias => $al,
+ from => [{
+ -alias => $al,
+ -source_handle => $owners->result_source->handle,
+ $al => $owners->as_query,
+ }],
+ },
+ );
+
+ is_deeply (
+ [ map { $_->name } ($sealed_owners->all) ],
+ [ map { $_->name } ($owners->all) ],
+ 'Sort preserved from within a subquery',
+ );
+}
+
+TODO: {
+ local $TODO = "This porbably will never work, but it isn't critical either afaik";
+
+ my $book_owner_ids = $schema->resultset ('BooksInLibrary')
+ ->search ({}, { join => 'owner', distinct => 1, order_by => 'owner.name', unsafe_subselect_ok => 1 })
+ ->get_column ('owner');
+
+ my $book_owners = $schema->resultset ('Owners')->search ({
+ id => { -in => $book_owner_ids->as_query }
+ });
+
+ is_deeply (
+ [ map { $_->id } ($book_owners->all) ],
+ [ $book_owner_ids->all ],
+ 'Sort is preserved across IN subqueries',
+ );
+}
+
+# This is known not to work - thus the negative test
+{
+ my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 });
+ my $corelated_owners = $owners->result_source->resultset->search (
+ {
+ id => { -in => $owners->get_column('id')->as_query },
+ },
+ {
+ order_by => 'name' #reorder because of what is shown above
+ },
+ );
+
+ cmp_ok (
+ join ("\x00", map { $_->name } ($corelated_owners->all) ),
+ 'ne',
+ join ("\x00", map { $_->name } ($owners->all) ),
+ 'Sadly sort not preserved from within a corelated subquery',
+ );
+
+ cmp_ok (
+ join ("\x00", sort map { $_->name } ($corelated_owners->all) ),
+ 'ne',
+ join ("\x00", sort map { $_->name } ($owners->all) ),
+ 'Which in fact gives a completely wrong dataset',
+ );
+}
+
+
+# make sure right-join-side single-prefetch ordering limit works
+{
+ my $rs = $schema->resultset ('BooksInLibrary')->search (
+ {
+ 'owner.name' => { '!=', 'woggle' },
+ },
+ {
+ prefetch => 'owner',
+ order_by => 'owner.name',
+ }
+ );
+ # this is the order in which they should come from the above query
+ my @owner_names = qw/boggle fISMBoC fREW fRIOUX fROOH fRUE wiggle wiggle/;
+
+ is ($rs->all, 8, 'Correct amount of objects from right-sorted joined resultset');
+ is_deeply (
+ [map { $_->owner->name } ($rs->all) ],
+ \@owner_names,
+ 'Rows were properly ordered'
+ );
+
+ my $limited_rs = $rs->search ({}, {rows => 7, offset => 2, unsafe_subselect_ok => 1});
+ is ($limited_rs->count, 6, 'Correct count of limited right-sorted joined resultset');
+ is ($limited_rs->count_rs->next, 6, 'Correct count_rs of limited right-sorted joined resultset');
+
+ my $queries;
+ $schema->storage->debugcb(sub { $queries++; });
+ $schema->storage->debug(1);
+
+ is_deeply (
+ [map { $_->owner->name } ($limited_rs->all) ],
+ [@owner_names[2 .. 7]],
+ 'Limited rows were properly ordered'
+ );
+ is ($queries, 1, 'Only one query with prefetch');
+
+ $schema->storage->debugcb(undef);
+ $schema->storage->debug(0);
+
+
+ is_deeply (
+ [map { $_->name } ($limited_rs->search_related ('owner')->all) ],
+ [@owner_names[2 .. 7]],
+ 'Rows are still properly ordered after search_related'
+ );
+}
+
+
#
# try a prefetch on tables with identically named columns
#
@@ -259,84 +388,65 @@
{
# try a ->has_many direction
- my $owners = $schema->resultset ('Owners')->search ({
- 'books.id' => { '!=', undef }
- }, {
+ my $owners = $schema->resultset ('Owners')->search (
+ {
+ 'books.id' => { '!=', undef },
+ 'me.name' => { '!=', 'somebogusstring' },
+ },
+ {
prefetch => 'books',
- order_by => 'name',
+ order_by => { -asc => \['name + ?', [ test => 'xxx' ]] }, # test bindvar propagation
rows => 3, # 8 results total
- });
+ unsafe_subselect_ok => 1,
+ },
+ );
+ my ($sql, @bind) = @${$owners->page(3)->as_query};
+ is_deeply (
+ \@bind,
+ [ ([ 'me.name' => 'somebogusstring' ], [ test => 'xxx' ]) x 2 ], # double because of the prefetch subq
+ );
+
is ($owners->page(1)->all, 3, 'has_many prefetch returns correct number of rows');
is ($owners->page(1)->count, 3, 'has-many prefetch returns correct count');
- TODO: {
- local $TODO = 'limit past end of resultset problem';
- is ($owners->page(3)->all, 2, 'has_many prefetch returns correct number of rows');
- is ($owners->page(3)->count, 2, 'has-many prefetch returns correct count');
- is ($owners->page(3)->count_rs->next, 2, 'has-many prefetch returns correct count_rs');
+ is ($owners->page(3)->all, 2, 'has_many prefetch returns correct number of rows');
+ is ($owners->page(3)->count, 2, 'has-many prefetch returns correct count');
+ is ($owners->page(3)->count_rs->next, 2, 'has-many prefetch returns correct count_rs');
- # make sure count does not become overly complex
- is_same_sql_bind (
- $owners->page(3)->count_rs->as_query,
- '(
- SELECT COUNT( * )
- FROM (
- SELECT TOP 3 [me].[id]
- FROM [owners] [me]
- LEFT JOIN [books] [books] ON [books].[owner] = [me].[id]
- WHERE ( [books].[id] IS NOT NULL )
- GROUP BY [me].[id]
- ORDER BY [me].[id] DESC
- ) [count_subq]
- )',
- [],
- );
- }
# try a ->belongs_to direction (no select collapse, group_by should work)
- my $books = $schema->resultset ('BooksInLibrary')->search ({
+ my $books = $schema->resultset ('BooksInLibrary')->search (
+ {
'owner.name' => [qw/wiggle woggle/],
- }, {
+ },
+ {
distinct => 1,
+ having => \['1 = ?', [ test => 1 ] ], #test having propagation
prefetch => 'owner',
rows => 2, # 3 results total
- order_by => { -desc => 'owner' },
- # there is no sane way to order by the right side of a grouped prefetch currently :(
- #order_by => { -desc => 'owner.name' },
- });
+ order_by => { -desc => 'me.owner' },
+ unsafe_subselect_ok => 1,
+ },
+ );
+ ($sql, @bind) = @${$books->page(3)->as_query};
+ is_deeply (
+ \@bind,
+ [
+ # inner
+ [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ], [ test => '1' ],
+ # outer
+ [ 'owner.name' => 'wiggle' ], [ 'owner.name' => 'woggle' ], [ source => 'Library' ],
+ ],
+ );
is ($books->page(1)->all, 2, 'Prefetched grouped search returns correct number of rows');
is ($books->page(1)->count, 2, 'Prefetched grouped search returns correct count');
- TODO: {
- local $TODO = 'limit past end of resultset problem';
- is ($books->page(2)->all, 1, 'Prefetched grouped search returns correct number of rows');
- is ($books->page(2)->count, 1, 'Prefetched grouped search returns correct count');
- is ($books->page(2)->count_rs->next, 1, 'Prefetched grouped search returns correct count_rs');
-
- # make sure count does not become overly complex (FIXME - the distinct-induced group_by is incorrect)
- is_same_sql_bind (
- $books->page(2)->count_rs->as_query,
- '(
- SELECT COUNT( * )
- FROM (
- SELECT TOP 2 [me].[id]
- FROM [books] [me]
- JOIN [owners] [owner] ON [owner].[id] = [me].[owner]
- WHERE ( ( ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ? ) )
- GROUP BY [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
- ORDER BY [me].[id] DESC
- ) [count_subq]
- )',
- [
- [ 'owner.name' => 'wiggle' ],
- [ 'owner.name' => 'woggle' ],
- [ 'source' => 'Library' ],
- ],
- );
- }
+ is ($books->page(2)->all, 1, 'Prefetched grouped search returns correct number of rows');
+ is ($books->page(2)->count, 1, 'Prefetched grouped search returns correct count');
+ is ($books->page(2)->count_rs->next, 1, 'Prefetched grouped search returns correct count_rs');
}
done_testing;
@@ -345,7 +455,7 @@
END {
if (my $dbh = eval { $schema->storage->_dbh }) {
eval { $dbh->do("DROP TABLE $_") }
- for qw/artist money_test Books Owners/;
+ for qw/artist money_test books owners/;
}
}
# vim:sw=2 sts=2
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/746sybase.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/746sybase.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/746sybase.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -7,12 +7,9 @@
use lib qw(t/lib);
use DBICTest;
-require DBIx::Class::Storage::DBI::Sybase;
-require DBIx::Class::Storage::DBI::Sybase::NoBindVars;
-
my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/};
-my $TESTS = 63 + 2;
+my $TESTS = 66 + 2;
if (not ($dsn && $user)) {
plan skip_all =>
@@ -24,9 +21,11 @@
}
my @storage_types = (
- 'DBI::Sybase',
- 'DBI::Sybase::NoBindVars',
+ 'DBI::Sybase::ASE',
+ 'DBI::Sybase::ASE::NoBindVars',
);
+eval "require DBIx::Class::Storage::$_;" for @storage_types;
+
my $schema;
my $storage_idx = -1;
@@ -40,8 +39,8 @@
my $ping_count = 0;
{
- my $ping = DBIx::Class::Storage::DBI::Sybase->can('_ping');
- *DBIx::Class::Storage::DBI::Sybase::_ping = sub {
+ my $ping = DBIx::Class::Storage::DBI::Sybase::ASE->can('_ping');
+ *DBIx::Class::Storage::DBI::Sybase::ASE::_ping = sub {
$ping_count++;
goto $ping;
};
@@ -50,7 +49,7 @@
for my $storage_type (@storage_types) {
$storage_idx++;
- unless ($storage_type eq 'DBI::Sybase') { # autodetect
+ unless ($storage_type eq 'DBI::Sybase::ASE') { # autodetect
DBICTest::Schema->storage_type("::$storage_type");
}
@@ -59,7 +58,7 @@
$schema->storage->ensure_connected;
if ($storage_idx == 0 &&
- $schema->storage->isa('DBIx::Class::Storage::DBI::Sybase::NoBindVars')) {
+ $schema->storage->isa('DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars')) {
# no placeholders in this version of Sybase or DBD::Sybase (or using FreeTDS)
my $tb = Test::More->builder;
$tb->skip('no placeholders') for 1..$TESTS;
@@ -96,7 +95,7 @@
$seen_id{$new->artistid}++;
# check redispatch to storage-specific insert when auto-detected storage
- if ($storage_type eq 'DBI::Sybase') {
+ if ($storage_type eq 'DBI::Sybase::ASE') {
DBICTest::Schema->storage_type('::DBI');
$schema = get_schema();
}
@@ -402,7 +401,7 @@
my $new_str = $binstr{large} . 'mtfnpy';
# check redispatch to storage-specific update when auto-detected storage
- if ($storage_type eq 'DBI::Sybase') {
+ if ($storage_type eq 'DBI::Sybase::ASE') {
DBICTest::Schema->storage_type('::DBI');
$schema = get_schema();
}
@@ -576,6 +575,35 @@
'updated money value to NULL round-trip'
);
diag $@ if $@;
+
+# Test computed columns and timestamps
+ $schema->storage->dbh_do (sub {
+ my ($storage, $dbh) = @_;
+ eval { $dbh->do("DROP TABLE computed_column_test") };
+ $dbh->do(<<'SQL');
+CREATE TABLE computed_column_test (
+ id INT IDENTITY PRIMARY KEY,
+ a_computed_column AS getdate(),
+ a_timestamp timestamp,
+ charfield VARCHAR(20) DEFAULT 'foo'
+)
+SQL
+ });
+
+ require DBICTest::Schema::ComputedColumn;
+ $schema->register_class(
+ ComputedColumn => 'DBICTest::Schema::ComputedColumn'
+ );
+
+ ok (($rs = $schema->resultset('ComputedColumn')),
+ 'got rs for ComputedColumn');
+
+ lives_ok { $row = $rs->create({}) }
+ 'empty insert for a table with computed columns survived';
+
+ lives_ok {
+ $row->update({ charfield => 'bar' })
+ } 'update of a table with computed columns survived';
}
is $ping_count, 0, 'no pings';
@@ -584,6 +612,6 @@
END {
if (my $dbh = eval { $schema->storage->_dbh }) {
eval { $dbh->do("DROP TABLE $_") }
- for qw/artist bindtype_test money_test/;
+ for qw/artist bindtype_test money_test computed_column_test/;
}
}
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/747mssql_ado.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/747mssql_ado.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/747mssql_ado.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,79 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ADO_${_}" } qw/DSN USER PASS/};
+
+plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ADO_DSN}, _USER and _PASS to run this test'
+ unless ($dsn && $user);
+
+my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+$schema->storage->ensure_connected;
+
+isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server' );
+
+$schema->storage->dbh_do (sub {
+ my ($storage, $dbh) = @_;
+ eval { $dbh->do("DROP TABLE artist") };
+ $dbh->do(<<'SQL');
+CREATE TABLE artist (
+ artistid INT IDENTITY NOT NULL,
+ name VARCHAR(100),
+ rank INT NOT NULL DEFAULT '13',
+ charfield CHAR(10) NULL,
+ primary key(artistid)
+)
+SQL
+});
+
+my $new = $schema->resultset('Artist')->create({ name => 'foo' });
+ok($new->artistid > 0, 'Auto-PK worked');
+
+# make sure select works
+my $found = $schema->resultset('Artist')->search({ name => 'foo' })->first;
+is $found->artistid, $new->artistid, 'search works';
+
+# test large column list in select
+$found = $schema->resultset('Artist')->search({ name => 'foo' }, {
+ select => ['artistid', 'name', map "'foo' foo_$_", 0..50],
+ as => ['artistid', 'name', map "foo_$_", 0..50],
+})->first;
+is $found->artistid, $new->artistid, 'select with big column list';
+is $found->get_column('foo_50'), 'foo', 'last item in big column list';
+
+# create a few more rows
+for (1..12) {
+ $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
+}
+
+# test multiple active cursors
+my $rs1 = $schema->resultset('Artist')->search({}, { order_by => 'artistid' });
+my $rs2 = $schema->resultset('Artist')->search({}, { order_by => 'name' });
+
+while ($rs1->next) {
+ ok eval { $rs2->next }, 'multiple active cursors';
+}
+
+# test bug where ADO blows up if the first bindparam is shorter than the second
+is $schema->resultset('Artist')->search({ artistid => 2 })->first->name,
+ 'Artist 1',
+ 'short bindparam';
+
+is $schema->resultset('Artist')->search({ artistid => 13 })->first->name,
+ 'Artist 12',
+ 'longer bindparam';
+
+done_testing;
+
+# clean up our mess
+END {
+ if (my $dbh = eval { $schema->storage->_dbh }) {
+ eval { $dbh->do("DROP TABLE $_") }
+ for qw/artist/;
+ }
+}
+# vim:sw=2 sts=2
Copied: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/748informix.t (from rev 7836, DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/745db2.t)
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/748informix.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/748informix.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,82 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_INFORMIX_${_}" } qw/DSN USER PASS/};
+
+#warn "$dsn $user $pass";
+
+plan skip_all => 'Set $ENV{DBICTEST_INFORMIX_DSN}, _USER and _PASS to run this test'
+ unless ($dsn && $user);
+
+my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+
+my $dbh = $schema->storage->dbh;
+
+eval { $dbh->do("DROP TABLE artist") };
+
+$dbh->do("CREATE TABLE artist (artistid SERIAL, name VARCHAR(255), charfield CHAR(10), rank INTEGER DEFAULT 13);");
+
+my $ars = $schema->resultset('Artist');
+is ( $ars->count, 0, 'No rows at first' );
+
+# test primary key handling
+my $new = $ars->create({ name => 'foo' });
+ok($new->artistid, "Auto-PK worked");
+
+# test explicit key spec
+$new = $ars->create ({ name => 'bar', artistid => 66 });
+is($new->artistid, 66, 'Explicit PK worked');
+$new->discard_changes;
+is($new->artistid, 66, 'Explicit PK assigned');
+
+# test populate
+lives_ok (sub {
+ my @pop;
+ for (1..2) {
+ push @pop, { name => "Artist_$_" };
+ }
+ $ars->populate (\@pop);
+});
+
+# test populate with explicit key
+lives_ok (sub {
+ my @pop;
+ for (1..2) {
+ push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
+ }
+ $ars->populate (\@pop);
+});
+
+# count what we did so far
+is ($ars->count, 6, 'Simple count works');
+
+# test LIMIT support
+my $lim = $ars->search( {},
+ {
+ rows => 3,
+ offset => 4,
+ order_by => 'artistid'
+ }
+);
+is( $lim->count, 2, 'ROWS+OFFSET count ok' );
+is( $lim->all, 2, 'Number of ->all objects matches count' );
+
+# test iterator
+$lim->reset;
+is( $lim->next->artistid, 101, "iterator->next ok" );
+is( $lim->next->artistid, 102, "iterator->next ok" );
+is( $lim->next, undef, "next past end of resultset ok" );
+
+
+done_testing;
+
+# clean up our mess
+END {
+ my $dbh = eval { $schema->storage->_dbh };
+ $dbh->do("DROP TABLE artist") if $dbh;
+}
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/749sybase_asa.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/749sybase_asa.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/749sybase_asa.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,150 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+# tests stolen from 748informix.t
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_ASA_${_}" } qw/DSN USER PASS/};
+my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_SYBASE_ASA_ODBC_${_}" } qw/DSN USER PASS/};
+
+plan skip_all => <<'EOF' unless $dsn || $dsn2;
+Set $ENV{DBICTEST_SYBASE_ASA_DSN} and/or $ENV{DBICTEST_SYBASE_ASA_ODBC_DSN},
+_USER and _PASS to run these tests
+EOF
+
+my @info = (
+ [ $dsn, $user, $pass ],
+ [ $dsn2, $user2, $pass2 ],
+);
+
+my @handles_to_clean;
+
+foreach my $info (@info) {
+ my ($dsn, $user, $pass) = @$info;
+
+ next unless $dsn;
+
+ my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
+
+ my $dbh = $schema->storage->dbh;
+
+ push @handles_to_clean, $dbh;
+
+ eval { $dbh->do("DROP TABLE artist") };
+
+ $dbh->do(<<EOF);
+ CREATE TABLE artist (
+ artistid INT IDENTITY PRIMARY KEY,
+ name VARCHAR(255) NULL,
+ charfield CHAR(10) NULL,
+ rank INT DEFAULT 13
+ )
+EOF
+
+ my $ars = $schema->resultset('Artist');
+ is ( $ars->count, 0, 'No rows at first' );
+
+# test primary key handling
+ my $new = $ars->create({ name => 'foo' });
+ ok($new->artistid, "Auto-PK worked");
+
+# test explicit key spec
+ $new = $ars->create ({ name => 'bar', artistid => 66 });
+ is($new->artistid, 66, 'Explicit PK worked');
+ $new->discard_changes;
+ is($new->artistid, 66, 'Explicit PK assigned');
+
+# test populate
+ lives_ok (sub {
+ my @pop;
+ for (1..2) {
+ push @pop, { name => "Artist_$_" };
+ }
+ $ars->populate (\@pop);
+ });
+
+# test populate with explicit key
+ lives_ok (sub {
+ my @pop;
+ for (1..2) {
+ push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
+ }
+ $ars->populate (\@pop);
+ });
+
+# count what we did so far
+ is ($ars->count, 6, 'Simple count works');
+
+# test LIMIT support
+ my $lim = $ars->search( {},
+ {
+ rows => 3,
+ offset => 4,
+ order_by => 'artistid'
+ }
+ );
+ is( $lim->count, 2, 'ROWS+OFFSET count ok' );
+ is( $lim->all, 2, 'Number of ->all objects matches count' );
+
+# test iterator
+ $lim->reset;
+ is( $lim->next->artistid, 101, "iterator->next ok" );
+ is( $lim->next->artistid, 102, "iterator->next ok" );
+ is( $lim->next, undef, "next past end of resultset ok" );
+
+# test empty insert
+ {
+ local $ars->result_source->column_info('artistid')->{is_auto_increment} = 0;
+
+ lives_ok { $ars->create({}) }
+ 'empty insert works';
+ }
+
+# test blobs (stolen from 73oracle.t)
+ eval { $dbh->do('DROP TABLE bindtype_test') };
+ $dbh->do(qq[
+ CREATE TABLE bindtype_test
+ (
+ id INT NOT NULL PRIMARY KEY,
+ bytea INT NULL,
+ blob LONG BINARY NULL,
+ clob LONG VARCHAR NULL
+ )
+ ],{ RaiseError => 1, PrintError => 1 });
+
+ my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
+ $binstr{'large'} = $binstr{'small'} x 1024;
+
+ my $maxloblen = length $binstr{'large'};
+ local $dbh->{'LongReadLen'} = $maxloblen;
+
+ my $rs = $schema->resultset('BindType');
+ my $id = 0;
+
+ foreach my $type (qw( blob clob )) {
+ foreach my $size (qw( small large )) {
+ $id++;
+
+# turn off horrendous binary DBIC_TRACE output
+ local $schema->storage->{debug} = 0;
+
+ lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
+ "inserted $size $type without dying";
+
+ ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" );
+ }
+ }
+}
+
+done_testing;
+
+# clean up our mess
+END {
+ foreach my $dbh (@handles_to_clean) {
+ eval { $dbh->do("DROP TABLE $_") } for qw/artist bindtype_test/;
+ }
+}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/74mssql.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/74mssql.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/74mssql.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -18,10 +18,6 @@
plan skip_all => 'Set $ENV{DBICTEST_MSSQL_DSN}, _USER and _PASS to run this test'
unless ($dsn);
-my $TESTS = 15;
-
-plan tests => $TESTS * 2;
-
my @storage_types = (
'DBI::Sybase::Microsoft_SQL_Server',
'DBI::Sybase::Microsoft_SQL_Server::NoBindVars',
@@ -29,22 +25,28 @@
my $storage_idx = -1;
my $schema;
+my $NUMBER_OF_TESTS_IN_BLOCK = 18;
for my $storage_type (@storage_types) {
$storage_idx++;
$schema = DBICTest::Schema->clone;
+ $schema->connection($dsn, $user, $pass);
+
if ($storage_idx != 0) { # autodetect
- $schema->storage_type("::$storage_type");
+ no warnings 'redefine';
+ local *DBIx::Class::Storage::DBI::_typeless_placeholders_supported =
+ sub { 0 };
+# $schema->storage_type("::$storage_type");
+ $schema->storage->ensure_connected;
}
+ else {
+ $schema->storage->ensure_connected;
+ }
- $schema->connection($dsn, $user, $pass);
-
- $schema->storage->ensure_connected;
-
if ($storage_idx == 0 && ref($schema->storage) =~ /NoBindVars\z/) {
my $tb = Test::More->builder;
- $tb->skip('no placeholders') for 1..$TESTS;
+ $tb->skip('no placeholders') for 1..$NUMBER_OF_TESTS_IN_BLOCK;
next;
}
@@ -145,17 +147,44 @@
$rs->reset;
} 'multiple active statements';
- # test multiple active statements in a transaction
- TODO: {
- local $TODO = 'needs similar FreeTDS fixes to the ones in Sybase.pm';
- lives_ok {
- $schema->txn_do(sub {
- $rs->create({ amount => 400 });
- });
- } 'simple transaction';
- }
+ $rs->delete;
+
+ # test simple transaction with commit
+ lives_ok {
+ $schema->txn_do(sub {
+ $rs->create({ amount => 400 });
+ });
+ } 'simple transaction';
+
+ cmp_ok $rs->first->amount, '==', 400, 'committed';
+ $rs->reset;
+
+ $rs->delete;
+
+ # test rollback
+ throws_ok {
+ $schema->txn_do(sub {
+ $rs->create({ amount => 400 });
+ die 'mtfnpy';
+ });
+ } qr/mtfnpy/, 'simple failed txn';
+
+ is $rs->first, undef, 'rolled back';
+ $rs->reset;
}
+# test op-induced autoconnect
+lives_ok (sub {
+
+ my $schema = DBICTest::Schema->clone;
+ $schema->connection($dsn, $user, $pass);
+
+ my $artist = $schema->resultset ('Artist')->search ({}, { order_by => 'artistid' })->next;
+ is ($artist->id, 1, 'Artist retrieved successfully');
+}, 'Query-induced autoconnect works');
+
+done_testing;
+
# clean up our mess
END {
if (my $dbh = eval { $schema->storage->dbh }) {
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/76joins.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/76joins.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/76joins.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -10,8 +10,6 @@
my $orig_debug = $schema->storage->debug;
-use IO::File;
-
BEGIN {
eval "use DBD::SQLite";
plan $@
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/76select.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/76select.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/76select.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,5 +1,5 @@
use strict;
-use warnings;
+use warnings;
use Test::More;
use Test::Exception;
@@ -9,8 +9,6 @@
my $schema = DBICTest->init_schema();
-plan tests => 24;
-
my $rs = $schema->resultset('CD')->search({},
{
'+select' => \ 'COUNT(*)',
@@ -29,16 +27,6 @@
lives_ok(sub { $rs->first->get_column('count') }, 'multiple +select/+as columns, 1st rscolumn present');
lives_ok(sub { $rs->first->get_column('addedtitle') }, 'multiple +select/+as columns, 2nd rscolumn present');
-# Tests a regression in ResultSetColumn wrt +select
-$rs = $schema->resultset('CD')->search(undef,
- {
- '+select' => [ \'COUNT(*) AS year_count' ],
- order_by => 'year_count'
- }
-);
-my @counts = $rs->get_column('cdid')->all;
-ok(scalar(@counts), 'got rows from ->all using +select');
-
$rs = $schema->resultset('CD')->search({},
{
'+select' => [ \ 'COUNT(*)', 'title' ],
@@ -101,13 +89,13 @@
}, 'columns 2nd rscolumn present');
lives_ok(sub {
- $rs->first->artist->get_column('name')
-}, 'columns 3rd rscolumn present');
+ $rs->first->artist->get_column('name')
+}, 'columns 3rd rscolumn present');
$rs = $schema->resultset('CD')->search({},
- {
+ {
'join' => 'artist',
'+columns' => ['cdid', 'title', 'artist.name'],
}
@@ -121,7 +109,7 @@
);
lives_ok(sub {
- $rs->first->get_column('cdid')
+ $rs->first->get_column('cdid')
}, 'columns 1st rscolumn present');
lives_ok(sub {
@@ -165,34 +153,17 @@
}
);
-is_deeply (
+is_deeply(
$sub_rs->single,
{
- artist => 1,
+ artist => 1,
track_position => 2,
- tracks =>
- {
- trackid => 17,
- title => 'Apiary',
- },
+ tracks => {
+ trackid => 17,
+ title => 'Apiary',
+ },
},
'columns/select/as fold properly on sub-searches',
);
-TODO: {
- local $TODO = "Multi-collapsing still doesn't work right - HRI should be getting an arrayref, not an individual hash";
- is_deeply (
- $sub_rs->single,
- {
- artist => 1,
- track_position => 2,
- tracks => [
- {
- trackid => 17,
- title => 'Apiary',
- },
- ],
- },
- 'columns/select/as fold properly on sub-searches',
- );
-}
+done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/79aliasing.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/79aliasing.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/79aliasing.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -52,7 +52,7 @@
my $cd_rs = $schema->resultset('CD')->search({ 'artist.name' => 'Caterwauler McCrae' }, { join => 'artist' });
my $cd = $cd_rs->find_or_new({ title => 'Huh?', year => 2006 });
- ok(! $cd->in_storage, 'new CD not in storage yet');
+ is($cd->in_storage, 0, 'new CD not in storage yet');
is($cd->title, 'Huh?', 'new CD title is correct');
is($cd->year, 2006, 'new CD year is correct');
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/80unique.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/80unique.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/80unique.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -195,7 +195,7 @@
{ key => 'cd_artist_title' }
);
- ok(!$cd1->in_storage, 'CD is not in storage yet after update_or_new');
+ is($cd1->in_storage, 0, 'CD is not in storage yet after update_or_new');
$cd1->insert;
ok($cd1->in_storage, 'CD got added to strage after update_or_new && insert');
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/81transactions.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/81transactions.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/81transactions.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -22,14 +22,13 @@
# Test checking of parameters
{
- eval {
+ throws_ok (sub {
(ref $schema)->txn_do(sub{});
- };
- like($@, qr/storage/, "can't call txn_do without storage");
- eval {
+ }, qr/storage/, "can't call txn_do without storage");
+
+ throws_ok ( sub {
$schema->txn_do('');
- };
- like($@, qr/must be a CODE reference/, '$coderef parameter check ok');
+ }, qr/must be a CODE reference/, '$coderef parameter check ok');
}
# Test successful txn_do() - scalar context
@@ -81,13 +80,10 @@
my $artist = $schema->resultset('Artist')->find(2);
my $count_before = $artist->cds->count;
- eval {
+ lives_ok (sub {
$schema->txn_do($nested_code, $schema, $artist, $code);
- };
+ }, 'nested txn_do succeeded');
- my $error = $@;
-
- ok(!$error, 'nested txn_do succeeded');
is($artist->cds({
title => 'nested txn_do test CD '.$_,
})->first->year, 2006, qq{nested txn_do CD$_ year ok}) for (1..10);
@@ -112,13 +108,10 @@
my $artist = $schema->resultset('Artist')->find(3);
- eval {
+ throws_ok (sub {
$schema->txn_do($fail_code, $artist);
- };
+ }, qr/the sky is falling/, 'failed txn_do threw an exception');
- my $error = $@;
-
- like($error, qr/the sky is falling/, 'failed txn_do threw an exception');
my $cd = $artist->cds({
title => 'this should not exist',
year => 2005,
@@ -134,13 +127,10 @@
my $artist = $schema->resultset('Artist')->find(3);
- eval {
+ throws_ok (sub {
$schema->txn_do($fail_code, $artist);
- };
+ }, qr/the sky is falling/, 'failed txn_do threw an exception');
- my $error = $@;
-
- like($error, qr/the sky is falling/, 'failed txn_do threw an exception');
my $cd = $artist->cds({
title => 'this should not exist',
year => 2005,
@@ -167,17 +157,14 @@
die 'FAILED';
};
- eval {
- $schema->txn_do($fail_code, $artist);
- };
+ throws_ok (
+ sub {
+ $schema->txn_do($fail_code, $artist);
+ },
+ qr/the sky is falling.+Rollback failed/s,
+ 'txn_rollback threw a rollback exception (and included the original exception'
+ );
- my $error = $@;
-
- like($error, qr/Rollback failed/, 'failed txn_do with a failed '.
- 'txn_rollback threw a rollback exception');
- like($error, qr/the sky is falling/, 'failed txn_do with a failed '.
- 'txn_rollback included the original exception');
-
my $cd = $artist->cds({
title => 'this should not exist',
year => 2005,
@@ -208,13 +195,10 @@
my $artist = $schema->resultset('Artist')->find(3);
- eval {
+ throws_ok ( sub {
$schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code);
- };
+ }, qr/the sky is falling/, 'nested failed txn_do threw exception');
- my $error = $@;
-
- like($error, qr/the sky is falling/, 'nested failed txn_do threw exception');
ok(!defined($artist->cds({
title => 'nested txn_do test CD '.$_,
year => 2006,
@@ -229,12 +213,10 @@
# Grab a new schema to test txn before connect
{
my $schema2 = DBICTest->init_schema(no_deploy => 1);
- eval {
+ lives_ok (sub {
$schema2->txn_begin();
$schema2->txn_begin();
- };
- my $err = $@;
- ok(! $err, 'Pre-connection nested transactions.');
+ }, 'Pre-connection nested transactions.');
# although not connected DBI would still warn about rolling back at disconnect
$schema2->txn_rollback;
@@ -263,17 +245,16 @@
ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
- my $inner_exception; # set in inner() below
- eval {
+ my $inner_exception = ''; # set in inner() below
+ throws_ok (sub {
outer($schema, 1);
- };
- is($@, $inner_exception, "Nested exceptions propogated");
+ }, qr/$inner_exception/, "Nested exceptions propogated");
ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
lives_ok (sub {
warnings_exist ( sub {
- # The 0 arg says don't die, just let the scope guard go out of scope
+ # The 0 arg says don't die, just let the scope guard go out of scope
# forcing a txn_rollback to happen
outer($schema, 0);
}, qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./, 'Out of scope warning detected');
@@ -299,9 +280,9 @@
my $artist = $artist_rs->find({ name => 'Death Cab for Cutie' });
eval {
- $artist->cds->create({
+ $artist->cds->create({
title => 'Plans',
- year => 2005,
+ year => 2005,
$fatal ? ( foo => 'bar' ) : ()
});
};
@@ -374,4 +355,40 @@
is (@w, 2, 'Both expected warnings found');
}
+# make sure AutoCommit => 0 on external handles behaves correctly with scope_guard
+{
+ my $factory = DBICTest->init_schema (AutoCommit => 0);
+ cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete');
+ my $dbh = $factory->storage->dbh;
+
+ ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
+ my $schema = DBICTest::Schema->connect (sub { $dbh });
+
+
+ lives_ok ( sub {
+ my $guard = $schema->txn_scope_guard;
+ $schema->resultset('CD')->delete;
+ $guard->commit;
+ }, 'No attempt to start a transaction with scope guard');
+
+ is ($schema->resultset('CD')->count, 0, 'Deletion successful');
+}
+
+# make sure AutoCommit => 0 on external handles behaves correctly with txn_do
+{
+ my $factory = DBICTest->init_schema (AutoCommit => 0);
+ cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete');
+ my $dbh = $factory->storage->dbh;
+
+ ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
+ my $schema = DBICTest::Schema->connect (sub { $dbh });
+
+
+ lives_ok ( sub {
+ $schema->txn_do (sub { $schema->resultset ('CD')->delete });
+ }, 'No attempt to start a atransaction with txn_do');
+
+ is ($schema->resultset('CD')->count, 0, 'Deletion successful');
+}
+
done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/85utf8.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/85utf8.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/85utf8.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,37 +1,43 @@
use strict;
-use warnings;
+use warnings;
use Test::More;
+use Test::Warn;
use lib qw(t/lib);
use DBICTest;
-my $schema = DBICTest->init_schema();
+warning_like (
+ sub {
+ package A::Comp;
+ use base 'DBIx::Class';
+ sub store_column { shift->next::method (@_) };
+ 1;
-if ($] <= 5.008000) {
+ package A::Test;
+ use base 'DBIx::Class::Core';
+ __PACKAGE__->load_components(qw(UTF8Columns +A::Comp));
+ 1;
+ },
+ qr/Incorrect loading order of DBIx::Class::UTF8Columns.+affect other components overriding store_column \(A::Comp\)/,
+ 'incorrect order warning issued',
+);
- eval 'use Encode; 1' or plan skip_all => 'Need Encode run this test';
-
-} else {
-
- eval 'use utf8; 1' or plan skip_all => 'Need utf8 run this test';
-}
-
-plan tests => 6;
-
+my $schema = DBICTest->init_schema();
DBICTest::Schema::CD->load_components('UTF8Columns');
DBICTest::Schema::CD->utf8_columns('title');
Class::C3->reinitialize();
-my $cd = $schema->resultset('CD')->create( { artist => 1, title => 'øni', year => '2048' } );
-my $utf8_char = 'uniuni';
+my $cd = $schema->resultset('CD')->create( { artist => 1, title => "weird\x{466}stuff", year => '2048' } );
+ok( utf8::is_utf8( $cd->title ), 'got title with utf8 flag' );
+ok(! utf8::is_utf8( $cd->{_column_data}{title} ), 'store title without utf8' );
-ok( _is_utf8( $cd->title ), 'got title with utf8 flag' );
-ok(! _is_utf8( $cd->year ), 'got year without utf8 flag' );
+ok(! utf8::is_utf8( $cd->year ), 'got year without utf8 flag' );
+ok(! utf8::is_utf8( $cd->{_column_data}{year} ), 'store year without utf8' );
-_force_utf8($utf8_char);
-$cd->title($utf8_char);
-ok(! _is_utf8( $cd->{_column_data}{title} ), 'store utf8-less chars' );
+$cd->title('nonunicode');
+ok(! utf8::is_utf8( $cd->title ), 'got title without utf8 flag' );
+ok(! utf8::is_utf8( $cd->{_column_data}{title} ), 'store utf8-less chars' );
my $v_utf8 = "\x{219}";
@@ -47,24 +53,7 @@
TODO: {
local $TODO = 'There is currently no way to propagate aliases to inflate_result()';
$cd = $schema->resultset('CD')->find ({ title => $v_utf8 }, { select => 'title', as => 'name' });
- ok (_is_utf8( $cd->get_column ('name') ), 'utf8 flag propagates via as');
+ ok (utf8::is_utf8( $cd->get_column ('name') ), 'utf8 flag propagates via as');
}
-
-sub _force_utf8 {
- if ($] <= 5.008000) {
- Encode::_utf8_on ($_[0]);
- }
- else {
- utf8::decode ($_[0]);
- }
-}
-
-sub _is_utf8 {
- if ($] <= 5.008000) {
- return Encode::is_utf8 (shift);
- }
- else {
- return utf8::is_utf8 (shift);
- }
-}
+done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/86might_have.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/86might_have.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/86might_have.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -2,6 +2,7 @@
use warnings;
use Test::More;
+use Test::Warn;
use lib qw(t/lib);
use DBICTest;
@@ -11,8 +12,6 @@
$schema->storage->debugcb( sub{ $queries++ } );
my $sdebug = $schema->storage->debug;
-plan tests => 2;
-
my $cd = $schema->resultset("CD")->find(1);
$cd->title('test');
@@ -40,4 +39,26 @@
is($queries, 1, 'liner_notes (might_have) prefetched - do not load
liner_notes on update');
+warning_like {
+ DBICTest::Schema::Bookmark->might_have(
+ linky => 'DBICTest::Schema::Link',
+ { "foreign.id" => "self.link" },
+ );
+}
+ qr{"might_have/has_one" must not be on columns with is_nullable set to true},
+ 'might_have should warn if the self.id column is nullable';
+
+{
+ local $ENV{DBIC_DONT_VALIDATE_RELS} = 1;
+ warning_is {
+ DBICTest::Schema::Bookmark->might_have(
+ slinky => 'DBICTest::Schema::Link',
+ { "foreign.id" => "self.link" },
+ );
+ }
+ undef,
+ 'Setting DBIC_DONT_VALIDATE_RELS suppresses nullable relation warnings';
+}
+
$schema->storage->debug($sdebug);
+done_testing();
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/86sqlt.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/86sqlt.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/86sqlt.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -14,6 +14,36 @@
my $schema = DBICTest->init_schema (no_deploy => 1);
+
+# Check deployment statements ctx sensitivity
+{
+ my $not_first_table_creation_re = qr/CREATE TABLE fourkeys_to_twokeys/;
+
+
+ my $statements = $schema->deployment_statements;
+ like (
+ $statements,
+ $not_first_table_creation_re,
+ 'All create statements returned in 1 string in scalar ctx'
+ );
+
+ my @statements = $schema->deployment_statements;
+ cmp_ok (scalar @statements, '>', 1, 'Multiple statement lines in array ctx');
+
+ my $i = 0;
+ while ($i <= $#statements) {
+ last if $statements[$i] =~ $not_first_table_creation_re;
+ $i++;
+ }
+
+ ok (
+ ($i > 0) && ($i <= $#statements),
+ "Creation statement was found somewherere within array ($i)"
+ );
+}
+
+
+
# replace the sqlt calback with a custom version ading an index
$schema->source('Track')->sqlt_deploy_callback(sub {
my ($self, $sqlt_table) = @_;
@@ -239,6 +269,7 @@
'name' => 'forceforeign_fk_artist', 'index_name' => 'forceforeign_idx_artist',
'selftable' => 'forceforeign', 'foreigntable' => 'artist',
'selfcols' => ['artist'], 'foreigncols' => ['artistid'],
+ 'noindex' => 1,
on_delete => '', on_update => '', deferrable => 1,
},
],
@@ -434,21 +465,21 @@
my ($expected, $got) = @_;
my $desc = $expected->{display};
is( $got->name, $expected->{name},
- "name parameter correct for `$desc'" );
+ "name parameter correct for '$desc'" );
is( $got->on_delete, $expected->{on_delete},
- "on_delete parameter correct for `$desc'" );
+ "on_delete parameter correct for '$desc'" );
is( $got->on_update, $expected->{on_update},
- "on_update parameter correct for `$desc'" );
+ "on_update parameter correct for '$desc'" );
is( $got->deferrable, $expected->{deferrable},
- "is_deferrable parameter correct for `$desc'" );
+ "is_deferrable parameter correct for '$desc'" );
my $index = get_index( $got->table, { fields => $expected->{selfcols} } );
if ($expected->{noindex}) {
- ok( !defined $index, "index doesn't for `$desc'" );
+ ok( !defined $index, "index doesn't for '$desc'" );
} else {
- ok( defined $index, "index exists for `$desc'" );
- is( $index->name, $expected->{index_name}, "index has correct name for `$desc'" );
+ ok( defined $index, "index exists for '$desc'" );
+ is( $index->name, $expected->{index_name}, "index has correct name for '$desc'" );
}
}
@@ -456,7 +487,7 @@
my ($expected, $got) = @_;
my $desc = $expected->{display};
is( $got->name, $expected->{name},
- "name parameter correct for `$desc'" );
+ "name parameter correct for '$desc'" );
}
done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/88result_set_column.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/88result_set_column.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/88result_set_column.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -6,11 +6,19 @@
use Test::Exception;
use lib qw(t/lib);
use DBICTest;
+use DBIC::SqlMakerTest;
my $schema = DBICTest->init_schema();
-my $rs = $schema->resultset("CD")->search({}, { order_by => 'cdid' });
+my $rs = $schema->resultset("CD");
+cmp_ok (
+ $rs->count,
+ '!=',
+ $rs->search ({}, {columns => ['year'], distinct => 1})->count,
+ 'At least one year is the same in rs'
+);
+
my $rs_title = $rs->get_column('title');
my $rs_year = $rs->get_column('year');
my $max_year = $rs->get_column(\'MAX (year)');
@@ -36,35 +44,82 @@
is($rs_year->single, 1999, "single okay");
}, qr/Query returned more than one row/, 'single warned');
+
+# test distinct propagation
+is_deeply (
+ [$rs->search ({}, { distinct => 1 })->get_column ('year')->all],
+ [$rs_year->func('distinct')],
+ 'distinct => 1 is passed through properly',
+);
+
# test +select/+as for single column
my $psrs = $schema->resultset('CD')->search({},
{
- '+select' => \'COUNT(*)',
- '+as' => 'count'
+ '+select' => \'MAX(year)',
+ '+as' => 'last_year'
}
);
-lives_ok(sub { $psrs->get_column('count')->next }, '+select/+as additional column "count" present (scalar)');
+lives_ok(sub { $psrs->get_column('last_year')->next }, '+select/+as additional column "last_year" present (scalar)');
dies_ok(sub { $psrs->get_column('noSuchColumn')->next }, '+select/+as nonexistent column throws exception');
-# test +select/+as for multiple columns
+# test +select/+as for overriding a column
$psrs = $schema->resultset('CD')->search({},
{
- '+select' => [ \'COUNT(*)', 'title' ],
- '+as' => [ 'count', 'addedtitle' ]
+ 'select' => \"'The Final Countdown'",
+ 'as' => 'title'
}
);
-lives_ok(sub { $psrs->get_column('count')->next }, '+select/+as multiple additional columns, "count" column present');
-lives_ok(sub { $psrs->get_column('addedtitle')->next }, '+select/+as multiple additional columns, "addedtitle" column present');
+is($psrs->get_column('title')->next, 'The Final Countdown', '+select/+as overridden column "title"');
-# test +select/+as for overriding a column
+
+# test +select/+as for multiple columns
$psrs = $schema->resultset('CD')->search({},
{
- 'select' => \"'The Final Countdown'",
- 'as' => 'title'
+ '+select' => [ \'LENGTH(title) AS title_length', 'title' ],
+ '+as' => [ 'tlength', 'addedtitle' ]
}
);
-is($psrs->get_column('title')->next, 'The Final Countdown', '+select/+as overridden column "title"');
+lives_ok(sub { $psrs->get_column('tlength')->next }, '+select/+as multiple additional columns, "tlength" column present');
+lives_ok(sub { $psrs->get_column('addedtitle')->next }, '+select/+as multiple additional columns, "addedtitle" column present');
+# test that +select/+as specs do not leak
+is_same_sql_bind (
+ $psrs->get_column('year')->as_query,
+ '(SELECT me.year FROM cd me)',
+ [],
+ 'Correct SQL for get_column/as'
+);
+
+is_same_sql_bind (
+ $psrs->get_column('addedtitle')->as_query,
+ '(SELECT me.title FROM cd me)',
+ [],
+ 'Correct SQL for get_column/+as col'
+);
+
+is_same_sql_bind (
+ $psrs->get_column('tlength')->as_query,
+ '(SELECT LENGTH(title) AS title_length FROM cd me)',
+ [],
+ 'Correct SQL for get_column/+as func'
+);
+
+# test that order_by over a function forces a subquery
+lives_ok ( sub {
+ is_deeply (
+ [ $psrs->search ({}, { order_by => { -desc => 'title_length' } })->get_column ('title')->all ],
+ [
+ "Generic Manufactured Singles",
+ "Come Be Depressed With Us",
+ "Caterwaulin' Blues",
+ "Spoonful of bees",
+ "Forkful of bees",
+ ],
+ 'Subquery count induced by aliased ordering function',
+ );
+});
+
+# test for prefetch not leaking
{
my $rs = $schema->resultset("CD")->search({}, { prefetch => 'artist' });
my $rsc = $rs->get_column('year');
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/93autocast.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/93autocast.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/93autocast.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -71,7 +71,7 @@
WHERE
cdid > CAST(? AS INT)
AND tracks.last_updated_at IS NOT NULL
- AND tracks.last_updated_on < CAST (? AS yyy)
+ AND tracks.last_updated_on < CAST (? AS DateTime)
AND tracks.position = ?
AND tracks.single_track = CAST(? AS INT)
)',
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/93single_accessor_object.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/93single_accessor_object.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/93single_accessor_object.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -48,7 +48,7 @@
my $artist = $schema->resultset('Artist')->create({ artistid => 666, name => 'bad religion' });
my $cd = $schema->resultset('CD')->create({ cdid => 187, artist => 1, title => 'how could hell be any worse?', year => 1982, genreid => undef });
- ok(!defined($cd->genreid), 'genreid is NULL');
+ ok(!defined($cd->get_column('genreid')), 'genreid is NULL'); #no accessor was defined for this column
ok(!defined($cd->genre), 'genre accessor returns undef');
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/94versioning.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/94versioning.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/94versioning.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -3,7 +3,10 @@
use strict;
use warnings;
use Test::More;
-use File::Spec;
+use Test::Warn;
+use Test::Exception;
+
+use Path::Class;
use File::Copy;
#warn "$dsn $user $pass";
@@ -25,106 +28,143 @@
if not DBIx::Class::Storage::DBI->_sqlt_version_ok;
}
+use lib qw(t/lib);
+use DBICTest; # do not remove even though it is not used
+
+use_ok('DBICVersion_v1');
+
my $version_table_name = 'dbix_class_schema_versions';
my $old_table_name = 'SchemaVersions';
-my $ddl_dir = File::Spec->catdir ('t', 'var');
+my $ddl_dir = dir ('t', 'var');
+mkdir ($ddl_dir) unless -d $ddl_dir;
+
my $fn = {
- v1 => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-1.0-MySQL.sql'),
- v2 => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-2.0-MySQL.sql'),
- trans => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-1.0-2.0-MySQL.sql'),
+ v1 => $ddl_dir->file ('DBICVersion-Schema-1.0-MySQL.sql'),
+ v2 => $ddl_dir->file ('DBICVersion-Schema-2.0-MySQL.sql'),
+ v3 => $ddl_dir->file ('DBICVersion-Schema-3.0-MySQL.sql'),
+ trans_v12 => $ddl_dir->file ('DBICVersion-Schema-1.0-2.0-MySQL.sql'),
+ trans_v23 => $ddl_dir->file ('DBICVersion-Schema-2.0-3.0-MySQL.sql'),
};
-use lib qw(t/lib);
-use DBICTest; # do not remove even though it is not used
+my $schema_v1 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
+eval { $schema_v1->storage->dbh->do('drop table ' . $version_table_name) };
+eval { $schema_v1->storage->dbh->do('drop table ' . $old_table_name) };
-use_ok('DBICVersionOrig');
-
-my $schema_orig = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
-eval { $schema_orig->storage->dbh->do('drop table ' . $version_table_name) };
-eval { $schema_orig->storage->dbh->do('drop table ' . $old_table_name) };
-
-is($schema_orig->ddl_filename('MySQL', '1.0', $ddl_dir), $fn->{v1}, 'Filename creation working');
+is($schema_v1->ddl_filename('MySQL', '1.0', $ddl_dir), $fn->{v1}, 'Filename creation working');
unlink( $fn->{v1} ) if ( -e $fn->{v1} );
-$schema_orig->create_ddl_dir('MySQL', undef, $ddl_dir);
+$schema_v1->create_ddl_dir('MySQL', undef, $ddl_dir);
ok(-f $fn->{v1}, 'Created DDL file');
-$schema_orig->deploy({ add_drop_table => 1 });
+$schema_v1->deploy({ add_drop_table => 1 });
-my $tvrs = $schema_orig->{vschema}->resultset('Table');
-is($schema_orig->_source_exists($tvrs), 1, 'Created schema from DDL file');
+my $tvrs = $schema_v1->{vschema}->resultset('Table');
+is($schema_v1->_source_exists($tvrs), 1, 'Created schema from DDL file');
# loading a new module defining a new version of the same table
DBICVersion::Schema->_unregister_source ('Table');
-eval "use DBICVersionNew";
+use_ok('DBICVersion_v2');
-my $schema_upgrade = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
+my $schema_v2 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
{
unlink($fn->{v2});
- unlink($fn->{trans});
+ unlink($fn->{trans_v12});
- is($schema_upgrade->get_db_version(), '1.0', 'get_db_version ok');
- is($schema_upgrade->schema_version, '2.0', 'schema version ok');
- $schema_upgrade->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0');
- ok(-f $fn->{trans}, 'Created DDL file');
+ is($schema_v2->get_db_version(), '1.0', 'get_db_version ok');
+ is($schema_v2->schema_version, '2.0', 'schema version ok');
+ $schema_v2->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0');
+ ok(-f $fn->{trans_v12}, 'Created DDL file');
- {
- my $w;
- local $SIG{__WARN__} = sub { $w = shift };
+ warnings_like (
+ sub { $schema_v2->upgrade() },
+ qr/DB version .+? is lower than the schema version/,
+ 'Warn before upgrade',
+ );
- sleep 1; # remove this when TODO below is completed
+ is($schema_v2->get_db_version(), '2.0', 'db version number upgraded');
- $schema_upgrade->upgrade();
- like ($w, qr/Attempting upgrade\.$/, 'Warn before upgrade');
- }
+ lives_ok ( sub {
+ $schema_v2->storage->dbh->do('select NewVersionName from TestVersion');
+ }, 'new column created' );
- is($schema_upgrade->get_db_version(), '2.0', 'db version number upgraded');
-
- eval {
- $schema_upgrade->storage->dbh->do('select NewVersionName from TestVersion');
- };
- is($@, '', 'new column created');
-
- # should overwrite files and warn about it
- my @w;
- local $SIG{__WARN__} = sub {
- if ($_[0] =~ /Overwriting existing/) {
- push @w, $_[0];
- }
- else {
- warn @_;
- }
- };
- $schema_upgrade->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0');
-
- is (2, @w, 'A warning generated for both the DDL and the diff');
- like ($w[0], qr/Overwriting existing DDL file - $fn->{v2}/, 'New version DDL overwrite warning');
- like ($w[1], qr/Overwriting existing diff file - $fn->{trans}/, 'Upgrade diff overwrite warning');
+ warnings_exist (
+ sub { $schema_v2->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0') },
+ [
+ qr/Overwriting existing DDL file - $fn->{v2}/,
+ qr/Overwriting existing diff file - $fn->{trans_v12}/,
+ ],
+ 'An overwrite warning generated for both the DDL and the diff',
+ );
}
{
my $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
- eval {
+ lives_ok (sub {
$schema_version->storage->dbh->do('select * from ' . $version_table_name);
- };
- is($@, '', 'version table exists');
+ }, 'version table exists');
- eval {
+ lives_ok (sub {
$schema_version->storage->dbh->do("DROP TABLE IF EXISTS $old_table_name");
$schema_version->storage->dbh->do("RENAME TABLE $version_table_name TO $old_table_name");
- };
- is($@, '', 'versions table renamed to old style table');
+ }, 'versions table renamed to old style table');
$schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
is($schema_version->get_db_version, '2.0', 'transition from old table name to new okay');
- eval {
+ dies_ok (sub {
$schema_version->storage->dbh->do('select * from ' . $old_table_name);
- };
- ok($@, 'old version table gone');
+ }, 'old version table gone');
}
+# repeat the v1->v2 process for v2->v3 before testing v1->v3
+DBICVersion::Schema->_unregister_source ('Table');
+use_ok('DBICVersion_v3');
+
+my $schema_v3 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
+{
+ unlink($fn->{v3});
+ unlink($fn->{trans_v23});
+
+ is($schema_v3->get_db_version(), '2.0', 'get_db_version 2.0 ok');
+ is($schema_v3->schema_version, '3.0', 'schema version 3.0 ok');
+ $schema_v3->create_ddl_dir('MySQL', '3.0', $ddl_dir, '2.0');
+ ok(-f $fn->{trans_v23}, 'Created DDL 2.0 -> 3.0 file');
+
+ warnings_exist (
+ sub { $schema_v3->upgrade() },
+ qr/DB version .+? is lower than the schema version/,
+ 'Warn before upgrade',
+ );
+
+ is($schema_v3->get_db_version(), '3.0', 'db version number upgraded');
+
+ lives_ok ( sub {
+ $schema_v3->storage->dbh->do('select ExtraColumn from TestVersion');
+ }, 'new column created');
+}
+
+# now put the v1 schema back again
+{
+ # drop all the tables...
+ eval { $schema_v1->storage->dbh->do('drop table ' . $version_table_name) };
+ eval { $schema_v1->storage->dbh->do('drop table ' . $old_table_name) };
+ eval { $schema_v1->storage->dbh->do('drop table TestVersion') };
+
+ {
+ local $DBICVersion::Schema::VERSION = '1.0';
+ $schema_v1->deploy;
+ }
+ is($schema_v1->get_db_version(), '1.0', 'get_db_version 1.0 ok');
+}
+
+# attempt v1 -> v3 upgrade
+{
+ local $SIG{__WARN__} = sub { warn if $_[0] !~ /Attempting upgrade\.$/ };
+ $schema_v3->upgrade();
+ is($schema_v3->get_db_version(), '3.0', 'db version number upgraded');
+}
+
# check behaviour of DBIC_NO_VERSION_CHECK env var and ignore_version connect attr
{
my $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
@@ -133,53 +173,45 @@
};
- my $warn = '';
- local $SIG{__WARN__} = sub { $warn = shift };
- $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
- like($warn, qr/Your DB is currently unversioned/, 'warning detected without env var or attr');
+ warnings_like ( sub {
+ $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
+ }, qr/Your DB is currently unversioned/, 'warning detected without env var or attr' );
+ warnings_like ( sub {
+ $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
+ }, [], 'warning not detected with attr set');
- # should warn
- $warn = '';
- $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 });
- is($warn, '', 'warning not detected with attr set');
- # should not warn
local $ENV{DBIC_NO_VERSION_CHECK} = 1;
- $warn = '';
- $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
- is($warn, '', 'warning not detected with env var set');
- # should not warn
+ warnings_like ( sub {
+ $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass);
+ }, [], 'warning not detected with env var set');
- $warn = '';
- $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 0 });
- like($warn, qr/Your DB is currently unversioned/, 'warning detected without env var or attr');
- # should warn
+ warnings_like ( sub {
+ $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 0 });
+ }, qr/Your DB is currently unversioned/, 'warning detected without env var or attr');
}
# attempt a deploy/upgrade cycle within one second
-TODO: {
+{
+ eval { $schema_v2->storage->dbh->do('drop table ' . $version_table_name) };
+ eval { $schema_v2->storage->dbh->do('drop table ' . $old_table_name) };
+ eval { $schema_v2->storage->dbh->do('drop table TestVersion') };
- local $TODO = 'To fix this properly the table must be extended with an autoinc column, mst will not accept anything less';
-
- eval { $schema_orig->storage->dbh->do('drop table ' . $version_table_name) };
- eval { $schema_orig->storage->dbh->do('drop table ' . $old_table_name) };
- eval { $schema_orig->storage->dbh->do('drop table TestVersion') };
-
# this attempts to sleep until the turn of the second
my $t = time();
sleep (int ($t) + 1 - $t);
- diag ('Fast deploy/upgrade start: ', time() );
+ note ('Fast deploy/upgrade start: ', time() );
{
- local $DBICVersion::Schema::VERSION = '1.0';
- $schema_orig->deploy;
+ local $DBICVersion::Schema::VERSION = '2.0';
+ $schema_v2->deploy;
}
local $SIG{__WARN__} = sub { warn if $_[0] !~ /Attempting upgrade\.$/ };
- $schema_upgrade->upgrade();
+ $schema_v2->upgrade();
- is($schema_upgrade->get_db_version(), '2.0', 'Fast deploy/upgrade');
+ is($schema_v2->get_db_version(), '3.0', 'Fast deploy/upgrade');
};
unless ($ENV{DBICTEST_KEEP_VERSIONING_DDL}) {
Deleted: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/95sql_maker.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/95sql_maker.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/95sql_maker.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,79 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use Test::Exception;
-
-use lib qw(t/lib);
-use DBIC::SqlMakerTest;
-
-use_ok('DBICTest');
-
-my $schema = DBICTest->init_schema(no_deploy => 1);
-
-my $sql_maker = $schema->storage->sql_maker;
-
-
-{
- my ($sql, @bind) = $sql_maker->insert(
- 'lottery',
- {
- 'day' => '2008-11-16',
- 'numbers' => [13, 21, 34, 55, 89]
- }
- );
-
- is_same_sql_bind(
- $sql, \@bind,
- q/INSERT INTO lottery (day, numbers) VALUES (?, ?)/,
- [ ['day' => '2008-11-16'], ['numbers' => [13, 21, 34, 55, 89]] ],
- 'sql_maker passes arrayrefs in insert'
- );
-
-
- ($sql, @bind) = $sql_maker->update(
- 'lottery',
- {
- 'day' => '2008-11-16',
- 'numbers' => [13, 21, 34, 55, 89]
- }
- );
-
- is_same_sql_bind(
- $sql, \@bind,
- q/UPDATE lottery SET day = ?, numbers = ?/,
- [ ['day' => '2008-11-16'], ['numbers' => [13, 21, 34, 55, 89]] ],
- 'sql_maker passes arrayrefs in update'
- );
-}
-
-# make sure the cookbook caveat of { $op, \'...' } no longer applies
-{
- my ($sql, @bind) = $sql_maker->where({
- last_attempt => \ '< now() - interval "12 hours"',
- next_attempt => { '<', \ 'now() - interval "12 hours"' },
- created => [
- { '<=', \ '1969' },
- \ '> 1984',
- ],
- });
- is_same_sql_bind(
- $sql,
- \@bind,
- 'WHERE
- (created <= 1969 OR created > 1984 )
- AND last_attempt < now() - interval "12 hours"
- AND next_attempt < now() - interval "12 hours"
- ',
- [],
- );
-}
-
-# Make sure the carp/croak override in SQLA works (via SQLAHacks)
-my $file = __FILE__;
-$file = "\Q$file\E";
-throws_ok (sub {
- $schema->resultset ('Artist')->search ({}, { order_by => { -asc => 'stuff', -desc => 'staff' } } )->as_query;
-}, qr/$file/, 'Exception correctly croak()ed');
-
-done_testing;
Deleted: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/95sql_maker_quote.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/95sql_maker_quote.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/95sql_maker_quote.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,332 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-
-use lib qw(t/lib);
-use DBIC::SqlMakerTest;
-
-BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? ( skip_all => 'needs DBD::SQLite for testing' )
- : ( tests => 12 );
-}
-
-use_ok('DBICTest');
-
-my $schema = DBICTest->init_schema();
-
-my $sql_maker = $schema->storage->sql_maker;
-
-$sql_maker->quote_char('`');
-$sql_maker->name_sep('.');
-
-my ($sql, @bind) = $sql_maker->select(
- [
- {
- 'me' => 'cd'
- },
- [
- {
- 'artist' => 'artist',
- '-join_type' => ''
- },
- {
- 'artist.artistid' => 'me.artist'
- }
- ],
- [
- {
- 'tracks' => 'tracks',
- '-join_type' => 'left'
- },
- {
- 'tracks.cd' => 'me.cdid'
- }
- ],
- ],
- [
- 'me.cdid',
- { count => 'tracks.cd' },
- { min => 'me.year', -as => 'me.minyear' },
- ],
- {
- 'artist.name' => 'Caterwauler McCrae',
- 'me.year' => 2001
- },
- [],
- undef,
- undef
-);
-
-is_same_sql_bind(
- $sql, \@bind,
- q/
- SELECT `me`.`cdid`, COUNT( `tracks`.`cd` ), MIN( `me`.`year` ) AS `me`.`minyear`
- FROM `cd` `me`
- JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` )
- LEFT JOIN `tracks` `tracks` ON ( `tracks`.`cd` = `me`.`cdid` )
- WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )
- /,
- [ ['artist.name' => 'Caterwauler McCrae'], ['me.year' => 2001] ],
- 'got correct SQL and bind parameters for complex select query with quoting'
-);
-
-
-($sql, @bind) = $sql_maker->select(
- [
- {
- 'me' => 'cd'
- }
- ],
- [
- 'me.cdid',
- 'me.artist',
- 'me.title',
- 'me.year'
- ],
- undef,
- 'year DESC',
- undef,
- undef
-);
-
-is_same_sql_bind(
- $sql, \@bind,
- q/SELECT `me`.`cdid`, `me`.`artist`, `me`.`title`, `me`.`year` FROM `cd` `me` ORDER BY `year DESC`/, [],
- 'scalar ORDER BY okay (single value)'
-);
-
-
-($sql, @bind) = $sql_maker->select(
- [
- {
- 'me' => 'cd'
- }
- ],
- [
- 'me.cdid',
- 'me.artist',
- 'me.title',
- 'me.year'
- ],
- undef,
- [
- 'year DESC',
- 'title ASC'
- ],
- undef,
- undef
-);
-
-is_same_sql_bind(
- $sql, \@bind,
- q/SELECT `me`.`cdid`, `me`.`artist`, `me`.`title`, `me`.`year` FROM `cd` `me` ORDER BY `year DESC`, `title ASC`/, [],
- 'scalar ORDER BY okay (multiple values)'
-);
-
-{
- ($sql, @bind) = $sql_maker->select(
- [
- {
- 'me' => 'cd'
- }
- ],
- [
- 'me.cdid',
- 'me.artist',
- 'me.title',
- 'me.year'
- ],
- undef,
- { -desc => 'year' },
- undef,
- undef
- );
-
- is_same_sql_bind(
- $sql, \@bind,
- q/SELECT `me`.`cdid`, `me`.`artist`, `me`.`title`, `me`.`year` FROM `cd` `me` ORDER BY `year` DESC/, [],
- 'hashref ORDER BY okay (single value)'
- );
-
-
- ($sql, @bind) = $sql_maker->select(
- [
- {
- 'me' => 'cd'
- }
- ],
- [
- 'me.cdid',
- 'me.artist',
- 'me.title',
- 'me.year'
- ],
- undef,
- [
- { -desc => 'year' },
- { -asc => 'title' }
- ],
- undef,
- undef
- );
-
- is_same_sql_bind(
- $sql, \@bind,
- q/SELECT `me`.`cdid`, `me`.`artist`, `me`.`title`, `me`.`year` FROM `cd` `me` ORDER BY `year` DESC, `title` ASC/, [],
- 'hashref ORDER BY okay (multiple values)'
- );
-
-}
-
-
-($sql, @bind) = $sql_maker->select(
- [
- {
- 'me' => 'cd'
- }
- ],
- [
- 'me.cdid',
- 'me.artist',
- 'me.title',
- 'me.year'
- ],
- undef,
- \'year DESC',
- undef,
- undef
-);
-
-is_same_sql_bind(
- $sql, \@bind,
- q/SELECT `me`.`cdid`, `me`.`artist`, `me`.`title`, `me`.`year` FROM `cd` `me` ORDER BY year DESC/, [],
- 'did not quote ORDER BY with scalarref (single value)'
-);
-
-
-($sql, @bind) = $sql_maker->select(
- [
- {
- 'me' => 'cd'
- }
- ],
- [
- 'me.cdid',
- 'me.artist',
- 'me.title',
- 'me.year'
- ],
- undef,
- [
- \'year DESC',
- \'title ASC'
- ],
- undef,
- undef
-);
-
-is_same_sql_bind(
- $sql, \@bind,
- q/SELECT `me`.`cdid`, `me`.`artist`, `me`.`title`, `me`.`year` FROM `cd` `me` ORDER BY year DESC, title ASC/, [],
- 'did not quote ORDER BY with scalarref (multiple values)'
-);
-
-
-($sql, @bind) = $sql_maker->update(
- 'group',
- {
- 'order' => '12',
- 'name' => 'Bill'
- }
-);
-
-is_same_sql_bind(
- $sql, \@bind,
- q/UPDATE `group` SET `name` = ?, `order` = ?/, [ ['name' => 'Bill'], ['order' => '12'] ],
- 'quoted table names for UPDATE'
-);
-
-{
- ($sql, @bind) = $sql_maker->select(
- [
- {
- 'me' => 'cd'
- }
- ],
- [
- 'me.*'
- ],
- undef,
- [],
- undef,
- undef
- );
-
- is_same_sql_bind(
- $sql, \@bind,
- q/SELECT `me`.* FROM `cd` `me`/, [],
- 'select attr with me.* is right'
- );
-}
-
-
-$sql_maker->quote_char([qw/[ ]/]);
-
-($sql, @bind) = $sql_maker->select(
- [
- {
- 'me' => 'cd'
- },
- [
- {
- 'artist' => 'artist',
- '-join_type' => ''
- },
- {
- 'artist.artistid' => 'me.artist'
- }
- ]
- ],
- [
- {
- max => 'rank',
- -as => 'max_rank',
- },
- 'rank',
- {
- 'count' => '*',
- -as => 'cnt',
- }
- ],
- {
- 'artist.name' => 'Caterwauler McCrae',
- 'me.year' => 2001
- },
- [],
- undef,
- undef
-);
-
-is_same_sql_bind(
- $sql, \@bind,
- q/SELECT MAX ( [rank] ) AS [max_rank], [rank], COUNT( * ) AS [cnt] FROM [cd] [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )/, [ ['artist.name' => 'Caterwauler McCrae'], ['me.year' => 2001] ],
- 'got correct SQL and bind parameters for count query with bracket quoting'
-);
-
-
-($sql, @bind) = $sql_maker->update(
- 'group',
- {
- 'order' => '12',
- 'name' => 'Bill'
- }
-);
-
-is_same_sql_bind(
- $sql, \@bind,
- q/UPDATE [group] SET [name] = ?, [order] = ?/, [ ['name' => 'Bill'], ['order' => '12'] ],
- 'bracket quoted table names for UPDATE'
-);
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/98savepoints.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/98savepoints.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/98savepoints.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -8,11 +8,11 @@
my ($create_sql, $dsn, $user, $pass);
-if (exists $ENV{DBICTEST_PG_DSN}) {
+if ($ENV{DBICTEST_PG_DSN}) {
($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
$create_sql = "CREATE TABLE artist (artistid serial PRIMARY KEY, name VARCHAR(100), rank INTEGER NOT NULL DEFAULT '13', charfield CHAR(10))";
-} elsif (exists $ENV{DBICTEST_MYSQL_DSN}) {
+} elsif ($ENV{DBICTEST_MYSQL_DSN}) {
($dsn, $user, $pass) = @ENV{map { "DBICTEST_MYSQL_${_}" } qw/DSN USER PASS/};
$create_sql = "CREATE TABLE artist (artistid INTEGER NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(100), rank INTEGER NOT NULL DEFAULT '13', charfield CHAR(10)) ENGINE=InnoDB";
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/99dbic_sqlt_parser.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/99dbic_sqlt_parser.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/99dbic_sqlt_parser.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,9 +1,12 @@
-#!/usr/bin/perl
use strict;
use warnings;
+
use Test::More;
+use Test::Exception;
use lib qw(t/lib);
use DBICTest;
+use DBICTest::Schema;
+use Scalar::Util ();
BEGIN {
require DBIx::Class::Storage::DBI;
@@ -12,6 +15,16 @@
if not DBIx::Class::Storage::DBI->_sqlt_version_ok;
}
+# Test for SQLT-related leaks
+{
+ my $s = DBICTest::Schema->clone;
+ create_schema ({ schema => $s });
+ Scalar::Util::weaken ($s);
+
+ ok (!$s, 'Schema not leaked');
+}
+
+
my $schema = DBICTest->init_schema();
# Dummy was yanked out by the sqlt hook test
# CustomSql tests the horrific/deprecated ->name(\$sql) hack
@@ -22,65 +35,119 @@
$schema->sources
;
-{
- my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { } } });
+my $idx_exceptions = {
+ 'Artwork' => -1,
+ 'ForceForeign' => -1,
+ 'LinerNotes' => -1,
+ 'TwoKeys' => -1, # TwoKeys has the index turned off on the rel def
+};
- foreach my $source (@sources) {
- my $table = get_table($sqlt_schema, $schema, $source);
+{
+ my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { } } });
- my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints);
- my @indices = $table->get_indices;
- my $index_count = scalar(@indices);
- $index_count++ if ($source eq 'TwoKeys'); # TwoKeys has the index turned off on the rel def
- is($index_count, $fk_count, "correct number of indices for $source with no args");
- }
+ foreach my $source_name (@sources) {
+ my $table = get_table($sqlt_schema, $schema, $source_name);
+
+ my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints);
+ $fk_count += $idx_exceptions->{$source_name} || 0;
+ my @indices = $table->get_indices;
+
+ my $index_count = scalar(@indices);
+ is($index_count, $fk_count, "correct number of indices for $source_name with no args");
+
+ for my $index (@indices) {
+ my $source = $schema->source($source_name);
+ my $pk_test = join("\x00", $source->primary_columns);
+ my $idx_test = join("\x00", $index->fields);
+ isnt ( $pk_test, $idx_test, "no additional index for the primary columns exists in $source_name");
+ }
+ }
}
-{
- my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 1 } } });
+{
+ my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 1 } } });
- foreach my $source (@sources) {
- my $table = get_table($sqlt_schema, $schema, $source);
+ foreach my $source_name (@sources) {
+ my $table = get_table($sqlt_schema, $schema, $source_name);
- my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints);
- my @indices = $table->get_indices;
- my $index_count = scalar(@indices);
- $index_count++ if ($source eq 'TwoKeys'); # TwoKeys has the index turned off on the rel def
- is($index_count, $fk_count, "correct number of indices for $source with add_fk_index => 1");
- }
+ my $fk_count = scalar(grep { $_->type eq 'FOREIGN KEY' } $table->get_constraints);
+ $fk_count += $idx_exceptions->{$source_name} || 0;
+ my @indices = $table->get_indices;
+ my $index_count = scalar(@indices);
+ is($index_count, $fk_count, "correct number of indices for $source_name with add_fk_index => 1");
+ }
}
-{
- my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 0 } } });
+{
+ my $sqlt_schema = create_schema({ schema => $schema, args => { parser_args => { add_fk_index => 0 } } });
- foreach my $source (@sources) {
- my $table = get_table($sqlt_schema, $schema, $source);
+ foreach my $source (@sources) {
+ my $table = get_table($sqlt_schema, $schema, $source);
- my @indices = $table->get_indices;
- my $index_count = scalar(@indices);
- is($index_count, 0, "correct number of indices for $source with add_fk_index => 0");
- }
+ my @indices = $table->get_indices;
+ my $index_count = scalar(@indices);
+ is($index_count, 0, "correct number of indices for $source with add_fk_index => 0");
+ }
}
+{
+ {
+ package # hide from PAUSE
+ DBICTest::Schema::NoViewDefinition;
+
+ use base qw/DBICTest::BaseResult/;
+
+ __PACKAGE__->table_class('DBIx::Class::ResultSource::View');
+ __PACKAGE__->table('noviewdefinition');
+
+ 1;
+ }
+
+ my $schema_invalid_view = $schema->clone;
+ $schema_invalid_view->register_class('NoViewDefinition', 'DBICTest::Schema::NoViewDefinition');
+
+ throws_ok { create_schema({ schema => $schema_invalid_view }) }
+ qr/view noviewdefinition is missing a view_definition/,
+ 'parser detects views with a view_definition';
+}
+
+lives_ok (sub {
+ my $sqlt_schema = create_schema ({
+ schema => $schema,
+ args => {
+ parser_args => {
+ sources => ['CD']
+ },
+ },
+ });
+
+ is_deeply (
+ [$sqlt_schema->get_tables ],
+ ['cd'],
+ 'sources limitng with relationships works',
+ );
+
+});
+
done_testing;
sub create_schema {
- my $args = shift;
+ my $args = shift;
- my $schema = $args->{schema};
- my $additional_sqltargs = $args->{args} || {};
+ my $schema = $args->{schema};
+ my $additional_sqltargs = $args->{args} || {};
- my $sqltargs = {
- add_drop_table => 1,
- ignore_constraint_names => 1,
- ignore_index_names => 1,
- %{$additional_sqltargs}
- };
+ my $sqltargs = {
+ add_drop_table => 1,
+ ignore_constraint_names => 1,
+ ignore_index_names => 1,
+ %{$additional_sqltargs}
+ };
- my $sqlt = SQL::Translator->new( $sqltargs );
+ my $sqlt = SQL::Translator->new( $sqltargs );
- $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
- return $sqlt->translate({ data => $schema }) or die $sqlt->error;
+ $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
+ return $sqlt->translate({ data => $schema }) || die $sqlt->error;
}
sub get_table {
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/bind/attribute.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/bind/attribute.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/bind/attribute.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -38,7 +38,7 @@
->search({ artistid => 1});
is ( $rs->count, 1, 'where/bind first' );
-
+
$rs = $schema->resultset('Artist')->search({ artistid => 1})
->search({}, $where_bind);
@@ -76,7 +76,7 @@
$rs = $schema->resultset('Complex')->search({}, { bind => [ 1999 ] })->search({}, { where => \"title LIKE ?", bind => [ 'Spoon%' ] });
is_same_sql_bind(
$rs->as_query,
- "(SELECT me.artistid, me.name, me.rank, me.charfield FROM (SELECT a.*, cd.cdid AS cdid, cd.title AS title, cd.year AS year FROM artist a JOIN cd ON cd.artist = a.artistid WHERE cd.year = ?) WHERE title LIKE ?)",
+ "(SELECT me.artistid, me.name, me.rank, me.charfield FROM (SELECT a.*, cd.cdid AS cdid, cd.title AS title, cd.year AS year FROM artist a JOIN cd ON cd.artist = a.artistid WHERE cd.year = ?) me WHERE title LIKE ?)",
[
[ '!!dummy' => '1999' ],
[ '!!dummy' => 'Spoon%' ]
@@ -105,7 +105,7 @@
$rs = $schema->resultset('CustomSql')->search({}, { bind => [ 1999 ] })->search({}, { where => \"title LIKE ?", bind => [ 'Spoon%' ] });
is_same_sql_bind(
$rs->as_query,
- "(SELECT me.artistid, me.name, me.rank, me.charfield FROM (SELECT a.*, cd.cdid AS cdid, cd.title AS title, cd.year AS year FROM artist a JOIN cd ON cd.artist = a.artistid WHERE cd.year = ?) WHERE title LIKE ?)",
+ "(SELECT me.artistid, me.name, me.rank, me.charfield FROM (SELECT a.*, cd.cdid AS cdid, cd.title AS title, cd.year AS year FROM artist a JOIN cd ON cd.artist = a.artistid WHERE cd.year = ?) me WHERE title LIKE ?)",
[
[ '!!dummy' => '1999' ],
[ '!!dummy' => 'Spoon%' ]
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/bind/bindtype_columns.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/bind/bindtype_columns.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/bind/bindtype_columns.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -9,7 +9,7 @@
plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test'
unless ($dsn && $dbuser);
-
+
plan tests => 6;
my $schema = DBICTest::Schema->connection($dsn, $dbuser, $dbpass, { AutoCommit => 1 });
@@ -32,7 +32,7 @@
],{ RaiseError => 1, PrintError => 1 });
}
-my $big_long_string = "\x00\x01\x02 abcd" x 125000;
+my $big_long_string = "\x00\x01\x02 abcd" x 125000;
my $new;
# test inserting a row
@@ -40,7 +40,7 @@
$new = $schema->resultset('BindType')->create({ bytea => $big_long_string });
ok($new->id, "Created a bytea row");
- is($new->bytea, $big_long_string, "Set the blob correctly.");
+ is($new->bytea, $big_long_string, "Set the blob correctly.");
}
# test retrieval of the bytea column
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/01-columns.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/01-columns.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/01-columns.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -24,15 +24,15 @@
#State->has_many(cities => "City");
sub accessor_name_for {
- my ($class, $column) = @_;
- my $return = $column eq "Rain" ? "Rainfall" : $column;
- return $return;
+ my ($class, $column) = @_;
+ my $return = $column eq "Rain" ? "Rainfall" : $column;
+ return $return;
}
sub mutator_name_for {
- my ($class, $column) = @_;
- my $return = $column eq "Rain" ? "set_Rainfall" : "set_$column";
- return $return;
+ my ($class, $column) = @_;
+ my $return = $column eq "Rain" ? "set_Rainfall" : "set_$column";
+ return $return;
}
sub Snowfall { 1 }
@@ -69,61 +69,61 @@
is(State->table, 'State', 'State table()');
is(State->primary_column, 'name', 'State primary()');
is_deeply [ State->columns('Primary') ] => [qw/name/],
- 'State Primary:' . join ", ", State->columns('Primary');
+ 'State Primary:' . join ", ", State->columns('Primary');
is_deeply [ sort State->columns('Essential') ] => [qw/abbreviation name/],
- 'State Essential:' . join ", ", State->columns('Essential');
+ 'State Essential:' . join ", ", State->columns('Essential');
is_deeply [ sort State->columns('All') ] =>
- [ sort qw/name abbreviation rain snowfall capital population/ ],
- 'State All:' . join ", ", State->columns('All');
+ [ sort qw/name abbreviation rain snowfall capital population/ ],
+ 'State All:' . join ", ", State->columns('All');
is(CD->primary_column, 'artist', 'CD primary()');
is_deeply [ CD->columns('Primary') ] => [qw/artist/],
- 'CD primary:' . join ", ", CD->columns('Primary');
+ 'CD primary:' . join ", ", CD->columns('Primary');
is_deeply [ sort CD->columns('All') ] => [qw/artist length title/],
- 'CD all:' . join ", ", CD->columns('All');
+ 'CD all:' . join ", ", CD->columns('All');
is_deeply [ sort CD->columns('Essential') ] => [qw/artist/],
- 'CD essential:' . join ", ", CD->columns('Essential');
+ 'CD essential:' . join ", ", CD->columns('Essential');
ok(State->find_column('Rain'), 'find_column Rain');
ok(State->find_column('rain'), 'find_column rain');
ok(!State->find_column('HGLAGAGlAG'), '!find_column HGLAGAGlAG');
{
-
+
can_ok +State => qw/Rainfall _Rainfall_accessor set_Rainfall
- _set_Rainfall_accessor Snowfall _Snowfall_accessor set_Snowfall
- _set_Snowfall_accessor/;
-
- foreach my $method (qw/Rain _Rain_accessor rain snowfall/) {
- ok !State->can($method), "State can't $method";
+ _set_Rainfall_accessor Snowfall _Snowfall_accessor set_Snowfall
+ _set_Snowfall_accessor/;
+
+ foreach my $method (qw/Rain _Rain_accessor rain snowfall/) {
+ ok !State->can($method), "State can't $method";
}
}
{
- SKIP: {
- skip "No column objects", 1;
+ SKIP: {
+ skip "No column objects", 1;
- eval { my @grps = State->__grouper->groups_for("Huh"); };
- ok $@, "Huh not in groups";
- }
+ eval { my @grps = State->__grouper->groups_for("Huh"); };
+ ok $@, "Huh not in groups";
+ }
- my @grps = sort State->__grouper->groups_for(State->_find_columns(qw/rain capital/));
- is @grps, 2, "Rain and Capital = 2 groups";
+ my @grps = sort State->__grouper->groups_for(State->_find_columns(qw/rain capital/));
+ is @grps, 2, "Rain and Capital = 2 groups";
@grps = sort @grps; # Because the underlying API is hash-based
- is $grps[0], 'Other', " - Other";
- is $grps[1], 'Weather', " - Weather";
+ is $grps[0], 'Other', " - Other";
+ is $grps[1], 'Weather', " - Weather";
}
#{
-#
+#
# package DieTest;
# @DieTest::ISA = qw(DBIx::Class);
# DieTest->load_components(qw/CDBICompat::Retrieve Core/);
# package main;
-# local $SIG{__WARN__} = sub { };
-# eval { DieTest->retrieve(1) };
-# like $@, qr/unless primary columns are defined/, "Need primary key for retrieve";
+# local $SIG{__WARN__} = sub { };
+# eval { DieTest->retrieve(1) };
+# like $@, qr/unless primary columns are defined/, "Need primary key for retrieve";
#}
#-----------------------------------------------------------------------
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/02-Film.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/02-Film.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/02-Film.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -12,28 +12,28 @@
}
INIT {
- use lib 't/cdbi/testlib';
- use Film;
+ use lib 't/cdbi/testlib';
+ use Film;
}
ok(Film->can('db_Main'), 'set_db()');
is(Film->__driver, "SQLite", "Driver set correctly");
{
- my $nul = eval { Film->retrieve() };
- is $nul, undef, "Can't retrieve nothing";
- like $@, qr/./, "retrieve needs parameters"; # TODO fix this...
+ my $nul = eval { Film->retrieve() };
+ is $nul, undef, "Can't retrieve nothing";
+ like $@, qr/./, "retrieve needs parameters"; # TODO fix this...
}
{
- eval { my $id = Film->id };
- like $@, qr/class method/, "Can't get id with no object";
+ eval { my $id = Film->id };
+ like $@, qr/class method/, "Can't get id with no object";
}
{
- eval { my $id = Film->title };
- #like $@, qr/class method/, "Can't get title with no object";
- ok $@, "Can't get title with no object";
+ eval { my $id = Film->title };
+ #like $@, qr/class method/, "Can't get title with no object";
+ ok $@, "Can't get title with no object";
}
eval { my $duh = Film->insert; };
@@ -49,24 +49,24 @@
is($btaste->NumExplodingSheep, 1, 'NumExplodingSheep() get');
{
- my $bt2 = Film->find_or_create(Title => 'Bad Taste');
- is $bt2->Director, $btaste->Director, "find_or_create";
- my @bt = Film->search(Title => 'Bad Taste');
- is @bt, 1, " doesn't create a new one";
+ my $bt2 = Film->find_or_create(Title => 'Bad Taste');
+ is $bt2->Director, $btaste->Director, "find_or_create";
+ my @bt = Film->search(Title => 'Bad Taste');
+ is @bt, 1, " doesn't create a new one";
}
ok my $gone = Film->find_or_create(
- {
- Title => 'Gone With The Wind',
- Director => 'Bob Baggadonuts',
- Rating => 'PG',
- NumExplodingSheep => 0
- }
- ),
- "Add Gone With The Wind";
+ {
+ Title => 'Gone With The Wind',
+ Director => 'Bob Baggadonuts',
+ Rating => 'PG',
+ NumExplodingSheep => 0
+ }
+ ),
+ "Add Gone With The Wind";
isa_ok $gone, 'Film';
ok $gone = Film->retrieve(Title => 'Gone With The Wind'),
- "Fetch it back again";
+ "Fetch it back again";
isa_ok $gone, 'Film';
# Shocking new footage found reveals bizarre Scarlet/sheep scene!
@@ -81,8 +81,8 @@
$gone->update;
{
- my @films = eval { Film->retrieve_all };
- cmp_ok(@films, '==', 2, "We have 2 films in total");
+ my @films = eval { Film->retrieve_all };
+ cmp_ok(@films, '==', 2, "We have 2 films in total");
}
# EXTRA TEST: added by mst to check a bug found by Numa
@@ -94,11 +94,11 @@
# Grab the 'Bladerunner' entry.
Film->create(
- {
- Title => 'Bladerunner',
- Director => 'Bob Ridley Scott',
- Rating => 'R'
- }
+ {
+ Title => 'Bladerunner',
+ Director => 'Bob Ridley Scott',
+ Rating => 'R'
+ }
);
my $blrunner = Film->retrieve('Bladerunner');
@@ -110,10 +110,10 @@
# Make a copy of 'Bladerunner' and create an entry of the directors cut
my $blrunner_dc = $blrunner->copy(
- {
- title => "Bladerunner: Director's Cut",
- rating => "15",
- }
+ {
+ title => "Bladerunner: Director's Cut",
+ rating => "15",
+ }
);
is(ref $blrunner_dc, 'Film', "copy() produces a film");
is($blrunner_dc->Title, "Bladerunner: Director's Cut", 'Title correct');
@@ -123,78 +123,78 @@
# Set up own SQL:
{
- Film->add_constructor(title_asc => "title LIKE ? ORDER BY title");
- Film->add_constructor(title_desc => "title LIKE ? ORDER BY title DESC");
+ Film->add_constructor(title_asc => "title LIKE ? ORDER BY title");
+ Film->add_constructor(title_desc => "title LIKE ? ORDER BY title DESC");
Film->add_constructor(title_asc_nl => q{
title LIKE ?
ORDER BY title
LIMIT 1
});
- {
- my @films = Film->title_asc("Bladerunner%");
- is @films, 2, "We have 2 Bladerunners";
- is $films[0]->Title, $blrunner->Title, "Ordered correctly";
- }
- {
- my @films = Film->title_desc("Bladerunner%");
- is @films, 2, "We have 2 Bladerunners";
- is $films[0]->Title, $blrunner_dc->Title, "Ordered correctly";
- }
- {
- my @films = Film->title_asc_nl("Bladerunner%");
- is @films, 1, "We have 2 Bladerunners";
- is $films[0]->Title, $blrunner->Title, "Ordered correctly";
- }
+ {
+ my @films = Film->title_asc("Bladerunner%");
+ is @films, 2, "We have 2 Bladerunners";
+ is $films[0]->Title, $blrunner->Title, "Ordered correctly";
+ }
+ {
+ my @films = Film->title_desc("Bladerunner%");
+ is @films, 2, "We have 2 Bladerunners";
+ is $films[0]->Title, $blrunner_dc->Title, "Ordered correctly";
+ }
+ {
+ my @films = Film->title_asc_nl("Bladerunner%");
+ is @films, 1, "We have 2 Bladerunners";
+ is $films[0]->Title, $blrunner->Title, "Ordered correctly";
+ }
}
# Multi-column search
{
- my @films = $blrunner->search (title => { -like => "Bladerunner%"}, rating => '15');
- is @films, 1, "Only one Bladerunner is a 15";
+ my @films = $blrunner->search (title => { -like => "Bladerunner%"}, rating => '15');
+ is @films, 1, "Only one Bladerunner is a 15";
}
# Inline SQL
{
- my @films = Film->retrieve_from_sql("numexplodingsheep > 0 ORDER BY title");
- is @films, 2, "Inline SQL";
- is $films[0]->id, $btaste->id, "Correct film";
- is $films[1]->id, $gone->id, "Correct film";
+ my @films = Film->retrieve_from_sql("numexplodingsheep > 0 ORDER BY title");
+ is @films, 2, "Inline SQL";
+ is $films[0]->id, $btaste->id, "Correct film";
+ is $films[1]->id, $gone->id, "Correct film";
}
# Inline SQL removes WHERE
{
- my @films =
- Film->retrieve_from_sql(" WHErE numexplodingsheep > 0 ORDER BY title");
- is @films, 2, "Inline SQL";
- is $films[0]->id, $btaste->id, "Correct film";
- is $films[1]->id, $gone->id, "Correct film";
+ my @films =
+ Film->retrieve_from_sql(" WHErE numexplodingsheep > 0 ORDER BY title");
+ is @films, 2, "Inline SQL";
+ is $films[0]->id, $btaste->id, "Correct film";
+ is $films[1]->id, $gone->id, "Correct film";
}
eval {
- my $ishtar = Film->insert({ Title => 'Ishtar', Director => 'Elaine May' });
- my $mandn =
- Film->insert({ Title => 'Mikey and Nicky', Director => 'Elaine May' });
- my $new_leaf =
- Film->insert({ Title => 'A New Leaf', Director => 'Elaine May' });
+ my $ishtar = Film->insert({ Title => 'Ishtar', Director => 'Elaine May' });
+ my $mandn =
+ Film->insert({ Title => 'Mikey and Nicky', Director => 'Elaine May' });
+ my $new_leaf =
+ Film->insert({ Title => 'A New Leaf', Director => 'Elaine May' });
#use Data::Dumper; die Dumper(Film->search( Director => 'Elaine May' ));
- cmp_ok(Film->search(Director => 'Elaine May'), '==', 3,
- "3 Films by Elaine May");
- ok(Film->retrieve('Ishtar')->delete,
- "Ishtar doesn't deserve an entry any more");
- ok(!Film->retrieve('Ishtar'), 'Ishtar no longer there');
- {
- my $deprecated = 0;
- local $SIG{__WARN__} = sub { $deprecated++ if $_[0] =~ /deprecated/ };
- ok(
- Film->delete(Director => 'Elaine May'),
- "In fact, delete all films by Elaine May"
- );
- cmp_ok(Film->search(Director => 'Elaine May'), '==',
- 0, "0 Films by Elaine May");
- is $deprecated, 0, "No deprecated warnings from compat layer";
- }
+ cmp_ok(Film->search(Director => 'Elaine May'), '==', 3,
+ "3 Films by Elaine May");
+ ok(Film->retrieve('Ishtar')->delete,
+ "Ishtar doesn't deserve an entry any more");
+ ok(!Film->retrieve('Ishtar'), 'Ishtar no longer there');
+ {
+ my $deprecated = 0;
+ local $SIG{__WARN__} = sub { $deprecated++ if $_[0] =~ /deprecated/ };
+ ok(
+ Film->delete(Director => 'Elaine May'),
+ "In fact, delete all films by Elaine May"
+ );
+ cmp_ok(Film->search(Director => 'Elaine May'), '==',
+ 0, "0 Films by Elaine May");
+ is $deprecated, 0, "No deprecated warnings from compat layer";
+ }
};
is $@, '', "No problems with deletes";
@@ -207,23 +207,23 @@
@films = Film->search ( { 'Director' => { -like => 'Bob %' } });
is(scalar @films, 3, ' search_like returns 3 films');
ok(
- eq_array(
- [ sort map { $_->id } @films ],
- [ sort map { $_->id } $blrunner_dc, $gone, $blrunner ]
- ),
- 'the correct ones'
+ eq_array(
+ [ sort map { $_->id } @films ],
+ [ sort map { $_->id } $blrunner_dc, $gone, $blrunner ]
+ ),
+ 'the correct ones'
);
# Find Ridley Scott films which don't have vomit
@films =
- Film->search(numExplodingSheep => undef, Director => 'Bob Ridley Scott');
+ Film->search(numExplodingSheep => undef, Director => 'Bob Ridley Scott');
is(scalar @films, 2, ' search where attribute is null returns 2 films');
ok(
- eq_array(
- [ sort map { $_->id } @films ],
- [ sort map { $_->id } $blrunner_dc, $blrunner ]
- ),
- 'the correct ones'
+ eq_array(
+ [ sort map { $_->id } @films ],
+ [ sort map { $_->id } $blrunner_dc, $blrunner ]
+ ),
+ 'the correct ones'
);
# Test that a disconnect doesnt harm anything.
@@ -248,166 +248,166 @@
}
SKIP: {
- skip "ActiveState perl produces additional warnings", 3
+ skip "ActiveState perl produces additional warnings", 3
if ($^O eq 'MSWin32');
- Film->autoupdate(1);
- my $btaste2 = Film->retrieve($btaste->id);
- $btaste->NumExplodingSheep(18);
- my @warnings;
- local $SIG{__WARN__} = sub { push(@warnings, @_); };
- {
+ Film->autoupdate(1);
+ my $btaste2 = Film->retrieve($btaste->id);
+ $btaste->NumExplodingSheep(18);
+ my @warnings;
+ local $SIG{__WARN__} = sub { push(@warnings, @_); };
+ {
- # unhook from live object cache, so next one is not from cache
- $btaste2->remove_from_object_index;
- my $btaste3 = Film->retrieve($btaste->id);
- is $btaste3->NumExplodingSheep, 18, "Class based AutoCommit";
- $btaste3->autoupdate(0); # obj a/c should override class a/c
- is @warnings, 0, "No warnings so far";
- $btaste3->NumExplodingSheep(13);
- }
- is @warnings, 1, "DESTROY without update warns";
- Film->autoupdate(0);
+ # unhook from live object cache, so next one is not from cache
+ $btaste2->remove_from_object_index;
+ my $btaste3 = Film->retrieve($btaste->id);
+ is $btaste3->NumExplodingSheep, 18, "Class based AutoCommit";
+ $btaste3->autoupdate(0); # obj a/c should override class a/c
+ is @warnings, 0, "No warnings so far";
+ $btaste3->NumExplodingSheep(13);
+ }
+ is @warnings, 1, "DESTROY without update warns";
+ Film->autoupdate(0);
}
{ # update unchanged object
- my $film = Film->retrieve($btaste->id);
- my $retval = $film->update;
- is $retval, -1, "Unchanged object";
+ my $film = Film->retrieve($btaste->id);
+ my $retval = $film->update;
+ is $retval, -1, "Unchanged object";
}
{ # update deleted object
- my $rt = "Royal Tenenbaums";
- my $ten = Film->insert({ title => $rt, Rating => "R" });
- $ten->rating(18);
- Film->set_sql(drt => "DELETE FROM __TABLE__ WHERE title = ?");
- Film->sql_drt->execute($rt);
- my @films = Film->search({ title => $rt });
- is @films, 0, "RT gone";
- my $retval = eval { $ten->update };
- like $@, qr/row not found/, "Update deleted object throws error";
- $ten->discard_changes;
+ my $rt = "Royal Tenenbaums";
+ my $ten = Film->insert({ title => $rt, Rating => "R" });
+ $ten->rating(18);
+ Film->set_sql(drt => "DELETE FROM __TABLE__ WHERE title = ?");
+ Film->sql_drt->execute($rt);
+ my @films = Film->search({ title => $rt });
+ is @films, 0, "RT gone";
+ my $retval = eval { $ten->update };
+ like $@, qr/row not found/, "Update deleted object throws error";
+ $ten->discard_changes;
}
{
- $btaste->autoupdate(1);
- $btaste->NumExplodingSheep(32);
- my $btaste2 = Film->retrieve($btaste->id);
- is $btaste2->NumExplodingSheep, 32, "Object based AutoCommit";
- $btaste->autoupdate(0);
+ $btaste->autoupdate(1);
+ $btaste->NumExplodingSheep(32);
+ my $btaste2 = Film->retrieve($btaste->id);
+ is $btaste2->NumExplodingSheep, 32, "Object based AutoCommit";
+ $btaste->autoupdate(0);
}
# Primary key of 0
{
- my $zero = Film->insert({ Title => 0, Rating => "U" });
- ok defined $zero, "Create 0";
- ok my $ret = Film->retrieve(0), "Retrieve 0";
- is $ret->Title, 0, "Title OK";
- is $ret->Rating, "U", "Rating OK";
+ my $zero = Film->insert({ Title => 0, Rating => "U" });
+ ok defined $zero, "Create 0";
+ ok my $ret = Film->retrieve(0), "Retrieve 0";
+ is $ret->Title, 0, "Title OK";
+ is $ret->Rating, "U", "Rating OK";
}
# Change after_update policy
SKIP: {
skip "DBIx::Class compat doesn't handle the exists stuff quite right yet", 4;
- my $bt = Film->retrieve($btaste->id);
- $bt->autoupdate(1);
+ my $bt = Film->retrieve($btaste->id);
+ $bt->autoupdate(1);
- $bt->rating("17");
- ok !$bt->_attribute_exists('rating'), "changed column needs reloaded";
- ok $bt->_attribute_exists('title'), "but we still have the title";
+ $bt->rating("17");
+ ok !$bt->_attribute_exists('rating'), "changed column needs reloaded";
+ ok $bt->_attribute_exists('title'), "but we still have the title";
- # Don't re-load
- $bt->add_trigger(
- after_update => sub {
- my ($self, %args) = @_;
- my $discard_columns = $args{discard_columns};
- @$discard_columns = qw/title/;
- }
- );
- $bt->rating("19");
- ok $bt->_attribute_exists('rating'), "changed column needs reloaded";
- ok !$bt->_attribute_exists('title'), "but no longer have the title";
+ # Don't re-load
+ $bt->add_trigger(
+ after_update => sub {
+ my ($self, %args) = @_;
+ my $discard_columns = $args{discard_columns};
+ @$discard_columns = qw/title/;
+ }
+ );
+ $bt->rating("19");
+ ok $bt->_attribute_exists('rating'), "changed column needs reloaded";
+ ok !$bt->_attribute_exists('title'), "but no longer have the title";
}
# Make sure that we can have other accessors. (Bugfix in 0.28)
if (0) {
- Film->mk_accessors(qw/temp1 temp2/);
- my $blrunner = Film->retrieve('Bladerunner');
- $blrunner->temp1("Foo");
- $blrunner->NumExplodingSheep(2);
- eval { $blrunner->update };
- ok(!$@, "Other accessors");
+ Film->mk_accessors(qw/temp1 temp2/);
+ my $blrunner = Film->retrieve('Bladerunner');
+ $blrunner->temp1("Foo");
+ $blrunner->NumExplodingSheep(2);
+ eval { $blrunner->update };
+ ok(!$@, "Other accessors");
}
# overloading
{
- is "$blrunner", "Bladerunner", "stringify";
+ is "$blrunner", "Bladerunner", "stringify";
- ok(Film->columns(Stringify => 'rating'), "Can change stringify column");
- is "$blrunner", "R", "And still stringifies correctly";
+ ok(Film->columns(Stringify => 'rating'), "Can change stringify column");
+ is "$blrunner", "R", "And still stringifies correctly";
- ok(
- Film->columns(Stringify => qw/title rating/),
- "Can have multiple stringify columns"
- );
- is "$blrunner", "Bladerunner/R", "And still stringifies correctly";
+ ok(
+ Film->columns(Stringify => qw/title rating/),
+ "Can have multiple stringify columns"
+ );
+ is "$blrunner", "Bladerunner/R", "And still stringifies correctly";
- no warnings 'once';
- local *Film::stringify_self = sub { join ":", $_[0]->title, $_[0]->rating };
- is "$blrunner", "Bladerunner:R", "Provide stringify_self()";
+ no warnings 'once';
+ local *Film::stringify_self = sub { join ":", $_[0]->title, $_[0]->rating };
+ is "$blrunner", "Bladerunner:R", "Provide stringify_self()";
}
{
- {
- ok my $byebye = DeletingFilm->insert(
- {
- Title => 'Goodbye Norma Jean',
- Rating => 'PG',
- }
- ),
- "Add a deleting Film";
+ {
+ ok my $byebye = DeletingFilm->insert(
+ {
+ Title => 'Goodbye Norma Jean',
+ Rating => 'PG',
+ }
+ ),
+ "Add a deleting Film";
- isa_ok $byebye, 'DeletingFilm';
- isa_ok $byebye, 'Film';
- ok(Film->retrieve('Goodbye Norma Jean'), "Fetch it back again");
- }
- my $film;
- eval { $film = Film->retrieve('Goodbye Norma Jean') };
- ok !$film, "It destroys itself";
+ isa_ok $byebye, 'DeletingFilm';
+ isa_ok $byebye, 'Film';
+ ok(Film->retrieve('Goodbye Norma Jean'), "Fetch it back again");
+ }
+ my $film;
+ eval { $film = Film->retrieve('Goodbye Norma Jean') };
+ ok !$film, "It destroys itself";
}
SKIP: {
skip "Caching has been removed", 5
if Film->isa("DBIx::Class::CDBICompat::NoObjectIndex");
- # my bad taste is your bad taste
- my $btaste = Film->retrieve('Bad Taste');
- my $btaste2 = Film->retrieve('Bad Taste');
- is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste2),
- "Retrieving twice gives ref to same object";
+ # my bad taste is your bad taste
+ my $btaste = Film->retrieve('Bad Taste');
+ my $btaste2 = Film->retrieve('Bad Taste');
+ is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste2),
+ "Retrieving twice gives ref to same object";
- my ($btaste5) = Film->search(title=>'Bad Taste');
- is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste5),
- "Searching also gives ref to same object";
+ my ($btaste5) = Film->search(title=>'Bad Taste');
+ is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste5),
+ "Searching also gives ref to same object";
- $btaste2->remove_from_object_index;
- my $btaste3 = Film->retrieve('Bad Taste');
- isnt Scalar::Util::refaddr($btaste2), Scalar::Util::refaddr($btaste3),
- "Removing from object_index and retrieving again gives new object";
+ $btaste2->remove_from_object_index;
+ my $btaste3 = Film->retrieve('Bad Taste');
+ isnt Scalar::Util::refaddr($btaste2), Scalar::Util::refaddr($btaste3),
+ "Removing from object_index and retrieving again gives new object";
- $btaste3->clear_object_index;
- my $btaste4 = Film->retrieve('Bad Taste');
- isnt Scalar::Util::refaddr($btaste2), Scalar::Util::refaddr($btaste4),
- "Clearing cache and retrieving again gives new object";
+ $btaste3->clear_object_index;
+ my $btaste4 = Film->retrieve('Bad Taste');
+ isnt Scalar::Util::refaddr($btaste2), Scalar::Util::refaddr($btaste4),
+ "Clearing cache and retrieving again gives new object";
$btaste=Film->insert({
- Title => 'Bad Taste 2',
- Director => 'Peter Jackson',
- Rating => 'R',
- NumExplodingSheep => 2,
- });
- $btaste2 = Film->retrieve('Bad Taste 2');
- is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste2),
- "Creating and retrieving gives ref to same object";
+ Title => 'Bad Taste 2',
+ Director => 'Peter Jackson',
+ Rating => 'R',
+ NumExplodingSheep => 2,
+ });
+ $btaste2 = Film->retrieve('Bad Taste 2');
+ is Scalar::Util::refaddr($btaste), Scalar::Util::refaddr($btaste2),
+ "Creating and retrieving gives ref to same object";
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/03-subclassing.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/03-subclassing.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/03-subclassing.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -22,7 +22,7 @@
ok(Film::Threat->db_Main->ping, 'subclass db_Main()');
is_deeply [ sort Film::Threat->columns ], [ sort Film->columns ],
- 'has the same columns';
+ 'has the same columns';
my $bt = Film->create_test_film;
ok my $btaste = Film::Threat->retrieve('Bad Taste'), "subclass retrieve";
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/04-lazy.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/04-lazy.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/04-lazy.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -17,8 +17,8 @@
}
INIT {
- use lib 't/cdbi/testlib';
- use Lazy;
+ use lib 't/cdbi/testlib';
+ use Lazy;
}
is_deeply [ Lazy->columns('Primary') ], [qw/this/], "Pri";
@@ -29,13 +29,13 @@
is_deeply [ sort Lazy->columns('All') ], [qw/eep oop opop orp that this/], "All";
{
- my @groups = Lazy->__grouper->groups_for(Lazy->find_column('this'));
- is_deeply [ sort @groups ], [sort qw/things Essential Primary/], "this (@groups)";
+ my @groups = Lazy->__grouper->groups_for(Lazy->find_column('this'));
+ is_deeply [ sort @groups ], [sort qw/things Essential Primary/], "this (@groups)";
}
{
- my @groups = Lazy->__grouper->groups_for(Lazy->find_column('that'));
- is_deeply \@groups, [qw/things/], "that (@groups)";
+ my @groups = Lazy->__grouper->groups_for(Lazy->find_column('that'));
+ is_deeply \@groups, [qw/things/], "that (@groups)";
}
Lazy->create({ this => 1, that => 2, oop => 3, opop => 4, eep => 5 });
@@ -54,28 +54,28 @@
ok(!$obj->_attribute_exists('that'), 'nor that');
{
- Lazy->columns(All => qw/this that eep orp oop opop/);
- ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary');
- ok !$obj->_attribute_exists('oop'), " Don't have oop";
- my $null = $obj->eep;
- ok !$obj->_attribute_exists('oop'),
- " Don't have oop - even after getting eep";
+ Lazy->columns(All => qw/this that eep orp oop opop/);
+ ok(my $obj = Lazy->retrieve(1), 'Retrieve by Primary');
+ ok !$obj->_attribute_exists('oop'), " Don't have oop";
+ my $null = $obj->eep;
+ ok !$obj->_attribute_exists('oop'),
+ " Don't have oop - even after getting eep";
}
# Test contructor breaking.
eval { # Need a hashref
- Lazy->create(this => 10, that => 20, oop => 30, opop => 40, eep => 50);
+ Lazy->create(this => 10, that => 20, oop => 30, opop => 40, eep => 50);
};
ok($@, $@);
eval { # False column
- Lazy->create({ this => 10, that => 20, theother => 30 });
+ Lazy->create({ this => 10, that => 20, theother => 30 });
};
ok($@, $@);
eval { # Multiple false columns
- Lazy->create({ this => 10, that => 20, theother => 30, andanother => 40 });
+ Lazy->create({ this => 10, that => 20, theother => 30, andanother => 40 });
};
ok($@, $@);
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/06-hasa.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/06-hasa.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/06-hasa.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -16,9 +16,9 @@
#local $SIG{__WARN__} = sub { };
INIT {
- use lib 't/cdbi/testlib';
- use Film;
- use Director;
+ use lib 't/cdbi/testlib';
+ use Film;
+ use Director;
}
Film->create_test_film;
@@ -28,14 +28,14 @@
ok(Film->has_a('Director' => 'Director'), "Link Director table");
ok(
- Director->create(
- {
- Name => 'Peter Jackson',
- Birthday => -300000000,
- IsInsane => 1
- }
- ),
- 'create Director'
+ Director->create(
+ {
+ Name => 'Peter Jackson',
+ Birthday => -300000000,
+ IsInsane => 1
+ }
+ ),
+ 'create Director'
);
$btaste = Film->retrieve('Bad Taste');
@@ -46,11 +46,11 @@
# Oh no! Its Peter Jacksons even twin, Skippy! Born one minute after him.
my $sj = Director->create(
- {
- Name => 'Skippy Jackson',
- Birthday => (-300000000 + 60),
- IsInsane => 1,
- }
+ {
+ Name => 'Skippy Jackson',
+ Birthday => (-300000000 + 60),
+ IsInsane => 1,
+ }
);
is($sj->id, 'Skippy Jackson', 'We have a new director');
@@ -61,71 +61,71 @@
$btaste->update;
is($btaste->CoDirector->Name, 'Skippy Jackson', 'He co-directed');
is(
- $btaste->Director->Name,
- 'Peter Jackson',
- "Didnt interfere with each other"
+ $btaste->Director->Name,
+ 'Peter Jackson',
+ "Didnt interfere with each other"
);
{ # Ensure search can take an object
- my @films = Film->search(Director => $pj);
- is @films, 1, "1 Film directed by $pj";
- is $films[0]->id, "Bad Taste", "Bad Taste";
+ my @films = Film->search(Director => $pj);
+ is @films, 1, "1 Film directed by $pj";
+ is $films[0]->id, "Bad Taste", "Bad Taste";
}
inheriting_hasa();
{
- # Skippy directs a film and Peter helps!
- $sj = Director->retrieve('Skippy Jackson');
- $pj = Director->retrieve('Peter Jackson');
+ # Skippy directs a film and Peter helps!
+ $sj = Director->retrieve('Skippy Jackson');
+ $pj = Director->retrieve('Peter Jackson');
- fail_with_bad_object($sj, $btaste);
- taste_bad($sj, $pj);
+ fail_with_bad_object($sj, $btaste);
+ taste_bad($sj, $pj);
}
sub inheriting_hasa {
- my $btaste = YA::Film->retrieve('Bad Taste');
- is(ref($btaste->Director), 'Director', 'inheriting has_a()');
- is(ref($btaste->CoDirector), 'Director', 'inheriting has_a()');
- is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly');
+ my $btaste = YA::Film->retrieve('Bad Taste');
+ is(ref($btaste->Director), 'Director', 'inheriting has_a()');
+ is(ref($btaste->CoDirector), 'Director', 'inheriting has_a()');
+ is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly');
}
sub taste_bad {
- my ($dir, $codir) = @_;
- my $tastes_bad = YA::Film->create(
- {
- Title => 'Tastes Bad',
- Director => $dir,
- CoDirector => $codir,
- Rating => 'R',
- NumExplodingSheep => 23
- }
- );
- is($tastes_bad->_Director_accessor, 'Skippy Jackson', 'Director_accessor');
- is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director');
- is($tastes_bad->CoDirector->Name, 'Peter Jackson', 'CoDirector');
- is(
- $tastes_bad->_CoDirector_accessor,
- 'Peter Jackson',
- 'CoDirector_accessor'
- );
+ my ($dir, $codir) = @_;
+ my $tastes_bad = YA::Film->create(
+ {
+ Title => 'Tastes Bad',
+ Director => $dir,
+ CoDirector => $codir,
+ Rating => 'R',
+ NumExplodingSheep => 23
+ }
+ );
+ is($tastes_bad->_Director_accessor, 'Skippy Jackson', 'Director_accessor');
+ is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director');
+ is($tastes_bad->CoDirector->Name, 'Peter Jackson', 'CoDirector');
+ is(
+ $tastes_bad->_CoDirector_accessor,
+ 'Peter Jackson',
+ 'CoDirector_accessor'
+ );
}
sub fail_with_bad_object {
- my ($dir, $codir) = @_;
- eval {
- YA::Film->create(
- {
- Title => 'Tastes Bad',
- Director => $dir,
- CoDirector => $codir,
- Rating => 'R',
- NumExplodingSheep => 23
- }
- );
- };
- ok $@, $@;
+ my ($dir, $codir) = @_;
+ eval {
+ YA::Film->create(
+ {
+ Title => 'Tastes Bad',
+ Director => $dir,
+ CoDirector => $codir,
+ Rating => 'R',
+ NumExplodingSheep => 23
+ }
+ );
+ };
+ ok $@, $@;
}
package Foo;
@@ -135,8 +135,8 @@
# fav is a film
__PACKAGE__->db_Main->do( qq{
CREATE TABLE foo (
- id INTEGER,
- fav VARCHAR(255)
+ id INTEGER,
+ fav VARCHAR(255)
)
});
@@ -148,8 +148,8 @@
# fav is a foo
__PACKAGE__->db_Main->do( qq{
CREATE TABLE bar (
- id INTEGER,
- fav INTEGER
+ id INTEGER,
+ fav INTEGER
)
});
@@ -162,9 +162,9 @@
isa_ok($foo->fav, "Film");
{
- my $foo;
- Foo->add_trigger(after_create => sub { $foo = shift->fav });
- my $gwh = Foo->create({ id => 93, fav => 'Good Will Hunting' });
- isa_ok $foo, "Film", "Object in after_create trigger";
+ my $foo;
+ Foo->add_trigger(after_create => sub { $foo = shift->fav });
+ my $gwh = Foo->create({ id => 93, fav => 'Good Will Hunting' });
+ isa_ok $foo, "Film", "Object in after_create trigger";
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/09-has_many.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/09-has_many.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/09-has_many.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -25,14 +25,14 @@
ok(my $btaste = Film->retrieve('Bad Taste'), "We have Bad Taste");
ok(
- my $pvj = Actor->create(
- {
- Name => 'Peter Vere-Jones',
- Film => undef,
- Salary => '30_000', # For a voice!
- }
- ),
- 'create Actor'
+ my $pvj = Actor->create(
+ {
+ Name => 'Peter Vere-Jones',
+ Film => undef,
+ Salary => '30_000', # For a voice!
+ }
+ ),
+ 'create Actor'
);
is $pvj->Name, "Peter Vere-Jones", "PVJ name ok";
is $pvj->Film, undef, "No film";
@@ -40,14 +40,14 @@
$pvj->update;
is $pvj->Film->id, $btaste->id, "Now film";
{
- my @actors = $btaste->actors;
- is(@actors, 1, "Bad taste has one actor");
- is($actors[0]->Name, $pvj->Name, " - the correct one");
+ my @actors = $btaste->actors;
+ is(@actors, 1, "Bad taste has one actor");
+ is($actors[0]->Name, $pvj->Name, " - the correct one");
}
my %pj_data = (
- Name => 'Peter Jackson',
- Salary => '0', # it's a labour of love
+ Name => 'Peter Jackson',
+ Salary => '0', # it's a labour of love
);
eval { my $pj = Film->add_to_actors(\%pj_data) };
@@ -57,37 +57,37 @@
like $@, qr/needs/, "add_to_actors takes hash";
ok(
- my $pj = $btaste->add_to_actors(
- {
- Name => 'Peter Jackson',
- Salary => '0', # it's a labour of love
- }
- ),
- 'add_to_actors'
+ my $pj = $btaste->add_to_actors(
+ {
+ Name => 'Peter Jackson',
+ Salary => '0', # it's a labour of love
+ }
+ ),
+ 'add_to_actors'
);
is $pj->Name, "Peter Jackson", "PJ ok";
is $pvj->Name, "Peter Vere-Jones", "PVJ still ok";
{
- my @actors = $btaste->actors;
- is @actors, 2, " - so now we have 2";
- is $actors[0]->Name, $pj->Name, "PJ first";
- is $actors[1]->Name, $pvj->Name, "PVJ first";
+ my @actors = $btaste->actors;
+ is @actors, 2, " - so now we have 2";
+ is $actors[0]->Name, $pj->Name, "PJ first";
+ is $actors[1]->Name, $pvj->Name, "PVJ first";
}
eval {
- my @actors = $btaste->actors(Name => $pj->Name);
- is @actors, 1, "One actor from restricted (sorted) has_many";
- is $actors[0]->Name, $pj->Name, "It's PJ";
+ my @actors = $btaste->actors(Name => $pj->Name);
+ is @actors, 1, "One actor from restricted (sorted) has_many";
+ is $actors[0]->Name, $pj->Name, "It's PJ";
};
is $@, '', "No errors";
my $as = Actor->create(
- {
- Name => 'Arnold Schwarzenegger',
- Film => 'Terminator 2',
- Salary => '15_000_000'
- }
+ {
+ Name => 'Arnold Schwarzenegger',
+ Film => 'Terminator 2',
+ Salary => '15_000_000'
+ }
);
eval { $btaste->actors($pj, $pvj, $as) };
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/11-triggers.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/11-triggers.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/11-triggers.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -18,8 +18,8 @@
sub delete_trigger { ::ok(1, "Deleting " . shift->Title) }
sub pre_up_trigger {
- $_[0]->_attribute_set(numexplodingsheep => 1);
- ::ok(1, "Running pre-update trigger");
+ $_[0]->_attribute_set(numexplodingsheep => 1);
+ ::ok(1, "Running pre-update trigger");
}
sub pst_up_trigger { ::ok(1, "Running post-update trigger"); }
@@ -32,15 +32,15 @@
Film->add_trigger(after_update => \&pst_up_trigger);
ok(
- my $ver = Film->create({
- title => 'La Double Vie De Veronique',
- director => 'Kryzstof Kieslowski',
+ my $ver = Film->create({
+ title => 'La Double Vie De Veronique',
+ director => 'Kryzstof Kieslowski',
- # rating => '15',
- numexplodingsheep => 0,
- }
- ),
- "Create Veronique"
+ # rating => '15',
+ numexplodingsheep => 0,
+ }
+ ),
+ "Create Veronique"
);
is $ver->Rating, 15, "Default rating";
@@ -48,19 +48,19 @@
ok $ver->Rating('12') && $ver->update, "Change the rating";
is $ver->NumExplodingSheep, 1, "Updated object's sheep count";
is + (
- $ver->db_Main->selectall_arrayref(
- 'SELECT numexplodingsheep FROM '
- . $ver->table
- . ' WHERE '
- . $ver->primary_column . ' = '
- . $ver->db_Main->quote($ver->id))
+ $ver->db_Main->selectall_arrayref(
+ 'SELECT numexplodingsheep FROM '
+ . $ver->table
+ . ' WHERE '
+ . $ver->primary_column . ' = '
+ . $ver->db_Main->quote($ver->id))
)->[0]->[0], 1, "Updated database's sheep count";
ok $ver->delete, "Delete";
{
- Film->add_trigger(before_create => sub {
- my $self = shift;
- ok !$self->_attribute_exists('title'), "PK doesn't auto-vivify";
- });
- Film->create({director => "Me"});
+ Film->add_trigger(before_create => sub {
+ my $self = shift;
+ ok !$self->_attribute_exists('title'), "PK doesn't auto-vivify";
+ });
+ Film->create({director => "Me"});
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/12-filter.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/12-filter.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/12-filter.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -22,76 +22,76 @@
my $film2 = Film->create({ Title => 'Another Film' });
my @act = (
- Actor->create(
- {
- name => 'Actor 1',
- film => $film,
- salary => 10,
- }
- ),
- Actor->create(
- {
- name => 'Actor 2',
- film => $film,
- salary => 20,
- }
- ),
- Actor->create(
- {
- name => 'Actor 3',
- film => $film,
- salary => 30,
- }
- ),
- Actor->create(
- {
- name => 'Actor 4',
- film => $film2,
- salary => 50,
- }
- ),
+ Actor->create(
+ {
+ name => 'Actor 1',
+ film => $film,
+ salary => 10,
+ }
+ ),
+ Actor->create(
+ {
+ name => 'Actor 2',
+ film => $film,
+ salary => 20,
+ }
+ ),
+ Actor->create(
+ {
+ name => 'Actor 3',
+ film => $film,
+ salary => 30,
+ }
+ ),
+ Actor->create(
+ {
+ name => 'Actor 4',
+ film => $film2,
+ salary => 50,
+ }
+ ),
);
eval {
- my @actors = $film->actors(name => 'Actor 1');
- is @actors, 1, "Got one actor from restricted has_many";
- is $actors[0]->name, "Actor 1", "Correct name";
+ my @actors = $film->actors(name => 'Actor 1');
+ is @actors, 1, "Got one actor from restricted has_many";
+ is $actors[0]->name, "Actor 1", "Correct name";
};
is $@, '', "No errors";
{
- my @actors = Actor->double_search("Actor 1", 10);
- is @actors, 1, "Got one actor";
- is $actors[0]->name, "Actor 1", "Correct name";
+ my @actors = Actor->double_search("Actor 1", 10);
+ is @actors, 1, "Got one actor";
+ is $actors[0]->name, "Actor 1", "Correct name";
}
{
- ok my @actors = Actor->salary_between(0, 100), "Range 0 - 100";
- is @actors, 4, "Got all";
+ ok my @actors = Actor->salary_between(0, 100), "Range 0 - 100";
+ is @actors, 4, "Got all";
}
{
- my @actors = Actor->salary_between(100, 200);
- is @actors, 0, "None in Range 100 - 200";
+ my @actors = Actor->salary_between(100, 200);
+ is @actors, 0, "None in Range 100 - 200";
}
{
- ok my @actors = Actor->salary_between(0, 10), "Range 0 - 10";
- is @actors, 1, "Got 1";
- is $actors[0]->name, $act[0]->name, "Actor 1";
+ ok my @actors = Actor->salary_between(0, 10), "Range 0 - 10";
+ is @actors, 1, "Got 1";
+ is $actors[0]->name, $act[0]->name, "Actor 1";
}
{
- ok my @actors = Actor->salary_between(20, 30), "Range 20 - 20";
- @actors = sort { $a->salary <=> $b->salary } @actors;
- is @actors, 2, "Got 2";
- is $actors[0]->name, $act[1]->name, "Actor 2";
- is $actors[1]->name, $act[2]->name, "and Actor 3";
+ ok my @actors = Actor->salary_between(20, 30), "Range 20 - 20";
+ @actors = sort { $a->salary <=> $b->salary } @actors;
+ is @actors, 2, "Got 2";
+ is $actors[0]->name, $act[1]->name, "Actor 2";
+ is $actors[1]->name, $act[2]->name, "and Actor 3";
}
{
- ok my @actors = Actor->search(Film => $film), "Search by object";
- is @actors, 3, "3 actors in film 1";
+ ok my @actors = Actor->search(Film => $film), "Search by object";
+ is @actors, 3, "3 actors in film 1";
}
#----------------------------------------------------------------------
@@ -101,29 +101,29 @@
my $it_class = 'DBIx::Class::ResultSet';
sub test_normal_iterator {
- my $it = $film->actors;
- isa_ok $it, $it_class;
- is $it->count, 3, " - with 3 elements";
- my $i = 0;
- while (my $film = $it->next) {
- is $film->name, $act[ $i++ ]->name, "Get $i";
- }
- ok !$it->next, "No more";
- is $it->first->name, $act[0]->name, "Get first";
+ my $it = $film->actors;
+ isa_ok $it, $it_class;
+ is $it->count, 3, " - with 3 elements";
+ my $i = 0;
+ while (my $film = $it->next) {
+ is $film->name, $act[ $i++ ]->name, "Get $i";
+ }
+ ok !$it->next, "No more";
+ is $it->first->name, $act[0]->name, "Get first";
}
test_normal_iterator;
{
- Film->has_many(actor_ids => [ Actor => 'id' ]);
- my $it = $film->actor_ids;
- isa_ok $it, $it_class;
- is $it->count, 3, " - with 3 elements";
- my $i = 0;
- while (my $film_id = $it->next) {
- is $film_id, $act[ $i++ ]->id, "Get id $i";
- }
- ok !$it->next, "No more";
- is $it->first, $act[0]->id, "Get first";
+ Film->has_many(actor_ids => [ Actor => 'id' ]);
+ my $it = $film->actor_ids;
+ isa_ok $it, $it_class;
+ is $it->count, 3, " - with 3 elements";
+ my $i = 0;
+ while (my $film_id = $it->next) {
+ is $film_id, $act[ $i++ ]->id, "Get id $i";
+ }
+ ok !$it->next, "No more";
+ is $it->first, $act[0]->id, "Get first";
}
# make sure nothing gets clobbered;
@@ -134,22 +134,22 @@
{
- my @acts = $film->actors->slice(1, 2);
- is @acts, 2, "Slice gives 2 actor";
- is $acts[0]->name, "Actor 2", "Actor 2";
- is $acts[1]->name, "Actor 3", "and actor 3";
+ my @acts = $film->actors->slice(1, 2);
+ is @acts, 2, "Slice gives 2 actor";
+ is $acts[0]->name, "Actor 2", "Actor 2";
+ is $acts[1]->name, "Actor 3", "and actor 3";
}
{
- my @acts = $film->actors->slice(1);
- is @acts, 1, "Slice of 1 actor";
- is $acts[0]->name, "Actor 2", "Actor 2";
+ my @acts = $film->actors->slice(1);
+ is @acts, 1, "Slice of 1 actor";
+ is $acts[0]->name, "Actor 2", "Actor 2";
}
{
- my @acts = $film->actors->slice(2, 8);
- is @acts, 1, "Slice off the end";
- is $acts[0]->name, "Actor 3", "Gets last actor only";
+ my @acts = $film->actors->slice(2, 8);
+ is @acts, 1, "Slice off the end";
+ is $acts[0]->name, "Actor 3", "Gets last actor only";
}
package Class::DBI::My::Iterator;
@@ -167,15 +167,15 @@
delete $film->{related_resultsets};
{
- my @acts = $film->actors->slice(1, 2);
- is @acts, 2, "Slice gives 2 results";
- ok eq_set(\@acts, [qw/fred barney/]), "Fred and Barney";
+ my @acts = $film->actors->slice(1, 2);
+ is @acts, 2, "Slice gives 2 results";
+ ok eq_set(\@acts, [qw/fred barney/]), "Fred and Barney";
- ok $film->actors->delete_all, "Can delete via iterator";
- is $film->actors, 0, "no actors left";
+ ok $film->actors->delete_all, "Can delete via iterator";
+ is $film->actors, 0, "no actors left";
- eval { $film->actors->delete_all };
- is $@, '', "Deleting again does no harm";
+ eval { $film->actors->delete_all };
+ is $@, '', "Deleting again does no harm";
}
} # end SKIP block
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/14-might_have.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/14-might_have.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/14-might_have.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -26,45 +26,45 @@
Film->create_test_film;
{
- ok my $bt = Film->retrieve('Bad Taste'), "Get Film";
- isa_ok $bt, "Film";
- is $bt->info, undef, "No blurb yet";
- # bug where we couldn't write a class with a might_have that didn't_have
- $bt->rating(16);
- eval { $bt->update };
- is $@, '', "No problems updating when don't have";
- is $bt->rating, 16, "Updated OK";
+ ok my $bt = Film->retrieve('Bad Taste'), "Get Film";
+ isa_ok $bt, "Film";
+ is $bt->info, undef, "No blurb yet";
+ # bug where we couldn't write a class with a might_have that didn't_have
+ $bt->rating(16);
+ eval { $bt->update };
+ is $@, '', "No problems updating when don't have";
+ is $bt->rating, 16, "Updated OK";
- is $bt->blurb, undef, "Bad taste has no blurb";
- $bt->blurb("Wibble bar");
- $bt->update;
- is $bt->blurb, "Wibble bar", "And we can write the info";
+ is $bt->blurb, undef, "Bad taste has no blurb";
+ $bt->blurb("Wibble bar");
+ $bt->update;
+ is $bt->blurb, "Wibble bar", "And we can write the info";
}
{
- my $bt = Film->retrieve('Bad Taste');
- my $info = $bt->info;
- isa_ok $info, 'Blurb';
+ my $bt = Film->retrieve('Bad Taste');
+ my $info = $bt->info;
+ isa_ok $info, 'Blurb';
- is $bt->blurb, $info->blurb, "Blurb is the same as fetching the long way";
- ok $bt->blurb("New blurb"), "We can set the blurb";
- $bt->update;
- is $bt->blurb, $info->blurb, "Blurb has been set";
+ is $bt->blurb, $info->blurb, "Blurb is the same as fetching the long way";
+ ok $bt->blurb("New blurb"), "We can set the blurb";
+ $bt->update;
+ is $bt->blurb, $info->blurb, "Blurb has been set";
- $bt->rating(18);
- eval { $bt->update };
- is $@, '', "No problems updating when do have";
- is $bt->rating, 18, "Updated OK";
+ $bt->rating(18);
+ eval { $bt->update };
+ is $@, '', "No problems updating when do have";
+ is $bt->rating, 18, "Updated OK";
- # cascade delete?
- {
- my $blurb = Blurb->retrieve('Bad Taste');
- isa_ok $blurb => "Blurb";
- $bt->delete;
- $blurb = Blurb->retrieve('Bad Taste');
- is $blurb, undef, "Blurb has gone";
- }
-
+ # cascade delete?
+ {
+ my $blurb = Blurb->retrieve('Bad Taste');
+ isa_ok $blurb => "Blurb";
+ $bt->delete;
+ $blurb = Blurb->retrieve('Bad Taste');
+ is $blurb, undef, "Blurb has gone";
+ }
+
}
{
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/15-accessor.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/15-accessor.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/15-accessor.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -83,7 +83,7 @@
my $data = { %$data };
$data->{NumExplodingSheep} = 1;
ok my $bt = Film->find_or_create($data),
- "find_or_create Modified accessor - find with column name";
+ "find_or_create Modified accessor - find with column name";
isa_ok $bt, "Film";
is $bt->sheep, 1, 'sheep bursting violently';
};
@@ -93,7 +93,7 @@
my $data = { %$data };
$data->{sheep} = 1;
ok my $bt = Film->find_or_create($data),
- "find_or_create Modified accessor - find with accessor";
+ "find_or_create Modified accessor - find with accessor";
isa_ok $bt, "Film";
is $bt->sheep, 1, 'sheep bursting violently';
};
@@ -104,7 +104,7 @@
my $data = { %$data };
$data->{NumExplodingSheep} = 3;
ok my $bt = Film->find_or_create($data),
- "find_or_create Modified accessor - create with column name";
+ "find_or_create Modified accessor - create with column name";
isa_ok $bt, "Film";
is $bt->sheep, 3, 'sheep bursting violently';
};
@@ -114,7 +114,7 @@
my $data = { %$data };
$data->{sheep} = 4;
ok my $bt = Film->find_or_create($data),
- "find_or_create Modified accessor - create with accessor";
+ "find_or_create Modified accessor - create with accessor";
isa_ok $bt, "Film";
is $bt->sheep, 4, 'sheep bursting violently';
};
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/18-has_a.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/18-has_a.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/18-has_a.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -24,217 +24,217 @@
ok(Film->has_a('Director' => 'Director'), "Link Director table");
ok(
- Director->create({
- Name => 'Peter Jackson',
- Birthday => -300000000,
- IsInsane => 1
- }
- ),
- 'create Director'
+ Director->create({
+ Name => 'Peter Jackson',
+ Birthday => -300000000,
+ IsInsane => 1
+ }
+ ),
+ 'create Director'
);
{
- ok $btaste = Film->retrieve('Bad Taste'), "Reretrieve Bad Taste";
- ok $pj = $btaste->Director, "Bad taste now hasa() director";
- isa_ok $pj => 'Director';
- {
- no warnings qw(redefine once);
- local *Ima::DBI::st::execute =
- sub { ::fail("Shouldn't need to query db"); };
- is $pj->id, 'Peter Jackson', 'ID already stored';
- }
- ok $pj->IsInsane, "But we know he's insane";
+ ok $btaste = Film->retrieve('Bad Taste'), "Reretrieve Bad Taste";
+ ok $pj = $btaste->Director, "Bad taste now hasa() director";
+ isa_ok $pj => 'Director';
+ {
+ no warnings qw(redefine once);
+ local *Ima::DBI::st::execute =
+ sub { ::fail("Shouldn't need to query db"); };
+ is $pj->id, 'Peter Jackson', 'ID already stored';
+ }
+ ok $pj->IsInsane, "But we know he's insane";
}
# Oh no! Its Peter Jacksons even twin, Skippy! Born one minute after him.
my $sj = Director->create({
- Name => 'Skippy Jackson',
- Birthday => (-300000000 + 60),
- IsInsane => 1,
- });
+ Name => 'Skippy Jackson',
+ Birthday => (-300000000 + 60),
+ IsInsane => 1,
+ });
{
- eval { $btaste->Director($btaste) };
- like $@, qr/Director/, "Can't set film as director";
- is $btaste->Director->id, $pj->id, "PJ still the director";
+ eval { $btaste->Director($btaste) };
+ like $@, qr/Director/, "Can't set film as director";
+ is $btaste->Director->id, $pj->id, "PJ still the director";
- # drop from cache so that next retrieve() is from db
- $btaste->remove_from_object_index;
+ # drop from cache so that next retrieve() is from db
+ $btaste->remove_from_object_index;
}
{ # Still inflated after update
- my $btaste = Film->retrieve('Bad Taste');
- isa_ok $btaste->Director, "Director";
- $btaste->numexplodingsheep(17);
- $btaste->update;
- isa_ok $btaste->Director, "Director";
+ my $btaste = Film->retrieve('Bad Taste');
+ isa_ok $btaste->Director, "Director";
+ $btaste->numexplodingsheep(17);
+ $btaste->update;
+ isa_ok $btaste->Director, "Director";
- $btaste->Director('Someone Else');
- $btaste->update;
- isa_ok $btaste->Director, "Director";
- is $btaste->Director->id, "Someone Else", "Can change director";
+ $btaste->Director('Someone Else');
+ $btaste->update;
+ isa_ok $btaste->Director, "Director";
+ is $btaste->Director->id, "Someone Else", "Can change director";
}
is $sj->id, 'Skippy Jackson', 'Create new director - Skippy';
Film->has_a('CoDirector' => 'Director');
{
- eval { $btaste->CoDirector("Skippy Jackson") };
- is $@, "", "Auto inflates";
- isa_ok $btaste->CoDirector, "Director";
- is $btaste->CoDirector->id, $sj->id, "To skippy";
+ eval { $btaste->CoDirector("Skippy Jackson") };
+ is $@, "", "Auto inflates";
+ isa_ok $btaste->CoDirector, "Director";
+ is $btaste->CoDirector->id, $sj->id, "To skippy";
}
$btaste->CoDirector($sj);
$btaste->update;
is($btaste->CoDirector->Name, 'Skippy Jackson', 'He co-directed');
is(
- $btaste->Director->Name,
- 'Peter Jackson',
- "Didnt interfere with each other"
+ $btaste->Director->Name,
+ 'Peter Jackson',
+ "Didnt interfere with each other"
);
{ # Inheriting hasa
- my $btaste = YA::Film->retrieve('Bad Taste');
- is(ref($btaste->Director), 'Director', 'inheriting hasa()');
- is(ref($btaste->CoDirector), 'Director', 'inheriting hasa()');
- is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly');
+ my $btaste = YA::Film->retrieve('Bad Taste');
+ is(ref($btaste->Director), 'Director', 'inheriting hasa()');
+ is(ref($btaste->CoDirector), 'Director', 'inheriting hasa()');
+ is($btaste->CoDirector->Name, 'Skippy Jackson', ' ... correctly');
}
{
- $sj = Director->retrieve('Skippy Jackson');
- $pj = Director->retrieve('Peter Jackson');
+ $sj = Director->retrieve('Skippy Jackson');
+ $pj = Director->retrieve('Peter Jackson');
- my $fail;
- eval {
- $fail = YA::Film->create({
- Title => 'Tastes Bad',
- Director => $sj,
- codirector => $btaste,
- Rating => 'R',
- NumExplodingSheep => 23
- });
- };
- ok $@, "Can't have film as codirector: $@";
- is $fail, undef, "We didn't get anything";
+ my $fail;
+ eval {
+ $fail = YA::Film->create({
+ Title => 'Tastes Bad',
+ Director => $sj,
+ codirector => $btaste,
+ Rating => 'R',
+ NumExplodingSheep => 23
+ });
+ };
+ ok $@, "Can't have film as codirector: $@";
+ is $fail, undef, "We didn't get anything";
- my $tastes_bad = YA::Film->create({
- Title => 'Tastes Bad',
- Director => $sj,
- codirector => $pj,
- Rating => 'R',
- NumExplodingSheep => 23
- });
- is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director');
- is(
- $tastes_bad->_director_accessor->Name,
- 'Skippy Jackson',
- 'director_accessor'
- );
- is($tastes_bad->codirector->Name, 'Peter Jackson', 'codirector');
- is(
- $tastes_bad->_codirector_accessor->Name,
- 'Peter Jackson',
- 'codirector_accessor'
- );
+ my $tastes_bad = YA::Film->create({
+ Title => 'Tastes Bad',
+ Director => $sj,
+ codirector => $pj,
+ Rating => 'R',
+ NumExplodingSheep => 23
+ });
+ is($tastes_bad->Director->Name, 'Skippy Jackson', 'Director');
+ is(
+ $tastes_bad->_director_accessor->Name,
+ 'Skippy Jackson',
+ 'director_accessor'
+ );
+ is($tastes_bad->codirector->Name, 'Peter Jackson', 'codirector');
+ is(
+ $tastes_bad->_codirector_accessor->Name,
+ 'Peter Jackson',
+ 'codirector_accessor'
+ );
}
SKIP: {
skip "Non-standard CDBI relationships not supported by compat", 9;
- {
+ {
- YA::Film->add_relationship_type(has_a => "YA::HasA");
+ YA::Film->add_relationship_type(has_a => "YA::HasA");
- package YA::HasA;
- #use base 'Class::DBI::Relationship::HasA';
+ package YA::HasA;
+ #use base 'Class::DBI::Relationship::HasA';
- sub _inflator {
- my $self = shift;
- my $col = $self->accessor;
- my $super = $self->SUPER::_inflator($col);
+ sub _inflator {
+ my $self = shift;
+ my $col = $self->accessor;
+ my $super = $self->SUPER::_inflator($col);
- return $super
- unless $col eq $self->class->find_column('Director');
+ return $super
+ unless $col eq $self->class->find_column('Director');
- return sub {
- my $self = shift;
- $self->_attribute_store($col, 'Ghostly Peter')
- if $self->_attribute_exists($col)
- and not defined $self->_attrs($col);
- return &$super($self);
- };
- }
- }
- {
+ return sub {
+ my $self = shift;
+ $self->_attribute_store($col, 'Ghostly Peter')
+ if $self->_attribute_exists($col)
+ and not defined $self->_attrs($col);
+ return &$super($self);
+ };
+ }
+ }
+ {
- package Rating;
+ package Rating;
- sub new {
- my ($class, $mpaa, @details) = @_;
- bless {
- MPAA => $mpaa,
- WHY => "@details"
- }, $class;
- }
- sub mpaa { shift->{MPAA}; }
- sub why { shift->{WHY}; }
- }
- local *Director::mapme = sub {
- my ($class, $val) = @_;
- $val =~ s/Skippy/Peter/;
- $val;
- };
- no warnings 'once';
- local *Director::sanity_check = sub { $_[0]->IsInsane ? undef: $_[0] };
- YA::Film->has_a(
- director => 'Director',
- inflate => 'mapme',
- deflate => 'sanity_check'
- );
- YA::Film->has_a(
- rating => 'Rating',
- inflate => sub {
- my ($val, $parent) = @_;
- my $sheep = $parent->find_column('NumexplodingSheep');
- if ($parent->_attrs($sheep) || 0 > 20) {
- return new Rating 'NC17', 'Graphic ovine violence';
- } else {
- return new Rating $val, 'Just because';
- }
- },
- deflate => sub {
- shift->mpaa;
- });
+ sub new {
+ my ($class, $mpaa, @details) = @_;
+ bless {
+ MPAA => $mpaa,
+ WHY => "@details"
+ }, $class;
+ }
+ sub mpaa { shift->{MPAA}; }
+ sub why { shift->{WHY}; }
+ }
+ local *Director::mapme = sub {
+ my ($class, $val) = @_;
+ $val =~ s/Skippy/Peter/;
+ $val;
+ };
+ no warnings 'once';
+ local *Director::sanity_check = sub { $_[0]->IsInsane ? undef: $_[0] };
+ YA::Film->has_a(
+ director => 'Director',
+ inflate => 'mapme',
+ deflate => 'sanity_check'
+ );
+ YA::Film->has_a(
+ rating => 'Rating',
+ inflate => sub {
+ my ($val, $parent) = @_;
+ my $sheep = $parent->find_column('NumexplodingSheep');
+ if ($parent->_attrs($sheep) || 0 > 20) {
+ return new Rating 'NC17', 'Graphic ovine violence';
+ } else {
+ return new Rating $val, 'Just because';
+ }
+ },
+ deflate => sub {
+ shift->mpaa;
+ });
- my $tbad = YA::Film->retrieve('Tastes Bad');
+ my $tbad = YA::Film->retrieve('Tastes Bad');
- isa_ok $tbad->Director, 'Director';
- is $tbad->Director->Name, 'Peter Jackson', 'Director shuffle';
- $tbad->Director('Skippy Jackson');
- $tbad->update;
- is $tbad->Director, 'Ghostly Peter', 'Sanity checked';
+ isa_ok $tbad->Director, 'Director';
+ is $tbad->Director->Name, 'Peter Jackson', 'Director shuffle';
+ $tbad->Director('Skippy Jackson');
+ $tbad->update;
+ is $tbad->Director, 'Ghostly Peter', 'Sanity checked';
- isa_ok $tbad->Rating, 'Rating';
- is $tbad->Rating->mpaa, 'NC17', 'Rating bumped';
- $tbad->Rating(new Rating 'NS17', 'Shaken sheep');
- no warnings 'redefine';
- local *Director::mapme = sub {
- my ($class, $obj) = @_;
- $obj->isa('Film') ? $obj->Director : $obj;
- };
+ isa_ok $tbad->Rating, 'Rating';
+ is $tbad->Rating->mpaa, 'NC17', 'Rating bumped';
+ $tbad->Rating(new Rating 'NS17', 'Shaken sheep');
+ no warnings 'redefine';
+ local *Director::mapme = sub {
+ my ($class, $obj) = @_;
+ $obj->isa('Film') ? $obj->Director : $obj;
+ };
- $pj->IsInsane(0);
- $pj->update; # Hush warnings
+ $pj->IsInsane(0);
+ $pj->update; # Hush warnings
- ok $tbad->Director($btaste), 'Cross-class mapping';
- is $tbad->Director, 'Peter Jackson', 'Yields PJ';
- $tbad->update;
+ ok $tbad->Director($btaste), 'Cross-class mapping';
+ is $tbad->Director, 'Peter Jackson', 'Yields PJ';
+ $tbad->update;
- $tbad = Film->retrieve('Tastes Bad');
- ok !ref($tbad->Rating), 'Unmagical rating';
- is $tbad->Rating, 'NS17', 'but prior change stuck';
+ $tbad = Film->retrieve('Tastes Bad');
+ ok !ref($tbad->Rating), 'Unmagical rating';
+ is $tbad->Rating, 'NS17', 'but prior change stuck';
}
{ # Broken has_a declaration
- eval { Film->has_a(driector => "Director") };
- like $@, qr/driector/, "Sensible error from has_a with incorrect column: $@";
+ eval { Film->has_a(driector => "Director") };
+ like $@, qr/driector/, "Sensible error from has_a with incorrect column: $@";
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/19-set_sql.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/19-set_sql.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/19-set_sql.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -16,14 +16,14 @@
use Actor;
{ # Check __ESSENTIAL__ expansion (RT#13038)
- my @cols = Film->columns('Essential');
- is_deeply \@cols, ['title'], "1 Column in essential";
- is +Film->transform_sql('__ESSENTIAL__'), 'title', '__ESSENTIAL__ expansion';
-
- # This provides a more interesting test
- Film->columns(Essential => qw(title rating));
- is +Film->transform_sql('__ESSENTIAL__'), 'title, rating',
- 'multi-col __ESSENTIAL__ expansion';
+ my @cols = Film->columns('Essential');
+ is_deeply \@cols, ['title'], "1 Column in essential";
+ is +Film->transform_sql('__ESSENTIAL__'), 'title', '__ESSENTIAL__ expansion';
+
+ # This provides a more interesting test
+ Film->columns(Essential => qw(title rating));
+ is +Film->transform_sql('__ESSENTIAL__'), 'title, rating',
+ 'multi-col __ESSENTIAL__ expansion';
}
my $f1 = Film->create({ title => 'A', director => 'AA', rating => 'PG' });
@@ -33,43 +33,43 @@
my $f5 = Film->create({ title => 'E', director => 'AA', rating => '18' });
Film->set_sql(
- pgs => qq{
- SELECT __ESSENTIAL__
- FROM __TABLE__
- WHERE __TABLE__.rating = 'PG'
- ORDER BY title DESC
+ pgs => qq{
+ SELECT __ESSENTIAL__
+ FROM __TABLE__
+ WHERE __TABLE__.rating = 'PG'
+ ORDER BY title DESC
}
);
{
- (my $sth = Film->sql_pgs())->execute;
- my @pgs = Film->sth_to_objects($sth);
- is @pgs, 2, "Execute our own SQL";
- is $pgs[0]->id, $f2->id, "get F2";
- is $pgs[1]->id, $f1->id, "and F1";
+ (my $sth = Film->sql_pgs())->execute;
+ my @pgs = Film->sth_to_objects($sth);
+ is @pgs, 2, "Execute our own SQL";
+ is $pgs[0]->id, $f2->id, "get F2";
+ is $pgs[1]->id, $f1->id, "and F1";
}
{
- my @pgs = Film->search_pgs;
- is @pgs, 2, "SQL creates search() method";
- is $pgs[0]->id, $f2->id, "get F2";
- is $pgs[1]->id, $f1->id, "and F1";
+ my @pgs = Film->search_pgs;
+ is @pgs, 2, "SQL creates search() method";
+ is $pgs[0]->id, $f2->id, "get F2";
+ is $pgs[1]->id, $f1->id, "and F1";
};
Film->set_sql(
- rating => qq{
- SELECT __ESSENTIAL__
- FROM __TABLE__
- WHERE rating = ?
- ORDER BY title DESC
+ rating => qq{
+ SELECT __ESSENTIAL__
+ FROM __TABLE__
+ WHERE rating = ?
+ ORDER BY title DESC
}
);
{
- my @pgs = Film->search_rating('18');
- is @pgs, 2, "Can pass parameters to created search()";
- is $pgs[0]->id, $f5->id, "F5";
- is $pgs[1]->id, $f4->id, "and F4";
+ my @pgs = Film->search_rating('18');
+ is @pgs, 2, "Can pass parameters to created search()";
+ is $pgs[0]->id, $f5->id, "F5";
+ is $pgs[1]->id, $f4->id, "and F4";
};
{
@@ -89,44 +89,44 @@
{
- Actor->has_a(film => "Film");
- Film->set_sql(
- namerate => qq{
- SELECT __ESSENTIAL(f)__
- FROM __TABLE(=f)__, __TABLE(Actor=a)__
- WHERE __JOIN(a f)__
- AND a.name LIKE ?
- AND f.rating = ?
- ORDER BY title
- }
- );
+ Actor->has_a(film => "Film");
+ Film->set_sql(
+ namerate => qq{
+ SELECT __ESSENTIAL(f)__
+ FROM __TABLE(=f)__, __TABLE(Actor=a)__
+ WHERE __JOIN(a f)__
+ AND a.name LIKE ?
+ AND f.rating = ?
+ ORDER BY title
+ }
+ );
- my $a1 = Actor->create({ name => "A1", film => $f1 });
- my $a2 = Actor->create({ name => "A2", film => $f2 });
- my $a3 = Actor->create({ name => "B1", film => $f1 });
+ my $a1 = Actor->create({ name => "A1", film => $f1 });
+ my $a2 = Actor->create({ name => "A2", film => $f2 });
+ my $a3 = Actor->create({ name => "B1", film => $f1 });
- my @apg = Film->search_namerate("A_", "PG");
- is @apg, 2, "2 Films with A* that are PG";
- is $apg[0]->title, "A", "A";
- is $apg[1]->title, "B", "and B";
+ my @apg = Film->search_namerate("A_", "PG");
+ is @apg, 2, "2 Films with A* that are PG";
+ is $apg[0]->title, "A", "A";
+ is $apg[1]->title, "B", "and B";
}
{ # join in reverse
- Actor->has_a(film => "Film");
- Film->set_sql(
- ratename => qq{
- SELECT __ESSENTIAL(f)__
- FROM __TABLE(=f)__, __TABLE(Actor=a)__
- WHERE __JOIN(f a)__
- AND f.rating = ?
- AND a.name LIKE ?
- ORDER BY title
- }
- );
+ Actor->has_a(film => "Film");
+ Film->set_sql(
+ ratename => qq{
+ SELECT __ESSENTIAL(f)__
+ FROM __TABLE(=f)__, __TABLE(Actor=a)__
+ WHERE __JOIN(f a)__
+ AND f.rating = ?
+ AND a.name LIKE ?
+ ORDER BY title
+ }
+ );
- my @apg = Film->search_ratename(PG => "A_");
- is @apg, 2, "2 Films with A* that are PG";
- is $apg[0]->title, "A", "A";
- is $apg[1]->title, "B", "and B";
+ my @apg = Film->search_ratename(PG => "A_");
+ is @apg, 2, "2 Films with A* that are PG";
+ is $apg[0]->title, "A", "A";
+ is $apg[1]->title, "B", "and B";
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/21-iterator.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/21-iterator.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/21-iterator.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -17,70 +17,70 @@
my $it_class = "DBIx::Class::ResultSet";
my @film = (
- Film->create({ Title => 'Film 1' }),
- Film->create({ Title => 'Film 2' }),
- Film->create({ Title => 'Film 3' }),
- Film->create({ Title => 'Film 4' }),
- Film->create({ Title => 'Film 5' }),
- Film->create({ Title => 'Film 6' }),
+ Film->create({ Title => 'Film 1' }),
+ Film->create({ Title => 'Film 2' }),
+ Film->create({ Title => 'Film 3' }),
+ Film->create({ Title => 'Film 4' }),
+ Film->create({ Title => 'Film 5' }),
+ Film->create({ Title => 'Film 6' }),
);
{
- my $it1 = Film->retrieve_all;
- isa_ok $it1, $it_class;
+ my $it1 = Film->retrieve_all;
+ isa_ok $it1, $it_class;
- my $it2 = Film->retrieve_all;
- isa_ok $it2, $it_class;
+ my $it2 = Film->retrieve_all;
+ isa_ok $it2, $it_class;
- while (my $from1 = $it1->next) {
- my $from2 = $it2->next;
- is $from1->id, $from2->id, "Both iterators get $from1";
- }
+ while (my $from1 = $it1->next) {
+ my $from2 = $it2->next;
+ is $from1->id, $from2->id, "Both iterators get $from1";
+ }
}
{
- my $it = Film->retrieve_all;
- is $it->first->title, "Film 1", "Film 1 first";
- is $it->next->title, "Film 2", "Film 2 next";
- is $it->first->title, "Film 1", "First goes back to 1";
- is $it->next->title, "Film 2", "With 2 still next";
- $it->reset;
- is $it->next->title, "Film 1", "Reset brings us to film 1 again";
- is $it->next->title, "Film 2", "And 2 is still next";
+ my $it = Film->retrieve_all;
+ is $it->first->title, "Film 1", "Film 1 first";
+ is $it->next->title, "Film 2", "Film 2 next";
+ is $it->first->title, "Film 1", "First goes back to 1";
+ is $it->next->title, "Film 2", "With 2 still next";
+ $it->reset;
+ is $it->next->title, "Film 1", "Reset brings us to film 1 again";
+ is $it->next->title, "Film 2", "And 2 is still next";
}
{
- my $it = Film->retrieve_all;
- my @slice = $it->slice(2,4);
- is @slice, 3, "correct slice size (array)";
- is $slice[0]->title, "Film 3", "Film 3 first";
- is $slice[2]->title, "Film 5", "Film 5 last";
+ my $it = Film->retrieve_all;
+ my @slice = $it->slice(2,4);
+ is @slice, 3, "correct slice size (array)";
+ is $slice[0]->title, "Film 3", "Film 3 first";
+ is $slice[2]->title, "Film 5", "Film 5 last";
}
{
- my $it = Film->retrieve_all;
- my $slice = $it->slice(2,4);
- isa_ok $slice, $it_class, "slice as iterator";
- is $slice->count, 3,"correct slice size (array)";
- is $slice->first->title, "Film 3", "Film 3 first";
- is $slice->next->title, "Film 4", "Film 4 next";
- is $slice->first->title, "Film 3", "First goes back to 3";
- is $slice->next->title, "Film 4", "With 4 still next";
- $slice->reset;
- is $slice->next->title, "Film 3", "Reset brings us to film 3 again";
- is $slice->next->title, "Film 4", "And 4 is still next";
+ my $it = Film->retrieve_all;
+ my $slice = $it->slice(2,4);
+ isa_ok $slice, $it_class, "slice as iterator";
+ is $slice->count, 3,"correct slice size (array)";
+ is $slice->first->title, "Film 3", "Film 3 first";
+ is $slice->next->title, "Film 4", "Film 4 next";
+ is $slice->first->title, "Film 3", "First goes back to 3";
+ is $slice->next->title, "Film 4", "With 4 still next";
+ $slice->reset;
+ is $slice->next->title, "Film 3", "Reset brings us to film 3 again";
+ is $slice->next->title, "Film 4", "And 4 is still next";
- # check if the original iterator still works
- is $it->count, 6, "back to the original iterator, is of right size";
- is $it->first->title, "Film 1", "Film 1 first";
- is $it->next->title, "Film 2", "Film 2 next";
- is $it->first->title, "Film 1", "First goes back to 1";
- is $it->next->title, "Film 2", "With 2 still next";
- is $it->next->title, "Film 3", "Film 3 is still in original Iterator";
- $it->reset;
- is $it->next->title, "Film 1", "Reset brings us to film 1 again";
- is $it->next->title, "Film 2", "And 2 is still next";
+ # check if the original iterator still works
+ is $it->count, 6, "back to the original iterator, is of right size";
+ is $it->first->title, "Film 1", "Film 1 first";
+ is $it->next->title, "Film 2", "Film 2 next";
+ is $it->first->title, "Film 1", "First goes back to 1";
+ is $it->next->title, "Film 2", "With 2 still next";
+ is $it->next->title, "Film 3", "Film 3 is still in original Iterator";
+ $it->reset;
+ is $it->next->title, "Film 1", "Reset brings us to film 1 again";
+ is $it->next->title, "Film 2", "And 2 is still next";
}
{
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/22-deflate_order.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/22-deflate_order.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/22-deflate_order.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -9,15 +9,17 @@
next;
}
+plan skip_all => 'Set $ENV{DBICTEST_MYSQL_DSN}, _USER and _PASS to run this test'
+ unless ($ENV{DBICTEST_MYSQL_DSN} && $ENV{DBICTEST_MYSQL_USER});
+
eval { require Time::Piece::MySQL };
plan skip_all => "Need Time::Piece::MySQL for this test" if $@;
+plan tests => 3;
+
use lib 't/cdbi/testlib';
-eval { require 't/cdbi/testlib/Log.pm' };
-plan skip_all => "Need MySQL for this test" if $@;
+use_ok ('Log');
-plan tests => 2;
-
package main;
my $log = Log->insert( { message => 'initial message' } );
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/26-mutator.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/26-mutator.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/26-mutator.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -8,40 +8,40 @@
}
BEGIN {
- eval "use DBD::SQLite";
- plan $@
- ? (skip_all => 'needs DBD::SQLite for testing')
- : (tests => 6);
+ eval "use DBD::SQLite";
+ plan $@
+ ? (skip_all => 'needs DBD::SQLite for testing')
+ : (tests => 6);
}
use lib 't/cdbi/testlib';
require Film;
sub Film::accessor_name_for {
- my ($class, $col) = @_;
- return "sheep" if lc $col eq "numexplodingsheep";
- return $col;
+ my ($class, $col) = @_;
+ return "sheep" if lc $col eq "numexplodingsheep";
+ return $col;
}
my $data = {
- Title => 'Bad Taste',
- Director => 'Peter Jackson',
- Rating => 'R',
+ Title => 'Bad Taste',
+ Director => 'Peter Jackson',
+ Rating => 'R',
};
my $bt;
eval {
- my $data = $data;
- $data->{sheep} = 1;
- ok $bt = Film->insert($data), "Modified accessor - with
+ my $data = $data;
+ $data->{sheep} = 1;
+ ok $bt = Film->insert($data), "Modified accessor - with
accessor";
- isa_ok $bt, "Film";
+ isa_ok $bt, "Film";
};
is $@, '', "No errors";
eval {
- ok $bt->sheep(2), 'Modified accessor, set';
- ok $bt->update, 'Update';
+ ok $bt->sheep(2), 'Modified accessor, set';
+ ok $bt->update, 'Update';
};
is $@, '', "No errors";
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/30-pager.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/30-pager.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/30-pager.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -15,11 +15,11 @@
use Film;
my @film = (
- Film->create({ Title => 'Film 1' }),
- Film->create({ Title => 'Film 2' }),
- Film->create({ Title => 'Film 3' }),
- Film->create({ Title => 'Film 4' }),
- Film->create({ Title => 'Film 5' }),
+ Film->create({ Title => 'Film 1' }),
+ Film->create({ Title => 'Film 2' }),
+ Film->create({ Title => 'Film 3' }),
+ Film->create({ Title => 'Film 4' }),
+ Film->create({ Title => 'Film 5' }),
);
# first page
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/98-failure.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/98-failure.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/98-failure.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -21,42 +21,42 @@
Film->create_test_film;
{
- my $btaste = Film->retrieve('Bad Taste');
- isa_ok $btaste, 'Film', "We have Bad Taste";
- {
- no warnings 'redefine';
- local *DBIx::ContextualFetch::st::execute = sub { die "Database died" };
- eval { $btaste->delete };
- ::like $@, qr/Database died/s, "We failed";
- }
- my $still = Film->retrieve('Bad Taste');
- isa_ok $btaste, 'Film', "We still have Bad Taste";
+ my $btaste = Film->retrieve('Bad Taste');
+ isa_ok $btaste, 'Film', "We have Bad Taste";
+ {
+ no warnings 'redefine';
+ local *DBIx::ContextualFetch::st::execute = sub { die "Database died" };
+ eval { $btaste->delete };
+ ::like $@, qr/Database died/s, "We failed";
+ }
+ my $still = Film->retrieve('Bad Taste');
+ isa_ok $btaste, 'Film', "We still have Bad Taste";
}
{
- my $btaste = Film->retrieve('Bad Taste');
- isa_ok $btaste, 'Film', "We have Bad Taste";
- $btaste->numexplodingsheep(10);
- {
- no warnings 'redefine';
- local *DBIx::ContextualFetch::st::execute = sub { die "Database died" };
- eval { $btaste->update };
- ::like $@, qr/Database died/s, "We failed";
- }
- $btaste->discard_changes;
- my $still = Film->retrieve('Bad Taste');
- isa_ok $btaste, 'Film', "We still have Bad Taste";
- is $btaste->numexplodingsheep, 1, "with 1 sheep";
+ my $btaste = Film->retrieve('Bad Taste');
+ isa_ok $btaste, 'Film', "We have Bad Taste";
+ $btaste->numexplodingsheep(10);
+ {
+ no warnings 'redefine';
+ local *DBIx::ContextualFetch::st::execute = sub { die "Database died" };
+ eval { $btaste->update };
+ ::like $@, qr/Database died/s, "We failed";
+ }
+ $btaste->discard_changes;
+ my $still = Film->retrieve('Bad Taste');
+ isa_ok $btaste, 'Film', "We still have Bad Taste";
+ is $btaste->numexplodingsheep, 1, "with 1 sheep";
}
if (0) {
- my $sheep = Film->maximum_value_of('numexplodingsheep');
- is $sheep, 1, "1 exploding sheep";
- {
- local *DBIx::ContextualFetch::st::execute = sub { die "Database died" };
- my $sheep = eval { Film->maximum_value_of('numexplodingsheep') };
- ::like $@, qr/select.*Database died/s,
- "Handle database death in single value select";
- }
+ my $sheep = Film->maximum_value_of('numexplodingsheep');
+ is $sheep, 1, "1 exploding sheep";
+ {
+ local *DBIx::ContextualFetch::st::execute = sub { die "Database died" };
+ my $sheep = eval { Film->maximum_value_of('numexplodingsheep') };
+ ::like $@, qr/select.*Database died/s,
+ "Handle database death in single value select";
+ }
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/abstract/search_where.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/abstract/search_where.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/abstract/search_where.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -14,8 +14,8 @@
}
INIT {
- use lib 't/cdbi/testlib';
- use Film;
+ use lib 't/cdbi/testlib';
+ use Film;
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Actor.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Actor.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Actor.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -16,12 +16,12 @@
sub mutator_name_for { "set_$_[1]" }
sub create_sql {
- return qq{
- id INTEGER PRIMARY KEY,
- name CHAR(40),
- film VARCHAR(255),
- salary INT
- }
+ return qq{
+ id INTEGER PRIMARY KEY,
+ name CHAR(40),
+ film VARCHAR(255),
+ salary INT
+ }
}
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/ActorAlias.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/ActorAlias.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/ActorAlias.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -14,11 +14,11 @@
__PACKAGE__->has_a( alias => 'Actor' );
sub create_sql {
- return qq{
- id INTEGER PRIMARY KEY,
- actor INTEGER,
- alias INTEGER
- }
+ return qq{
+ id INTEGER PRIMARY KEY,
+ actor INTEGER,
+ alias INTEGER
+ }
}
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Blurb.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Blurb.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Blurb.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -9,9 +9,9 @@
__PACKAGE__->columns('Blurb', qw/ blurb/);
sub create_sql {
- return qq{
- title VARCHAR(255) PRIMARY KEY,
- blurb VARCHAR(255) NOT NULL
+ return qq{
+ title VARCHAR(255) PRIMARY KEY,
+ blurb VARCHAR(255) NOT NULL
}
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Director.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Director.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Director.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -8,11 +8,11 @@
__PACKAGE__->columns('All' => qw/ Name Birthday IsInsane /);
sub create_sql {
- return qq{
- name VARCHAR(80),
- birthday INTEGER,
- isinsane INTEGER
- };
+ return qq{
+ name VARCHAR(80),
+ birthday INTEGER,
+ isinsane INTEGER
+ };
}
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Film.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Film.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Film.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -11,23 +11,23 @@
__PACKAGE__->columns('Other', qw( Rating NumExplodingSheep HasVomit ));
sub create_sql {
- return qq{
- title VARCHAR(255),
- director VARCHAR(80),
- codirector VARCHAR(80),
- rating CHAR(5),
- numexplodingsheep INTEGER,
- hasvomit CHAR(1)
+ return qq{
+ title VARCHAR(255),
+ director VARCHAR(80),
+ codirector VARCHAR(80),
+ rating CHAR(5),
+ numexplodingsheep INTEGER,
+ hasvomit CHAR(1)
}
}
sub create_test_film {
- return shift->create({
- Title => 'Bad Taste',
- Director => 'Peter Jackson',
- Rating => 'R',
- NumExplodingSheep => 1,
- });
+ return shift->create({
+ Title => 'Bad Taste',
+ Director => 'Peter Jackson',
+ Rating => 'R',
+ NumExplodingSheep => 1,
+ });
}
package DeletingFilm;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Lazy.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Lazy.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Lazy.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -12,14 +12,14 @@
__PACKAGE__->columns('vertical', qw(oop opop));
sub create_sql {
- return qq{
- this INTEGER,
- that INTEGER,
- eep INTEGER,
- orp INTEGER,
- oop INTEGER,
- opop INTEGER
- };
+ return qq{
+ this INTEGER,
+ that INTEGER,
+ eep INTEGER,
+ orp INTEGER,
+ oop INTEGER,
+ opop INTEGER
+ };
}
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Log.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Log.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Log.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -10,21 +10,21 @@
__PACKAGE__->set_table();
__PACKAGE__->columns(All => qw/id message datetime_stamp/);
__PACKAGE__->has_a(
- datetime_stamp => 'Time::Piece',
- inflate => 'from_mysql_datetime',
- deflate => 'mysql_datetime'
+ datetime_stamp => 'Time::Piece',
+ inflate => 'from_mysql_datetime',
+ deflate => 'mysql_datetime'
);
__PACKAGE__->add_trigger(before_create => \&set_dts);
__PACKAGE__->add_trigger(before_update => \&set_dts);
sub set_dts {
- shift->datetime_stamp(
- POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime(time)));
+ shift->datetime_stamp(
+ POSIX::strftime('%Y-%m-%d %H:%M:%S', localtime(time)));
}
sub create_sql {
- return qq{
+ return qq{
id INT UNSIGNED AUTO_INCREMENT PRIMARY KEY,
message VARCHAR(255),
datetime_stamp DATETIME
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyBase.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyBase.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyBase.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -17,30 +17,30 @@
__PACKAGE__->connection(@connect);
sub set_table {
- my $class = shift;
- $class->table($class->create_test_table);
+ my $class = shift;
+ $class->table($class->create_test_table);
}
sub create_test_table {
- my $self = shift;
- my $table = $self->next_available_table;
- my $create = sprintf "CREATE TABLE $table ( %s )", $self->create_sql;
- push @table, $table;
- $dbh->do($create);
- return $table;
+ my $self = shift;
+ my $table = $self->next_available_table;
+ my $create = sprintf "CREATE TABLE $table ( %s )", $self->create_sql;
+ push @table, $table;
+ $dbh->do($create);
+ return $table;
}
sub next_available_table {
- my $self = shift;
- my @tables = sort @{
- $dbh->selectcol_arrayref(
- qq{
+ my $self = shift;
+ my @tables = sort @{
+ $dbh->selectcol_arrayref(
+ qq{
SHOW TABLES
}
- )
- };
- my $table = $tables[-1] || "aaa";
- return "z$table";
+ )
+ };
+ my $table = $tables[-1] || "aaa";
+ return "z$table";
}
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyFilm.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyFilm.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyFilm.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -16,7 +16,7 @@
sub stars { map $_->star, shift->_stars }
sub create_sql {
- return qq{
+ return qq{
filmid TINYINT NOT NULL AUTO_INCREMENT PRIMARY KEY,
title VARCHAR(255)
};
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyFoo.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyFoo.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyFoo.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -10,14 +10,14 @@
__PACKAGE__->set_table();
__PACKAGE__->columns(All => qw/myid name val tdate/);
__PACKAGE__->has_a(
- tdate => 'Date::Simple',
- inflate => sub { Date::Simple->new(shift) },
- deflate => 'format',
+ tdate => 'Date::Simple',
+ inflate => sub { Date::Simple->new(shift) },
+ deflate => 'format',
);
#__PACKAGE__->find_column('tdate')->placeholder("IF(1, CURDATE(), ?)");
sub create_sql {
- return qq{
+ return qq{
myid mediumint not null auto_increment primary key,
name varchar(50) not null default '',
val char(1) default 'A',
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyStar.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyStar.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyStar.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -12,10 +12,10 @@
# sub films { map $_->film, shift->_films }
sub create_sql {
- return qq{
- starid TINYINT NOT NULL AUTO_INCREMENT PRIMARY KEY,
- name VARCHAR(255)
- };
+ return qq{
+ starid TINYINT NOT NULL AUTO_INCREMENT PRIMARY KEY,
+ name VARCHAR(255)
+ };
}
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyStarLink.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyStarLink.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyStarLink.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -11,7 +11,7 @@
__PACKAGE__->has_a(star => 'MyStar');
sub create_sql {
- return qq{
+ return qq{
linkid TINYINT NOT NULL AUTO_INCREMENT PRIMARY KEY,
film TINYINT NOT NULL,
star TINYINT NOT NULL
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyStarLinkMCPK.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyStarLinkMCPK.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/MyStarLinkMCPK.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -18,7 +18,7 @@
__PACKAGE__->has_a(star => 'MyStar');
sub create_sql {
- return qq{
+ return qq{
film INTEGER NOT NULL,
star INTEGER NOT NULL,
PRIMARY KEY (film, star)
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Order.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Order.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/Order.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -10,10 +10,10 @@
__PACKAGE__->columns(Others => qw/orders/);
sub create_sql {
- return qq{
- film VARCHAR(255),
- orders INTEGER
- };
+ return qq{
+ film VARCHAR(255),
+ orders INTEGER
+ };
}
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/OtherFilm.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/OtherFilm.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/cdbi/testlib/OtherFilm.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,4 +1,4 @@
-package # hide from PAUSE
+package # hide from PAUSE
OtherFilm;
use strict;
@@ -7,14 +7,14 @@
__PACKAGE__->set_table('Different_Film');
sub create_sql {
- return qq{
- title VARCHAR(255),
- director VARCHAR(80),
- codirector VARCHAR(80),
- rating CHAR(5),
- numexplodingsheep INTEGER,
- hasvomit CHAR(1)
- };
+ return qq{
+ title VARCHAR(255),
+ director VARCHAR(80),
+ codirector VARCHAR(80),
+ rating CHAR(5),
+ numexplodingsheep INTEGER,
+ hasvomit CHAR(1)
+ };
}
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/count/count_rs.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/count/count_rs.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/count/count_rs.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -35,7 +35,6 @@
FROM cd me
JOIN track tracks ON tracks.cd = me.cdid
JOIN cd disc ON disc.cdid = tracks.cd
- LEFT JOIN lyrics lyrics ON lyrics.track_id = tracks.trackid
WHERE ( ( position = ? OR position = ? ) )
',
[ qw/'1' '2'/ ],
@@ -53,7 +52,6 @@
FROM cd me
JOIN track tracks ON tracks.cd = me.cdid
JOIN cd disc ON disc.cdid = tracks.cd
- LEFT JOIN lyrics lyrics ON lyrics.track_id = tracks.trackid
WHERE ( ( position = ? OR position = ? ) )
LIMIT 3 OFFSET 8
) count_subq
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/count/prefetch.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/count/prefetch.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/count/prefetch.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -39,16 +39,9 @@
# collapsing prefetch with distinct
{
- my $first_cd = $schema->resultset('Artist')->first->cds->first;
- $first_cd->update ({
- genreid => $first_cd->create_related (
- genre => ({ name => 'vague genre' })
- )->id
- });
-
my $rs = $schema->resultset("Artist")->search(undef, {distinct => 1})
->search_related('cds')->search_related('genre',
- { 'genre.name' => { '!=', 'foo' } },
+ { 'genre.name' => 'emo' },
{ prefetch => q(cds) },
);
is ($rs->all, 1, 'Correct number of objects');
@@ -60,15 +53,19 @@
SELECT COUNT( * )
FROM (
SELECT genre.genreid
- FROM artist me
+ FROM (
+ SELECT me.artistid, me.name, me.rank, me.charfield
+ FROM artist me
+ GROUP BY me.artistid, me.name, me.rank, me.charfield
+ ) me
JOIN cd cds ON cds.artist = me.artistid
JOIN genre genre ON genre.genreid = cds.genreid
- LEFT JOIN cd cds_2 ON cds_2.genreid = genre.genreid
- WHERE ( genre.name != ? )
+ WHERE ( genre.name = ? )
GROUP BY genre.genreid
- ) count_subq
+ )
+ count_subq
)',
- [ [ 'genre.name' => 'foo' ] ],
+ [ [ 'genre.name' => 'emo' ] ],
);
}
@@ -76,7 +73,7 @@
{
my $rs = $schema->resultset("CD")
->search_related('tracks',
- { position => [1,2] },
+ { position => [1,2], 'lyrics.lyric_id' => undef },
{ prefetch => [qw/disc lyrics/] },
);
is ($rs->all, 10, 'Correct number of objects');
@@ -92,7 +89,7 @@
JOIN track tracks ON tracks.cd = me.cdid
JOIN cd disc ON disc.cdid = tracks.cd
LEFT JOIN lyrics lyrics ON lyrics.track_id = tracks.trackid
- WHERE position = ? OR position = ?
+ WHERE lyrics.lyric_id IS NULL AND (position = ? OR position = ?)
)',
[ map { [ position => $_ ] } (1, 2) ],
);
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/count/search_related.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/count/search_related.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/count/search_related.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,41 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib qw(t/lib);
+
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+my $cd_rs = $schema->resultset('CD')->search ({}, { rows => 1, order_by => 'cdid' });
+
+my $track_count = $cd_rs->first->tracks->count;
+
+cmp_ok ($track_count, '>', 1, 'First CD has several tracks');
+
+is ($cd_rs->search_related ('tracks')->count, $track_count, 'related->count returns correct number chained off a limited rs');
+is (scalar ($cd_rs->search_related ('tracks')->all), $track_count, 'related->all returns correct number of objects chained off a limited rs');
+
+
+my $joined_cd_rs = $cd_rs->search ({}, {
+ join => 'tracks', rows => 2, distinct => 1, having => \ 'count(tracks.trackid) > 2',
+});
+
+my $multiple_track_count = $schema->resultset('Track')->search ({
+ cd => { -in => $joined_cd_rs->get_column ('cdid')->as_query }
+})->count;
+
+
+is (
+ $joined_cd_rs->search_related ('tracks')->count,
+ $multiple_track_count,
+ 'related->count returns correct number chained off a grouped rs',
+);
+is (
+ scalar ($joined_cd_rs->search_related ('tracks')->all),
+ $multiple_track_count,
+ 'related->all returns correct number of objects chained off a grouped rs',
+);
+
+done_testing;
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/delete/complex.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/delete/complex.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/delete/complex.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,35 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+my $artist_rs = $schema->resultset ('Artist');
+
+my $init_count = $artist_rs->count;
+ok ($init_count, 'Some artists is database');
+
+$artist_rs->populate ([
+ {
+ name => 'foo',
+ },
+ {
+ name => 'bar',
+ }
+]);
+
+is ($artist_rs->count, $init_count + 2, '2 Artists created');
+
+$artist_rs->search ({
+ -and => [
+ { 'me.artistid' => { '!=', undef } },
+ [ { 'me.name' => 'foo' }, { 'me.name' => 'bar' } ],
+ ],
+})->delete;
+
+is ($artist_rs->count, $init_count, 'Correct amount of artists deleted');
+
+done_testing;
+
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/from_subquery.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/from_subquery.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/from_subquery.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,5 +1,5 @@
use strict;
-use warnings FATAL => 'all';
+use warnings;
use Test::More;
@@ -20,7 +20,7 @@
is_same_sql_bind(
$cdrs2->as_query,
- "(SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE artist_id IN ( SELECT id FROM artist me LIMIT 1 ))",
+ "(SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE artist_id IN ( SELECT id FROM artist me LIMIT 1 ))",
[],
);
}
@@ -73,7 +73,9 @@
is_same_sql_bind(
$rs->as_query,
- "(SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track FROM (SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE ( id > ? ) ) cd2)",
+ "(SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track FROM (
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE ( id > ? )
+ ) cd2)",
[
[ 'id', 20 ]
],
@@ -119,11 +121,11 @@
is_same_sql_bind(
$rs->as_query,
- "(SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track
- FROM
- (SELECT cd3.cdid,cd3.artist,cd3.title,cd3.year,cd3.genreid,cd3.single_track
- FROM
- (SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track
+ "(SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track
+ FROM
+ (SELECT cd3.cdid, cd3.artist, cd3.title, cd3.year, cd3.genreid, cd3.single_track
+ FROM
+ (SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
FROM cd me WHERE ( id < ? ) ) cd3
WHERE ( id > ? ) ) cd2)",
[
@@ -163,7 +165,9 @@
is_same_sql_bind(
$rs->as_query,
- "(SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track FROM (SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE ( title = ? ) ) cd2)",
+ "(SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track FROM (
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE ( title = ? )
+ ) cd2)",
[ [ 'title', 'Thriller' ] ],
);
}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/core.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/core.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/core.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -16,8 +16,10 @@
deflate => sub { shift->year } }
);
+my $rs = $schema->resultset('CD');
+
# inflation test
-my $cd = $schema->resultset("CD")->find(3);
+my $cd = $rs->find(3);
is( ref($cd->year), 'DateTime', 'year is a DateTime, ok' );
@@ -45,7 +47,7 @@
$cd->year( $now );
$cd->update;
-$cd = $schema->resultset("CD")->find(3);
+$cd = $rs->find(3);
is( $cd->year->year, $now->year, 'deflate ok' );
# set_inflated_column test
@@ -53,29 +55,23 @@
ok(!$@, 'set_inflated_column with DateTime object');
$cd->update;
-$cd = $schema->resultset("CD")->find(3);
+$cd = $rs->find(3);
is( $cd->year->year, $now->year, 'deflate ok' );
-$cd = $schema->resultset("CD")->find(3);
+$cd = $rs->find(3);
my $before_year = $cd->year->year;
eval { $cd->set_inflated_column('year', \'year + 1') };
ok(!$@, 'set_inflated_column to "year + 1"');
$cd->update;
-TODO: {
- local $TODO = 'this was left in without a TODO - should it work?';
+$cd->store_inflated_column('year', \'year + 1');
+is_deeply( $cd->year, \'year + 1', 'scalarref deflate passthrough ok' );
- lives_ok (sub {
- $cd->store_inflated_column('year', \'year + 1');
- is_deeply( $cd->year, \'year + 1', 'deflate ok' );
- }, 'store_inflated_column to "year + 1"');
-}
-
-$cd = $schema->resultset("CD")->find(3);
+$cd = $rs->find(3);
is( $cd->year->year, $before_year+1, 'deflate ok' );
# store_inflated_column test
-$cd = $schema->resultset("CD")->find(3);
+$cd = $rs->find(3);
eval { $cd->store_inflated_column('year', $now) };
ok(!$@, 'store_inflated_column with DateTime object');
$cd->update;
@@ -83,21 +79,21 @@
is( $cd->year->year, $now->year, 'deflate ok' );
# update tests
-$cd = $schema->resultset("CD")->find(3);
+$cd = $rs->find(3);
eval { $cd->update({'year' => $now}) };
ok(!$@, 'update using DateTime object ok');
is($cd->year->year, $now->year, 'deflate ok');
-$cd = $schema->resultset("CD")->find(3);
+$cd = $rs->find(3);
$before_year = $cd->year->year;
eval { $cd->update({'year' => \'year + 1'}) };
ok(!$@, 'update using scalarref ok');
-$cd = $schema->resultset("CD")->find(3);
+$cd = $rs->find(3);
is($cd->year->year, $before_year + 1, 'deflate ok');
# discard_changes test
-$cd = $schema->resultset("CD")->find(3);
+$cd = $rs->find(3);
# inflate the year
$before_year = $cd->year->year;
$cd->update({ year => \'year + 1'});
@@ -107,6 +103,45 @@
my $copy = $cd->copy({ year => $now, title => "zemoose" });
-isnt( $copy->year->year, $before_year, "copy" );
+is( $copy->year->year, $now->year, "copy" );
+
+
+my $artist = $cd->artist;
+my $sval = \ '2012';
+
+$cd = $rs->create ({
+ artist => $artist,
+ year => $sval,
+ title => 'create with scalarref',
+});
+
+is ($cd->year, $sval, 'scalar value retained');
+my $cd2 = $cd->copy ({ title => 'copy with scalar in coldata' });
+is ($cd2->year, $sval, 'copied scalar value retained');
+
+$cd->discard_changes;
+is ($cd->year->year, 2012, 'infation upon reload');
+
+$cd2->discard_changes;
+is ($cd2->year->year, 2012, 'infation upon reload of copy');
+
+
+my $precount = $rs->count;
+$cd = $rs->update_or_create ({artist => $artist, title => 'nonexisting update/create test row', year => $sval });
+is ($rs->count, $precount + 1, 'Row created');
+
+is ($cd->year, $sval, 'scalar value retained on creating update_or_create');
+$cd->discard_changes;
+is ($cd->year->year, 2012, 'infation upon reload');
+
+my $sval2 = \ '2013';
+
+$cd = $rs->update_or_create ({artist => $artist, title => 'nonexisting update/create test row', year => $sval2 });
+is ($rs->count, $precount + 1, 'No more rows created');
+
+is ($cd->year, $sval2, 'scalar value retained on updating update_or_create');
+$cd->discard_changes;
+is ($cd->year->year, 2013, 'infation upon reload');
+
done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/datetime_sybase.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/datetime_sybase.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/datetime_sybase.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -17,21 +17,18 @@
if ($@) {
plan skip_all => 'needs DateTime and DateTime::Format::Sybase for testing';
}
- else {
- plan tests => (4 * 2 * 2) + 2; # (tests * dt_types * storage_types) + storage_tests
- }
}
my @storage_types = (
- 'DBI::Sybase',
- 'DBI::Sybase::NoBindVars',
+ 'DBI::Sybase::ASE',
+ 'DBI::Sybase::ASE::NoBindVars',
);
my $schema;
for my $storage_type (@storage_types) {
$schema = DBICTest::Schema->clone;
- unless ($storage_type eq 'DBI::Sybase') { # autodetect
+ unless ($storage_type eq 'DBI::Sybase::ASE') { # autodetect
$schema->storage_type("::$storage_type");
}
$schema->connection($dsn, $user, $pass, {
@@ -57,9 +54,9 @@
$schema->storage->dbh->do(<<"SQL");
CREATE TABLE track (
trackid INT IDENTITY PRIMARY KEY,
- cd INT,
- position INT,
- $col $type,
+ cd INT NULL,
+ position INT NULL,
+ $col $type NULL
)
SQL
ok(my $dt = DateTime::Format::Sybase->parse_datetime($sample_dt));
@@ -75,8 +72,33 @@
);
is( $row->$col, $dt, 'DateTime roundtrip' );
}
+
+ # test a computed datetime column
+ eval { $schema->storage->dbh->do("DROP TABLE track") };
+ $schema->storage->dbh->do(<<"SQL");
+CREATE TABLE track (
+ trackid INT IDENTITY PRIMARY KEY,
+ cd INT NULL,
+ position INT NULL,
+ title VARCHAR(100) NULL,
+ last_updated_on DATETIME NULL,
+ last_updated_at AS getdate(),
+ small_dt SMALLDATETIME NULL
+)
+SQL
+
+ my $now = DateTime->now;
+ sleep 1;
+ my $new_row = $schema->resultset('Track')->create({});
+ $new_row->discard_changes;
+
+ lives_and {
+ cmp_ok (($new_row->last_updated_at - $now)->seconds, '>=', 1)
+ } 'getdate() computed column works';
}
+done_testing;
+
# clean up our mess
END {
if (my $dbh = eval { $schema->storage->_dbh }) {
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/datetime_sybase_asa.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/datetime_sybase_asa.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/datetime_sybase_asa.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,86 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use lib qw(t/lib);
+use DBICTest;
+
+my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_ASA_${_}" } qw/DSN USER PASS/};
+my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_SYBASE_ASA_ODBC_${_}" } qw/DSN USER PASS/};
+
+if (not ($dsn || $dsn2)) {
+ plan skip_all => <<'EOF';
+Set $ENV{DBICTEST_SYBASE_ASA_DSN} and/or $ENV{DBICTEST_SYBASE_ASA_ODBC_DSN}
+_USER and _PASS to run this test'.
+Warning: This test drops and creates a table called 'track'";
+EOF
+} else {
+ eval "use DateTime; use DateTime::Format::Strptime;";
+ if ($@) {
+ plan skip_all => 'needs DateTime and DateTime::Format::Strptime for testing';
+ }
+}
+
+my @info = (
+ [ $dsn, $user, $pass ],
+ [ $dsn2, $user2, $pass2 ],
+);
+
+my @handles_to_clean;
+
+foreach my $info (@info) {
+ my ($dsn, $user, $pass) = @$info;
+
+ next unless $dsn;
+
+ my $schema = DBICTest::Schema->clone;
+
+ $schema->connection($dsn, $user, $pass, {
+ on_connect_call => [ 'datetime_setup' ],
+ });
+
+ push @handles_to_clean, $schema->storage->dbh;
+
+# coltype, col, date
+ my @dt_types = (
+ ['TIMESTAMP', 'last_updated_at', '2004-08-21 14:36:48.080444'],
+# date only (but minute precision according to ASA docs)
+ ['DATE', 'small_dt', '2004-08-21 00:00:00.000000'],
+ );
+
+ for my $dt_type (@dt_types) {
+ my ($type, $col, $sample_dt) = @$dt_type;
+
+ eval { $schema->storage->dbh->do("DROP TABLE track") };
+ $schema->storage->dbh->do(<<"SQL");
+ CREATE TABLE track (
+ trackid INT IDENTITY PRIMARY KEY,
+ cd INT,
+ position INT,
+ $col $type,
+ )
+SQL
+ ok(my $dt = $schema->storage->datetime_parser->parse_datetime($sample_dt));
+
+ my $row;
+ ok( $row = $schema->resultset('Track')->create({
+ $col => $dt,
+ cd => 1,
+ }));
+ ok( $row = $schema->resultset('Track')
+ ->search({ trackid => $row->trackid }, { select => [$col] })
+ ->first
+ );
+ is( $row->$col, $dt, 'DateTime roundtrip' );
+ }
+}
+
+done_testing;
+
+# clean up our mess
+END {
+ foreach my $dbh (@handles_to_clean) {
+ eval { $dbh->do("DROP TABLE $_") } for qw/track/;
+ }
+}
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/file_column.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/file_column.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/file_column.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -4,7 +4,6 @@
use Test::More;
use lib qw(t/lib);
use DBICTest;
-use IO::File;
use File::Compare;
use Path::Class qw/file/;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/hri.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/hri.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/inflate/hri.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,7 +1,7 @@
use strict;
-use warnings;
+use warnings;
-use Test::More qw(no_plan);
+use Test::More;
use lib qw(t/lib);
use DBICTest;
my $schema = DBICTest->init_schema();
@@ -9,7 +9,7 @@
# Under some versions of SQLite if the $rs is left hanging around it will lock
# So we create a scope here cos I'm lazy
{
- my $rs = $schema->resultset('CD');
+ my $rs = $schema->resultset('CD')->search ({}, { order_by => 'cdid' });
# get the defined columns
my @dbic_cols = sort $rs->result_source->columns;
@@ -23,12 +23,14 @@
my @hashref_cols = sort keys %$datahashref1;
is_deeply( \@dbic_cols, \@hashref_cols, 'returned columns' );
+
+ my $cd1 = $rs->find ({cdid => 1});
+ is_deeply ( $cd1, $datahashref1, 'first/find return the same thing');
}
-
sub check_cols_of {
my ($dbic_obj, $datahashref) = @_;
-
+
foreach my $col (keys %$datahashref) {
# plain column
if (not ref ($datahashref->{$col}) ) {
@@ -42,14 +44,14 @@
elsif (ref ($datahashref->{$col}) eq 'ARRAY') {
my @dbic_reltable = $dbic_obj->$col;
my @hashref_reltable = @{$datahashref->{$col}};
-
- is (scalar @hashref_reltable, scalar @dbic_reltable, 'number of related entries');
+ is (scalar @dbic_reltable, scalar @hashref_reltable, 'number of related entries');
+
# for my $index (0..scalar @hashref_reltable) {
for my $index (0..scalar @dbic_reltable) {
my $dbic_reltable_obj = $dbic_reltable[$index];
my $hashref_reltable_entry = $hashref_reltable[$index];
-
+
check_cols_of($dbic_reltable_obj, $hashref_reltable_entry);
}
}
@@ -135,3 +137,6 @@
[{ $artist->get_columns, cds => [] }],
'nested has_many prefetch without entries'
);
+
+done_testing;
+
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Bogus/A.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Bogus/A.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Bogus/A.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,6 +1,5 @@
package DBICNSTest::Bogus::A;
-use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/PK::Auto Core/);
+use base qw/DBIx::Class::Core/;
__PACKAGE__->table('a');
__PACKAGE__->add_columns('a');
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Bogus/B.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Bogus/B.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Bogus/B.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,6 +1,5 @@
package DBICNSTest::Result::B;
-use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/PK::Auto Core/);
+use base qw/DBIx::Class::Core/;
__PACKAGE__->table('b');
__PACKAGE__->add_columns('b');
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/OtherRslt/D.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/OtherRslt/D.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/OtherRslt/D.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,6 +1,5 @@
package DBICNSTest::OtherRslt::D;
-use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/PK::Auto Core/);
+use base qw/DBIx::Class::Core/;
__PACKAGE__->table('d');
__PACKAGE__->add_columns('d');
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Result/A.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Result/A.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Result/A.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,6 +1,5 @@
package DBICNSTest::Result::A;
-use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/PK::Auto Core/);
+use base qw/DBIx::Class::Core/;
__PACKAGE__->table('a');
__PACKAGE__->add_columns('a');
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Result/B.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Result/B.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Result/B.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,6 +1,5 @@
package DBICNSTest::Result::B;
-use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/PK::Auto Core/);
+use base qw/DBIx::Class::Core/;
__PACKAGE__->table('b');
__PACKAGE__->add_columns('b');
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Rslt/A.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Rslt/A.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Rslt/A.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,6 +1,5 @@
package DBICNSTest::Rslt::A;
-use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/PK::Auto Core/);
+use base qw/DBIx::Class::Core/;
__PACKAGE__->table('a');
__PACKAGE__->add_columns('a');
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Rslt/B.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Rslt/B.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/Rslt/B.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,6 +1,5 @@
package DBICNSTest::Rslt::B;
-use base qw/DBIx::Class/;
-__PACKAGE__->load_components(qw/PK::Auto Core/);
+use base qw/DBIx::Class::Core/;
__PACKAGE__->table('b');
__PACKAGE__->add_columns('b');
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/RtBug41083/Schema/Foo.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/RtBug41083/Schema/Foo.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/RtBug41083/Schema/Foo.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,8 +1,7 @@
package DBICNSTest::RtBug41083::Schema::Foo;
use strict;
use warnings;
-use base 'DBIx::Class';
-__PACKAGE__->load_components('Core');
+use base 'DBIx::Class::Core';
__PACKAGE__->table('foo');
__PACKAGE__->add_columns('foo');
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/RtBug41083/Schema_A/A.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/RtBug41083/Schema_A/A.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICNSTest/RtBug41083/Schema_A/A.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,8 +1,7 @@
package DBICNSTest::RtBug41083::Schema_A::A;
use strict;
use warnings;
-use base 'DBIx::Class';
-__PACKAGE__->load_components('Core');
+use base 'DBIx::Class::Core';
__PACKAGE__->table('a');
__PACKAGE__->add_columns('a');
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/BaseResult.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/BaseResult.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/BaseResult.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -4,10 +4,9 @@
use strict;
use warnings;
-use base qw/DBIx::Class/;
+use base qw/DBIx::Class::Core/;
use DBICTest::BaseResultSet;
-__PACKAGE__->load_components (qw/Core/);
__PACKAGE__->table ('bogus');
__PACKAGE__->resultset_class ('DBICTest::BaseResultSet');
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/ResultSetManager/Foo.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/ResultSetManager/Foo.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/ResultSetManager/Foo.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,8 +1,8 @@
package # hide from PAUSE
DBICTest::ResultSetManager::Foo;
-use base 'DBIx::Class';
+use base 'DBIx::Class::Core';
-__PACKAGE__->load_components(qw/ ResultSetManager Core /);
+__PACKAGE__->load_components(qw/ ResultSetManager /);
__PACKAGE__->table('foo');
sub bar : ResultSet { 'good' }
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Artist.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Artist.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Artist.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -44,6 +44,9 @@
__PACKAGE__->has_many(
cds_unordered => 'DBICTest::Schema::CD'
);
+__PACKAGE__->has_many(
+ cds_very_very_very_long_relationship_name => 'DBICTest::Schema::CD'
+);
__PACKAGE__->has_many( twokeys => 'DBICTest::Schema::TwoKeys' );
__PACKAGE__->has_many( onekeys => 'DBICTest::Schema::OneKey' );
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/CD.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/CD.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/CD.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -26,6 +26,7 @@
'genreid' => {
data_type => 'integer',
is_nullable => 1,
+ accessor => undef,
},
'single_track' => {
data_type => 'integer',
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/ComputedColumn.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/ComputedColumn.pm (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/ComputedColumn.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,34 @@
+package # hide from PAUSE
+ DBICTest::Schema::ComputedColumn;
+
+# for sybase and mssql computed column tests
+
+use base qw/DBICTest::BaseResult/;
+
+__PACKAGE__->table('computed_column_test');
+
+__PACKAGE__->add_columns(
+ 'id' => {
+ data_type => 'integer',
+ is_auto_increment => 1,
+ },
+ 'a_computed_column' => {
+ data_type => undef,
+ is_nullable => 0,
+ default_value => \'getdate()',
+ },
+ 'a_timestamp' => {
+ data_type => 'timestamp',
+ is_nullable => 0,
+ },
+ 'charfield' => {
+ data_type => 'varchar',
+ size => 20,
+ default_value => 'foo',
+ is_nullable => 0,
+ }
+);
+
+__PACKAGE__->set_primary_key('id');
+
+1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Track.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Track.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Track.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -50,4 +50,17 @@
__PACKAGE__->might_have( cd_single => 'DBICTest::Schema::CD', 'single_track' );
__PACKAGE__->might_have( lyrics => 'DBICTest::Schema::Lyrics', 'track_id' );
+__PACKAGE__->belongs_to(
+ "year1999cd",
+ "DBICTest::Schema::Year1999CDs",
+ { "foreign.cdid" => "self.cd" },
+ { join_type => 'left' }, # the relationship is of course optional
+);
+__PACKAGE__->belongs_to(
+ "year2000cd",
+ "DBICTest::Schema::Year2000CDs",
+ { "foreign.cdid" => "self.cd" },
+ { join_type => 'left' },
+);
+
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Year1999CDs.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Year1999CDs.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Year1999CDs.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -9,7 +9,7 @@
__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'"
+ "SELECT cdid, artist, title, single_track FROM cd WHERE year ='1999'"
);
__PACKAGE__->add_columns(
'cdid' => {
@@ -23,9 +23,17 @@
data_type => 'varchar',
size => 100,
},
-
+ 'single_track' => {
+ data_type => 'integer',
+ is_nullable => 1,
+ is_foreign_key => 1,
+ },
);
__PACKAGE__->set_primary_key('cdid');
__PACKAGE__->add_unique_constraint([ qw/artist title/ ]);
+__PACKAGE__->belongs_to( artist => 'DBICTest::Schema::Artist' );
+__PACKAGE__->has_many( tracks => 'DBICTest::Schema::Track',
+ { "foreign.cd" => "self.cdid" });
+
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Year2000CDs.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Year2000CDs.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest/Schema/Year2000CDs.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,30 +1,19 @@
-package # hide from PAUSE
+package # hide from PAUSE
DBICTest::Schema::Year2000CDs;
-## Used in 104view.t
-use base qw/DBICTest::BaseResult/;
+use base qw/DBICTest::Schema::CD/;
__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/ ]);
+# need to operate on the instance for things to work
+__PACKAGE__->result_source_instance->view_definition( sprintf (
+ 'SELECT %s FROM cd WHERE year = "2000"',
+ join (', ', __PACKAGE__->columns),
+));
+__PACKAGE__->belongs_to( artist => 'DBICTest::Schema::Artist' );
+__PACKAGE__->has_many( tracks => 'DBICTest::Schema::Track',
+ { "foreign.cd" => "self.cdid" });
+
1;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICTest.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -32,7 +32,7 @@
no_populate=>1,
storage_type=>'::DBI::Replicated',
storage_type_args=>{
- balancer_type=>'DBIx::Class::Storage::DBI::Replicated::Balancer::Random'
+ balancer_type=>'DBIx::Class::Storage::DBI::Replicated::Balancer::Random'
},
);
@@ -48,7 +48,7 @@
=cut
sub has_custom_dsn {
- return $ENV{"DBICTEST_DSN"} ? 1:0;
+ return $ENV{"DBICTEST_DSN"} ? 1:0;
}
sub _sqlite_dbfilename {
@@ -59,7 +59,7 @@
my $self = shift;
my %args = @_;
return $self->_sqlite_dbfilename if $args{sqlite_use_file} or $ENV{"DBICTEST_SQLITE_USE_FILE"};
- return ":memory:";
+ return ":memory:";
}
sub _database {
@@ -85,7 +85,7 @@
my %args = @_;
my $schema;
-
+
if ($args{compose_connection}) {
$schema = DBICTest::Schema->compose_connection(
'DBICTest', $self->_database(%args)
@@ -94,8 +94,8 @@
$schema = DBICTest::Schema->compose_namespace('DBICTest');
}
if( $args{storage_type}) {
- $schema->storage_type($args{storage_type});
- }
+ $schema->storage_type($args{storage_type});
+ }
if ( !$args{no_connect} ) {
$schema = $schema->connect($self->_database(%args));
$schema->storage->on_connect_do(['PRAGMA synchronous = OFF'])
@@ -127,7 +127,7 @@
my $args = shift || {};
if ($ENV{"DBICTEST_SQLT_DEPLOY"}) {
- $schema->deploy($args);
+ $schema->deploy($args);
} else {
open IN, "t/lib/sqlite.sql";
my $sql;
@@ -155,6 +155,11 @@
my $self = shift;
my $schema = shift;
+ $schema->populate('Genre', [
+ [qw/genreid name/],
+ [qw/1 emo /],
+ ]);
+
$schema->populate('Artist', [
[ qw/artistid name/ ],
[ 1, 'Caterwauler McCrae' ],
@@ -163,8 +168,8 @@
]);
$schema->populate('CD', [
- [ qw/cdid artist title year/ ],
- [ 1, 1, "Spoonful of bees", 1999 ],
+ [ qw/cdid artist title year genreid/ ],
+ [ 1, 1, "Spoonful of bees", 1999, 1 ],
[ 2, 1, "Forkful of bees", 2001 ],
[ 3, 1, "Caterwaulin' Blues", 1997 ],
[ 4, 2, "Generic Manufactured Singles", 2001 ],
@@ -243,7 +248,7 @@
$schema->populate('TreeLike', [
[ qw/id parent name/ ],
- [ 1, undef, 'root' ],
+ [ 1, undef, 'root' ],
[ 2, 1, 'foo' ],
[ 3, 2, 'bar' ],
[ 6, 2, 'blop' ],
Deleted: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersionNew.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersionNew.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersionNew.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,56 +0,0 @@
-package DBICVersion::Table;
-
-use base 'DBIx::Class';
-use strict;
-use warnings;
-
-__PACKAGE__->load_components(qw/ Core/);
-__PACKAGE__->table('TestVersion');
-
-__PACKAGE__->add_columns
- ( 'Version' => {
- 'data_type' => 'INTEGER',
- 'is_auto_increment' => 1,
- 'default_value' => undef,
- 'is_foreign_key' => 0,
- 'is_nullable' => 0,
- 'size' => ''
- },
- 'VersionName' => {
- 'data_type' => 'VARCHAR',
- 'is_auto_increment' => 0,
- 'default_value' => undef,
- 'is_foreign_key' => 0,
- 'is_nullable' => 0,
- 'size' => '10'
- },
- 'NewVersionName' => {
- 'data_type' => 'VARCHAR',
- 'is_auto_increment' => 0,
- 'default_value' => undef,
- 'is_foreign_key' => 0,
- 'is_nullable' => 1,
- 'size' => '20'
- }
- );
-
-__PACKAGE__->set_primary_key('Version');
-
-package DBICVersion::Schema;
-use base 'DBIx::Class::Schema';
-use strict;
-use warnings;
-
-our $VERSION = '2.0';
-
-__PACKAGE__->register_class('Table', 'DBICVersion::Table');
-__PACKAGE__->load_components('+DBIx::Class::Schema::Versioned');
-__PACKAGE__->upgrade_directory('t/var/');
-__PACKAGE__->backup_directory('t/var/backup/');
-
-#sub upgrade_directory
-#{
-# return 't/var/';
-#}
-
-1;
Deleted: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersionOrig.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersionOrig.pm 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersionOrig.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,46 +0,0 @@
-package DBICVersion::Table;
-
-use base 'DBIx::Class';
-use strict;
-use warnings;
-
-__PACKAGE__->load_components(qw/ Core/);
-__PACKAGE__->table('TestVersion');
-
-__PACKAGE__->add_columns
- ( 'Version' => {
- 'data_type' => 'INTEGER',
- 'is_auto_increment' => 1,
- 'default_value' => undef,
- 'is_foreign_key' => 0,
- 'is_nullable' => 0,
- 'size' => ''
- },
- 'VersionName' => {
- 'data_type' => 'VARCHAR',
- 'is_auto_increment' => 0,
- 'default_value' => undef,
- 'is_foreign_key' => 0,
- 'is_nullable' => 0,
- 'size' => '10'
- },
- );
-
-__PACKAGE__->set_primary_key('Version');
-
-package DBICVersion::Schema;
-use base 'DBIx::Class::Schema';
-use strict;
-use warnings;
-
-our $VERSION = '1.0';
-
-__PACKAGE__->register_class('Table', 'DBICVersion::Table');
-__PACKAGE__->load_components('+DBIx::Class::Schema::Versioned');
-
-sub upgrade_directory
-{
- return 't/var/';
-}
-
-1;
Copied: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersion_v1.pm (from rev 7836, DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersionOrig.pm)
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersion_v1.pm (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersion_v1.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,49 @@
+package DBICVersion::Table;
+
+use base 'DBIx::Class::Core';
+use strict;
+use warnings;
+
+__PACKAGE__->table('TestVersion');
+
+__PACKAGE__->add_columns
+ ( 'Version' => {
+ 'data_type' => 'INTEGER',
+ 'is_auto_increment' => 1,
+ 'default_value' => undef,
+ 'is_foreign_key' => 0,
+ 'is_nullable' => 0,
+ 'size' => ''
+ },
+ 'VersionName' => {
+ 'data_type' => 'VARCHAR',
+ 'is_auto_increment' => 0,
+ 'default_value' => undef,
+ 'is_foreign_key' => 0,
+ 'is_nullable' => 0,
+ 'size' => '10'
+ },
+ );
+
+__PACKAGE__->set_primary_key('Version');
+
+package DBICVersion::Schema;
+use base 'DBIx::Class::Schema';
+use strict;
+use warnings;
+
+our $VERSION = '1.0';
+
+__PACKAGE__->register_class('Table', 'DBICVersion::Table');
+__PACKAGE__->load_components('+DBIx::Class::Schema::Versioned');
+
+sub upgrade_directory
+{
+ return 't/var/';
+}
+
+sub ordered_schema_versions {
+ return('1.0','2.0','3.0');
+}
+
+1;
Copied: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersion_v2.pm (from rev 7836, DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersionNew.pm)
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersion_v2.pm (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersion_v2.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,55 @@
+package DBICVersion::Table;
+
+use base 'DBIx::Class::Core';
+use strict;
+use warnings;
+
+__PACKAGE__->table('TestVersion');
+
+__PACKAGE__->add_columns
+ ( 'Version' => {
+ 'data_type' => 'INTEGER',
+ 'is_auto_increment' => 1,
+ 'default_value' => undef,
+ 'is_foreign_key' => 0,
+ 'is_nullable' => 0,
+ 'size' => ''
+ },
+ 'VersionName' => {
+ 'data_type' => 'VARCHAR',
+ 'is_auto_increment' => 0,
+ 'default_value' => undef,
+ 'is_foreign_key' => 0,
+ 'is_nullable' => 0,
+ 'size' => '10'
+ },
+ 'NewVersionName' => {
+ 'data_type' => 'VARCHAR',
+ 'is_auto_increment' => 0,
+ 'default_value' => undef,
+ 'is_foreign_key' => 0,
+ 'is_nullable' => 1,
+ 'size' => '20'
+ }
+ );
+
+__PACKAGE__->set_primary_key('Version');
+
+package DBICVersion::Schema;
+use base 'DBIx::Class::Schema';
+use strict;
+use warnings;
+
+our $VERSION = '2.0';
+
+__PACKAGE__->register_class('Table', 'DBICVersion::Table');
+__PACKAGE__->load_components('+DBIx::Class::Schema::Versioned');
+__PACKAGE__->upgrade_directory('t/var/');
+__PACKAGE__->backup_directory('t/var/backup/');
+
+#sub upgrade_directory
+#{
+# return 't/var/';
+#}
+
+1;
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersion_v3.pm
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersion_v3.pm (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersion_v3.pm 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,58 @@
+package DBICVersion::Table;
+
+use base 'DBIx::Class::Core';
+use strict;
+use warnings;
+
+__PACKAGE__->table('TestVersion');
+
+__PACKAGE__->add_columns
+ ( 'Version' => {
+ 'data_type' => 'INTEGER',
+ 'is_auto_increment' => 1,
+ 'default_value' => undef,
+ 'is_foreign_key' => 0,
+ 'is_nullable' => 0,
+ 'size' => ''
+ },
+ 'VersionName' => {
+ 'data_type' => 'VARCHAR',
+ 'is_auto_increment' => 0,
+ 'default_value' => undef,
+ 'is_foreign_key' => 0,
+ 'is_nullable' => 0,
+ 'size' => '10'
+ },
+ 'NewVersionName' => {
+ 'data_type' => 'VARCHAR',
+ 'is_auto_increment' => 0,
+ 'default_value' => undef,
+ 'is_foreign_key' => 0,
+ 'is_nullable' => 1,
+ 'size' => '20'
+ },
+ 'ExtraColumn' => {
+ 'data_type' => 'VARCHAR',
+ 'is_auto_increment' => 0,
+ 'default_value' => undef,
+ 'is_foreign_key' => 0,
+ 'is_nullable' => 1,
+ 'size' => '20'
+ }
+ );
+
+__PACKAGE__->set_primary_key('Version');
+
+package DBICVersion::Schema;
+use base 'DBIx::Class::Schema';
+use strict;
+use warnings;
+
+our $VERSION = '3.0';
+
+__PACKAGE__->register_class('Table', 'DBICVersion::Table');
+__PACKAGE__->load_components('+DBIx::Class::Schema::Versioned');
+__PACKAGE__->upgrade_directory('t/var/');
+__PACKAGE__->backup_directory('t/var/backup/');
+
+1;
Property changes on: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/DBICVersion_v3.pm
___________________________________________________________________
Name: svn:keywords
+ "Author Date Id Revision Url"
Name: svn:eol-style
+ native
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/sqlite.sql
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/sqlite.sql 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/lib/sqlite.sql 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,9 +1,9 @@
--- Created on Tue Aug 25 12:34:34 2009
--
+-- Created by SQL::Translator::Producer::SQLite
+-- Created on Sat Jan 30 19:18:55 2010
+--
+;
-
-BEGIN TRANSACTION;
-
--
-- Table: artist
--
@@ -260,8 +260,6 @@
cd integer NOT NULL
);
-CREATE INDEX forceforeign_idx_artist ON forceforeign (artist);
-
--
-- Table: self_ref_alias
--
@@ -344,8 +342,6 @@
cd_id INTEGER PRIMARY KEY NOT NULL
);
-CREATE INDEX cd_artwork_idx_cd_id ON cd_artwork (cd_id);
-
--
-- Table: liner_notes
--
@@ -354,8 +350,6 @@
notes varchar(100) NOT NULL
);
-CREATE INDEX liner_notes_idx_liner_id ON liner_notes (liner_id);
-
--
-- Table: lyric_versions
--
@@ -451,6 +445,4 @@
-- View: year2000cds
--
CREATE VIEW year2000cds AS
- SELECT cdid, artist, title FROM cd WHERE year ='2000';
-
-COMMIT;
+ SELECT cdid, artist, title, year, genreid, single_track FROM cd WHERE year = "2000"
\ No newline at end of file
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/multi_create/standard.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/multi_create/standard.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/multi_create/standard.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -72,7 +72,7 @@
],
});
},
- qr/Recursive update is not supported over relationships of type multi/,
+ qr/Recursive update is not supported over relationships of type 'multi'/,
'create via update of multi relationships throws an exception'
);
@@ -329,60 +329,60 @@
}, 'Nested find_or_create');
lives_ok ( sub {
- my $artist = $schema->resultset('Artist')->first;
-
- my $cd_result = $artist->create_related('cds', {
-
- title => 'TestOneCD1',
- year => 2007,
- tracks => [
- { title => 'TrackOne' },
- { title => 'TrackTwo' },
- ],
+ my $artist = $schema->resultset('Artist')->first;
+
+ my $cd_result = $artist->create_related('cds', {
+
+ title => 'TestOneCD1',
+ year => 2007,
+ tracks => [
+ { title => 'TrackOne' },
+ { title => 'TrackTwo' },
+ ],
- });
-
- isa_ok( $cd_result, 'DBICTest::CD', "Got Good CD Class");
- ok( $cd_result->title eq "TestOneCD1", "Got Expected Title");
-
- my $tracks = $cd_result->tracks;
-
- isa_ok( $tracks, 'DBIx::Class::ResultSet', 'Got Expected Tracks ResultSet');
-
- foreach my $track ($tracks->all)
- {
- isa_ok( $track, 'DBICTest::Track', 'Got Expected Track Class');
- }
+ });
+
+ isa_ok( $cd_result, 'DBICTest::CD', "Got Good CD Class");
+ ok( $cd_result->title eq "TestOneCD1", "Got Expected Title");
+
+ my $tracks = $cd_result->tracks;
+
+ isa_ok( $tracks, 'DBIx::Class::ResultSet', 'Got Expected Tracks ResultSet');
+
+ foreach my $track ($tracks->all)
+ {
+ isa_ok( $track, 'DBICTest::Track', 'Got Expected Track Class');
+ }
}, 'First create_related pass');
lives_ok ( sub {
- my $artist = $schema->resultset('Artist')->first;
-
- my $cd_result = $artist->create_related('cds', {
-
- title => 'TestOneCD2',
- year => 2007,
- tracks => [
- { title => 'TrackOne' },
- { title => 'TrackTwo' },
- ],
+ my $artist = $schema->resultset('Artist')->first;
+
+ my $cd_result = $artist->create_related('cds', {
+
+ title => 'TestOneCD2',
+ year => 2007,
+ tracks => [
+ { title => 'TrackOne' },
+ { title => 'TrackTwo' },
+ ],
liner_notes => { notes => 'I can haz liner notes?' },
- });
-
- isa_ok( $cd_result, 'DBICTest::CD', "Got Good CD Class");
- ok( $cd_result->title eq "TestOneCD2", "Got Expected Title");
+ });
+
+ isa_ok( $cd_result, 'DBICTest::CD', "Got Good CD Class");
+ ok( $cd_result->title eq "TestOneCD2", "Got Expected Title");
ok( $cd_result->notes eq 'I can haz liner notes?', 'Liner notes');
-
- my $tracks = $cd_result->tracks;
-
- isa_ok( $tracks, 'DBIx::Class::ResultSet', "Got Expected Tracks ResultSet");
-
- foreach my $track ($tracks->all)
- {
- isa_ok( $track, 'DBICTest::Track', 'Got Expected Track Class');
- }
+
+ my $tracks = $cd_result->tracks;
+
+ isa_ok( $tracks, 'DBIx::Class::ResultSet', "Got Expected Tracks ResultSet");
+
+ foreach my $track ($tracks->all)
+ {
+ isa_ok( $track, 'DBICTest::Track', 'Got Expected Track Class');
+ }
}, 'second create_related with same arguments');
lives_ok ( sub {
@@ -409,7 +409,7 @@
is($a->name, 'Kurt Cobain', 'Artist insertion ok');
is($a->cds && $a->cds->first && $a->cds->first->title,
- 'In Utero', 'CD insertion ok');
+ 'In Utero', 'CD insertion ok');
}, 'populate');
## Create foreign key col obj including PK
@@ -431,7 +431,7 @@
}, 'Create foreign key col obj including PK');
lives_ok ( sub {
- $schema->resultset("CD")->create({
+ $schema->resultset("CD")->create({
cdid => 28,
title => 'Boogie Wiggle',
year => '2007',
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/diamond.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/diamond.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/diamond.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -96,12 +96,12 @@
}
}
-plan tests => (scalar (keys %tests) * 3);
-
foreach my $name (keys %tests) {
foreach my $artwork ($tests{$name}->all()) {
is($artwork->id, 1, $name . ', correct artwork');
is($artwork->cd->artist->artistid, 1, $name . ', correct artist_id over cd');
is($artwork->artwork_to_artist->first->artist->artistid, 2, $name . ', correct artist_id over A2A');
}
-}
\ No newline at end of file
+}
+
+done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/double_prefetch.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/double_prefetch.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/double_prefetch.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -27,7 +27,7 @@
single_track_2.trackid, single_track_2.cd, single_track_2.position, single_track_2.title, single_track_2.last_updated_on, single_track_2.last_updated_at, single_track_2.small_dt,
cd.cdid, cd.artist, cd.title, cd.year, cd.genreid, cd.single_track
FROM artist me
- LEFT JOIN cd cds ON cds.artist = me.artistid
+ JOIN cd cds ON cds.artist = me.artistid
LEFT JOIN track single_track ON single_track.trackid = cds.single_track
LEFT JOIN track single_track_2 ON single_track_2.trackid = cds.single_track
LEFT JOIN cd cd ON cd.cdid = single_track_2.cd
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/grouped.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/grouped.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/grouped.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -87,12 +87,12 @@
'(
SELECT me.cd, me.track_count, cd.cdid, cd.artist, cd.title, cd.year, cd.genreid, cd.single_track
FROM (
- SELECT me.cd, COUNT (me.trackid) AS track_count,
+ SELECT me.cd, COUNT (me.trackid) AS track_count
FROM track me
JOIN cd cd ON cd.cdid = me.cd
WHERE ( me.cd IN ( ?, ?, ?, ?, ? ) )
GROUP BY me.cd
- ) as me
+ ) me
JOIN cd cd ON cd.cdid = me.cd
WHERE ( me.cd IN ( ?, ?, ?, ?, ? ) )
)',
@@ -148,8 +148,6 @@
FROM (
SELECT me.cdid
FROM cd me
- LEFT JOIN track tracks ON tracks.cd = me.cdid
- LEFT JOIN liner_notes liner_notes ON liner_notes.liner_id = me.cdid
WHERE ( me.cdid IS NOT NULL )
GROUP BY me.cdid
LIMIT 2
@@ -166,7 +164,7 @@
tracks.trackid, tracks.cd, tracks.position, tracks.title, tracks.last_updated_on, tracks.last_updated_at, tracks.small_dt,
liner_notes.liner_id, liner_notes.notes
FROM (
- SELECT me.cdid, COUNT( tracks.trackid ) AS track_count, MAX( tracks.trackid ) AS maxtr,
+ SELECT me.cdid, COUNT( tracks.trackid ) AS track_count, MAX( tracks.trackid ) AS maxtr
FROM cd me
LEFT JOIN track tracks ON tracks.cd = me.cdid
WHERE ( me.cdid IS NOT NULL )
@@ -217,11 +215,11 @@
$rs->as_query,
'(
SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
- tags.tagid, tags.cd, tags.tag
+ tags.tagid, tags.cd, tags.tag
FROM (
SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
FROM cd me
- GROUP BY me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+ GROUP BY me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track, cdid
ORDER BY cdid
) me
LEFT JOIN tags tags ON tags.cd = me.cdid
@@ -329,4 +327,28 @@
);
}
+{
+ my $rs = $schema->resultset('CD')->search({},
+ {
+ '+select' => [{ count => 'tags.tag' }],
+ '+as' => ['test_count'],
+ prefetch => ['tags'],
+ distinct => 1,
+ order_by => {'-asc' => 'tags.tag'},
+ rows => 1
+ }
+ );
+ is_same_sql_bind($rs->as_query, q{
+ (SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track, me.test_count, tags.tagid, tags.cd, tags.tag
+ FROM (SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track, COUNT( tags.tag ) AS test_count
+ FROM cd me LEFT JOIN tags tags ON tags.cd = me.cdid
+ GROUP BY me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track, tags.tag
+ ORDER BY tags.tag ASC LIMIT 1)
+ me
+ LEFT JOIN tags tags ON tags.cd = me.cdid
+ ORDER BY tags.tag ASC, tags.cd, tags.tag
+ )
+ }, []);
+}
+
done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/multiple_hasmany.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/multiple_hasmany.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/multiple_hasmany.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -7,12 +7,9 @@
use DBICTest;
use IO::File;
-plan tests => 10;
-
my $schema = DBICTest->init_schema();
my $sdebug = $schema->storage->debug;
-
# once the following TODO is complete, remove the 2 warning tests immediately
# after the TODO block
# (the TODO block itself contains tests ensuring that the warns are removed)
@@ -102,44 +99,4 @@
is (@w, 1, 'warning on attempt prefetching several same level has_manys (M -> 1 -> M + M)');
}
-__END__
-The solution is to rewrite ResultSet->_collapse_result() and
-ResultSource->resolve_prefetch() to focus on the final results from the collapse
-of the data. Right now, the code doesn't treat the columns from the various
-tables as grouped entities. While there is a concept of hierarchy (so that
-prefetching down relationships does work as expected), there is no idea of what
-the final product should look like and how the various columns in the row would
-play together. So, the actual prefetch datastructure from the search would be
-very useful in working through this problem. We already have access to the PKs
-and sundry for those. So, when collapsing the search result, we know we are
-looking for 1 cd object. We also know we're looking for tracks and tags records
--independently- of each other. So, we can grab the data for tracks and data for
-tags separately, uniqueing on the PK as appropriate. Then, when we're done with
-the given cd object's datastream, we know we're good. This should work for all
-the various scenarios.
-
-My reccommendation is the row's data is preprocessed first, breaking it up into
-the data for each of the component tables. (This could be done in the single
-table case, too, but probably isn't necessary.) So, starting with something
-like:
- my $row = {
- t1.col1 => 1,
- t1.col2 => 2,
- t2.col1 => 3,
- t2.col2 => 4,
- t3.col1 => 5,
- t3.col2 => 6,
- };
-it is massaged to look something like:
- my $row_massaged = {
- t1 => { col1 => 1, col2 => 2 },
- t2 => { col1 => 3, col2 => 4 },
- t3 => { col1 => 5, col2 => 6 },
- };
-At this point, find the stuff that's different is easy enough to do and slotting
-things into the right spot is, likewise, pretty straightforward. Instead of
-storing things in a AoH, store them in a HoH keyed on the PKs of the the table,
-then convert to an AoH after all collapsing is done.
-
-This implies that the collapse attribute can probably disappear or, at the
-least, be turned into a boolean (which is how it's used in every other place).
+done_testing;
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/one_to_many_to_one.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/one_to_many_to_one.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/one_to_many_to_one.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,35 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+my $artist = $schema->resultset ('Artist')->find ({artistid => 1});
+is ($artist->cds->count, 3, 'Correct number of CDs');
+is ($artist->cds->search_related ('genre')->count, 1, 'Only one of the cds has a genre');
+
+my $queries = 0;
+my $orig_cb = $schema->storage->debugcb;
+$schema->storage->debugcb(sub { $queries++ });
+$schema->storage->debug(1);
+
+
+my $pref = $schema->resultset ('Artist')
+ ->search ({ 'me.artistid' => $artist->id }, { prefetch => { cds => 'genre' } })
+ ->next;
+
+is ($pref->cds->count, 3, 'Correct number of CDs prefetched');
+is ($pref->cds->search_related ('genre')->count, 1, 'Only one of the prefetched cds has a prefetched genre');
+
+
+is ($queries, 1, 'All happened within one query only');
+$schema->storage->debugcb($orig_cb);
+$schema->storage->debug(0);
+
+
+done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/standard.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/standard.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/standard.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -5,7 +5,6 @@
use Test::Exception;
use lib qw(t/lib);
use DBICTest;
-use IO::File;
my $schema = DBICTest->init_schema();
my $orig_debug = $schema->storage->debug;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/via_search_related.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/via_search_related.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/via_search_related.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -37,7 +37,37 @@
}, 'search_related prefetch with order_by works');
+TODO: { local $TODO = 'Unqualified columns in where clauses can not be fixed without an SQLA rewrite' if SQL::Abstract->VERSION < 2;
+lives_ok ( sub {
+ my $no_prefetch = $schema->resultset('Track')->search_related(cd =>
+ {
+ 'cd.year' => "2000",
+ 'tagid' => 1,
+ },
+ {
+ join => 'tags',
+ rows => 1,
+ }
+ );
+ my $use_prefetch = $no_prefetch->search(
+ undef,
+ {
+ prefetch => 'tags',
+ }
+ );
+
+ is(
+ scalar ($use_prefetch->all),
+ scalar ($no_prefetch->all),
+ "Amount of returned rows is right"
+ );
+ is($use_prefetch->count, $no_prefetch->count, 'counts with and without prefetch match');
+
+}, 'search_related prefetch with condition referencing unqualified column of a joined table works');
+}
+
+
lives_ok (sub {
my $rs = $schema->resultset("Artwork")->search(undef, {distinct => 1})
->search_related('artwork_to_artist')->search_related('artist',
@@ -79,27 +109,31 @@
is($rs->search_related('cds')->count, 4, 'prefetch without distinct (count)');
- $rs = $artist_rs->search(undef, {distinct => 1})
- ->search_related('cds')->search_related('genre',
+ $rs = $artist_rs->search_related('cds', {}, { distinct => 1})->search_related('genre',
{ 'genre.name' => 'vague genre' },
);
+ is($rs->all, 2, 'distinct does not propagate over search_related (objects)');
+ is($rs->count, 2, 'distinct does not propagate over search_related (count)');
+
+ $rs = $rs->search ({}, { distinct => 1} );
is($rs->all, 1, 'distinct without prefetch (objects)');
is($rs->count, 1, 'distinct without prefetch (count)');
- $rs = $artist_rs->search({}, {distinct => 1})
- ->search_related('cds')->search_related('genre',
+ $rs = $artist_rs->search_related('cds')->search_related('genre',
{ 'genre.name' => 'vague genre' },
- { prefetch => 'cds' },
+ { prefetch => 'cds', distinct => 1 },
);
is($rs->all, 1, 'distinct with prefetch (objects)');
is($rs->count, 1, 'distinct with prefetch (count)');
+
+ TODO: {
+ local $TODO = "This makes another 2 trips to the database, it can't be right";
# artist -> 2 cds -> 2 genres -> 2 cds for each genre + distinct = 2
is($rs->search_related('cds')->all, 2, 'prefetched distinct with prefetch (objects)');
is($rs->search_related('cds')->count, 2, 'prefetched distinct with prefetch (count)');
+ }
-
-
}, 'distinct generally works with prefetch on deep search_related chains');
done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/with_limit.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/with_limit.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/prefetch/with_limit.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -8,8 +8,6 @@
use lib qw(t/lib);
use DBICTest;
-plan tests => 9;
-
my $schema = DBICTest->init_schema();
@@ -25,6 +23,8 @@
my $use_prefetch = $no_prefetch->search(
{},
{
+ select => ['me.artistid', 'me.name'],
+ as => ['artistid', 'name'],
prefetch => 'cds',
order_by => { -desc => 'name' },
}
@@ -90,3 +90,4 @@
my $artist2 = $use_prefetch->search({'cds.title' => { '!=' => $artist_many_cds->cds->first->title } })->slice (0,0)->next;
is($artist2->cds->count, 2, "count on search limiting prefetched has_many");
+done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/relationship/core.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/relationship/core.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/relationship/core.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -133,7 +133,7 @@
year => 2007,
} );
is( $cd->title, 'Greatest Hits 2: Louder Than Ever', 'find_or_new_related new record ok' );
-ok( ! $cd->in_storage, 'find_or_new_related on a new record: not in_storage' );
+is( $cd->in_storage, 0, 'find_or_new_related on a new record: not in_storage' );
$cd->artist(undef);
my $newartist = $cd->find_or_new_related( 'artist', {
@@ -268,7 +268,7 @@
'(
SELECT artist_undirected_maps.id1, artist_undirected_maps.id2
FROM artist me
- LEFT JOIN artist_undirected_map artist_undirected_maps
+ JOIN artist_undirected_map artist_undirected_maps
ON artist_undirected_maps.id1 = me.artistid OR artist_undirected_maps.id2 = me.artistid
WHERE ( artistid = ? )
)',
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/as_query.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/as_query.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/as_query.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -1,7 +1,5 @@
-#!/usr/bin/perl
-
use strict;
-use warnings FATAL => 'all';
+use warnings;
use Test::More;
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/as_subselect_rs.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/as_subselect_rs.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/as_subselect_rs.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,25 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+my $schema = DBICTest->init_schema();
+
+my $new_rs = $schema->resultset('Artist')->search({
+ 'artwork_to_artist.artist_id' => 1
+}, {
+ join => 'artwork_to_artist'
+});
+lives_ok { $new_rs->count } 'regular search works';
+lives_ok { $new_rs->search({ 'artwork_to_artist.artwork_cd_id' => 1})->count }
+ '... and chaining off that using join works';
+lives_ok { $new_rs->search({ 'artwork_to_artist.artwork_cd_id' => 1})->as_subselect_rs->count }
+ '... and chaining off the virtual view works';
+dies_ok { $new_rs->as_subselect_rs->search({'artwork_to_artist.artwork_cd_id'=> 1})->count }
+ q{... but chaining off of a virtual view using join doesn't work};
+done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/is_paged.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/is_paged.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/is_paged.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -16,4 +16,3 @@
ok $paginated->is_paged, 'resultset is paginated now';
done_testing;
-
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/nulls_only.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/nulls_only.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/nulls_only.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,29 @@
+use strict;
+use warnings;
+
+use lib qw(t/lib);
+use Test::More;
+use Test::Exception;
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+
+my $cd_rs = $schema->resultset('CD')->search ({ genreid => undef }, { columns => [ 'genreid' ]} );
+my $count = $cd_rs->count;
+cmp_ok ( $count, '>', 1, 'several CDs with no genre');
+
+my @objects = $cd_rs->all;
+is (scalar @objects, $count, 'Correct amount of objects without limit');
+isa_ok ($_, 'DBICTest::CD') for @objects;
+
+is_deeply (
+ [ map { values %{{$_->get_columns}} } (@objects) ],
+ [ (undef) x $count ],
+ 'All values are indeed undef'
+);
+
+
+isa_ok ($cd_rs->search ({}, { rows => 1 })->single, 'DBICTest::CD');
+
+done_testing;
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/plus_select.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/plus_select.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/plus_select.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,63 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+my $cd_rs = $schema->resultset('CD')->search ({genreid => { '!=', undef } }, { order_by => 'cdid' });
+my $track_cnt = $cd_rs->search({}, { rows => 1 })->search_related ('tracks')->count;
+
+my %basecols = $cd_rs->first->get_columns;
+
+# the current implementation of get_inflated_columns will "inflate"
+# relationships by simply calling the accessor, when you have
+# identically named columns and relationships (you shouldn't anyway)
+# I consider this wrong, but at the same time appreciate the
+# ramifications of changing this. Thus the value override and the
+# TODO to go with it. Delete all of this if ever resolved.
+my %todo_rel_inflation_override = ( artist => $basecols{artist} );
+TODO: {
+ local $TODO = 'Treating relationships as inflatable data is wrong - see comment in ' . __FILE__;
+ ok (! keys %todo_rel_inflation_override);
+}
+
+my $plus_rs = $cd_rs->search (
+ {},
+ { join => 'tracks', distinct => 1, '+select' => { count => 'tracks.trackid' }, '+as' => 'tr_cnt' },
+);
+
+is_deeply (
+ { $plus_rs->first->get_columns },
+ { %basecols, tr_cnt => $track_cnt },
+ 'extra columns returned by get_columns',
+);
+
+is_deeply (
+ { $plus_rs->first->get_inflated_columns, %todo_rel_inflation_override },
+ { %basecols, tr_cnt => $track_cnt },
+ 'extra columns returned by get_inflated_columns without inflatable columns',
+);
+
+SKIP: {
+ eval { require DateTime };
+ skip "Need DateTime for +select/get_inflated_columns tests", 1 if $@;
+
+ $schema->class('CD')->inflate_column( 'year',
+ { inflate => sub { DateTime->new( year => shift ) },
+ deflate => sub { shift->year } }
+ );
+
+ $basecols{year} = DateTime->new ( year => $basecols{year} );
+
+ is_deeply (
+ { $plus_rs->first->get_inflated_columns, %todo_rel_inflation_override },
+ { %basecols, tr_cnt => $track_cnt },
+ 'extra columns returned by get_inflated_columns',
+ );
+}
+
+done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/update_delete.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/update_delete.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/resultset/update_delete.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -79,8 +79,12 @@
);
# grouping on PKs only should pass
-$sub_rs->search ({}, { group_by => [ reverse $sub_rs->result_source->primary_columns ] }) # reverse to make sure the comaprison works
- ->update ({ pilot_sequence => \ 'pilot_sequence + 1' });
+$sub_rs->search (
+ {},
+ {
+ group_by => [ reverse $sub_rs->result_source->primary_columns ], # reverse to make sure the PK-list comaprison works
+ },
+)->update ({ pilot_sequence => \ 'pilot_sequence + 1' });
is_deeply (
[ $tkfks->search ({ autopilot => [qw/a b x y/]}, { order_by => 'autopilot' })
@@ -90,6 +94,19 @@
'Only two rows incremented',
);
+# also make sure weird scalarref usage works (RT#51409)
+$tkfks->search (
+ \ 'pilot_sequence BETWEEN 11 AND 21',
+)->update ({ pilot_sequence => \ 'pilot_sequence + 1' });
+
+is_deeply (
+ [ $tkfks->search ({ autopilot => [qw/a b x y/]}, { order_by => 'autopilot' })
+ ->get_column ('pilot_sequence')->all
+ ],
+ [qw/12 22 30 40/],
+ 'Only two rows incremented (where => scalarref works)',
+);
+
$sub_rs->delete;
is ($tkfks->count, $tkfk_cnt -= 2, 'Only two rows deleted');
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/schema/anon.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/schema/anon.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/schema/anon.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,13 @@
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+use lib qw(t/lib);
+use DBICTest;
+
+lives_ok (sub {
+ DBICTest->init_schema()->resultset('Artist')->find({artistid => 1 })->update({name => 'anon test'});
+}, 'Schema object not lost in chaining');
+
+done_testing;
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/schema/clone.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/schema/clone.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/schema/clone.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,13 @@
+use strict;
+use warnings;
+use Test::More;
+
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+my $clone = $schema->clone;
+cmp_ok ($clone->storage, 'eq', $schema->storage, 'Storage copied into new schema (not a new instance)');
+
+done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/search/preserve_original_rs.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/search/preserve_original_rs.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/search/preserve_original_rs.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -89,4 +89,3 @@
is_same_sql_bind ($rs->as_query, $q{$s}{query}, "$s resultset unmodified (as_query matches)" );
}
-
Added: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/search/related_strip_prefetch.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/search/related_strip_prefetch.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/search/related_strip_prefetch.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,42 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use lib qw(t/lib);
+use DBIC::SqlMakerTest;
+use DBICTest;
+
+my $schema = DBICTest->init_schema();
+
+my $rs = $schema->resultset('CD')->search (
+ { 'tracks.id' => { '!=', 666 }},
+ { join => 'artist', prefetch => 'tracks', rows => 2 }
+);
+
+my $rel_rs = $rs->search_related ('tags', { 'tags.tag' => { '!=', undef }}, { distinct => 1});
+
+is_same_sql_bind (
+ $rel_rs->as_query,
+ '(
+ SELECT tags.tagid, tags.cd, tags.tag
+ FROM (
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
+ FROM cd me
+ JOIN artist artist ON artist.artistid = me.artist
+ LEFT JOIN track tracks ON tracks.cd = me.cdid
+ WHERE ( tracks.id != ? )
+ LIMIT 2
+ ) me
+ JOIN artist artist ON artist.artistid = me.artist
+ JOIN tags tags ON tags.cd = me.cdid
+ WHERE ( tags.tag IS NOT NULL )
+ GROUP BY tags.tagid, tags.cd, tags.tag
+ )',
+
+ [ [ 'tracks.id' => 666 ] ],
+ 'Prefetch spec successfully stripped on search_related'
+);
+
+done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/search/subquery.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/search/subquery.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/search/subquery.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -19,7 +19,7 @@
search => \[ "title = ? AND year LIKE ?", 'buahaha', '20%' ],
attrs => { rows => 5 },
sqlbind => \[
- "( SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE (title = ? AND year LIKE ?) LIMIT 5)",
+ "( SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE (title = ? AND year LIKE ?) LIMIT 5)",
'buahaha',
'20%',
],
@@ -31,7 +31,7 @@
artist_id => { 'in' => $art_rs->search({}, { rows => 1 })->get_column( 'id' )->as_query },
},
sqlbind => \[
- "( SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE artist_id IN ( SELECT id FROM artist me LIMIT 1 ) )",
+ "( SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE artist_id IN ( SELECT id FROM artist me LIMIT 1 ) )",
],
},
@@ -68,7 +68,10 @@
],
},
sqlbind => \[
- "( SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track FROM (SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE id > ?) cd2 )",
+ "( SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track FROM (
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE id > ?
+ ) cd2
+ )",
[ 'id', 20 ]
],
},
@@ -76,9 +79,13 @@
{
rs => $art_rs,
attrs => {
- from => [ { 'me' => 'artist' },
- [ { 'cds' => $cdrs->search({},{ 'select' => [\'me.artist as cds_artist' ]})->as_query },
- { 'me.artistid' => 'cds_artist' } ] ]
+ from => [
+ { 'me' => 'artist' },
+ [
+ { 'cds' => $cdrs->search({}, { 'select' => [\'me.artist as cds_artist' ]})->as_query },
+ { 'me.artistid' => 'cds_artist' }
+ ]
+ ]
},
sqlbind => \[
"( SELECT me.artistid, me.name, me.rank, me.charfield FROM artist me JOIN (SELECT me.artist as cds_artist FROM cd me) cds ON me.artistid = cds_artist )"
@@ -103,9 +110,9 @@
sqlbind => \[
"( SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track
FROM
- (SELECT cd3.cdid,cd3.artist,cd3.title,cd3.year,cd3.genreid,cd3.single_track
+ (SELECT cd3.cdid, cd3.artist, cd3.title, cd3.year, cd3.genreid, cd3.single_track
FROM
- (SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track
+ (SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track
FROM cd me WHERE id < ?) cd3
WHERE id > ?) cd2
)",
@@ -138,7 +145,10 @@
],
},
sqlbind => \[
- "(SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track FROM (SELECT me.cdid,me.artist,me.title,me.year,me.genreid,me.single_track FROM cd me WHERE title = ?) cd2)",
+ "(SELECT cd2.cdid, cd2.artist, cd2.title, cd2.year, cd2.genreid, cd2.single_track FROM (
+ SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE title = ?
+ ) cd2
+ )",
[ 'title',
'Thriller'
]
Copied: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/limit_dialects/toplimit.t (from rev 7836, DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/42toplimit.t)
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/limit_dialects/toplimit.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/limit_dialects/toplimit.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,152 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBIC::SqlMakerTest;
+
+my $schema = DBICTest->init_schema;
+
+# Trick the sqlite DB to use Top limit emulation
+# We could test all of this via $sq->$op directly,
+# but some conditions need a $rsrc
+delete $schema->storage->_sql_maker->{_cached_syntax};
+$schema->storage->_sql_maker->limit_dialect ('Top');
+
+my $rs = $schema->resultset ('BooksInLibrary')->search ({}, { prefetch => 'owner', rows => 1, offset => 3 });
+
+sub default_test_order {
+ my $order_by = shift;
+ is_same_sql_bind(
+ $rs->search ({}, {order_by => $order_by})->as_query,
+ "(SELECT
+ TOP 1 me__id, source, owner, title, price, owner__id, name FROM
+ (SELECT
+ TOP 4 me.id AS me__id, me.source, me.owner, me.title, me.price, owner.id AS owner__id, owner.name
+ FROM books me
+ JOIN owners owner ON
+ owner.id = me.owner
+ WHERE ( source = ? )
+ ORDER BY me__id ASC
+ ) me ORDER BY me__id DESC
+ )",
+ [ [ source => 'Library' ] ],
+ );
+}
+
+sub test_order {
+ my $args = shift;
+
+ my $req_order = $args->{order_req}
+ ? "ORDER BY $args->{order_req}"
+ : ''
+ ;
+
+ is_same_sql_bind(
+ $rs->search ({}, {order_by => $args->{order_by}})->as_query,
+ "(SELECT
+ me__id, source, owner, title, price, owner__id, name FROM
+ (SELECT
+ TOP 1 me__id, source, owner, title, price, owner__id, name FROM
+ (SELECT
+ TOP 4 me.id AS me__id, me.source, me.owner, me.title, me.price, owner.id AS owner__id, owner.name FROM
+ books me
+ JOIN owners owner ON owner.id = me.owner
+ WHERE ( source = ? )
+ ORDER BY $args->{order_inner}
+ ) me ORDER BY $args->{order_outer}
+ ) me $req_order
+ )",
+ [ [ source => 'Library' ] ],
+ );
+}
+
+my @tests = (
+ {
+ order_by => \'foo DESC',
+ order_req => 'foo DESC',
+ order_inner => 'foo DESC',
+ order_outer => 'foo ASC'
+ },
+ {
+ order_by => { -asc => 'foo' },
+ order_req => 'foo ASC',
+ order_inner => 'foo ASC',
+ order_outer => 'foo DESC',
+ },
+ {
+ order_by => 'foo',
+ order_req => 'foo',
+ order_inner => 'foo ASC',
+ order_outer => 'foo DESC',
+ },
+ {
+ order_by => [ qw{ foo bar} ],
+ order_req => 'foo, bar',
+ order_inner => 'foo ASC, bar ASC',
+ order_outer => 'foo DESC, bar DESC',
+ },
+ {
+ order_by => { -desc => 'foo' },
+ order_req => 'foo DESC',
+ order_inner => 'foo DESC',
+ order_outer => 'foo ASC',
+ },
+ {
+ order_by => ['foo', { -desc => 'bar' } ],
+ order_req => 'foo, bar DESC',
+ order_inner => 'foo ASC, bar DESC',
+ order_outer => 'foo DESC, bar ASC',
+ },
+ {
+ order_by => { -asc => [qw{ foo bar }] },
+ order_req => 'foo ASC, bar ASC',
+ order_inner => 'foo ASC, bar ASC',
+ order_outer => 'foo DESC, bar DESC',
+ },
+ {
+ order_by => [
+ { -asc => 'foo' },
+ { -desc => [qw{bar}] },
+ { -asc => [qw{hello sensors}]},
+ ],
+ order_req => 'foo ASC, bar DESC, hello ASC, sensors ASC',
+ order_inner => 'foo ASC, bar DESC, hello ASC, sensors ASC',
+ order_outer => 'foo DESC, bar ASC, hello DESC, sensors DESC',
+ },
+);
+
+my @default_tests = ( undef, '', {}, [] );
+
+plan (tests => scalar @tests + scalar @default_tests + 1);
+
+test_order ($_) for @tests;
+default_test_order ($_) for @default_tests;
+
+
+is_same_sql_bind (
+ $rs->search ({}, { group_by => 'title', order_by => 'title' })->as_query,
+'(SELECT
+me.id, me.source, me.owner, me.title, me.price, owner.id, owner.name FROM
+ ( SELECT
+ id, source, owner, title, price FROM
+ ( SELECT
+ TOP 1 id, source, owner, title, price FROM
+ ( SELECT
+ TOP 4 me.id, me.source, me.owner, me.title, me.price FROM
+ books me JOIN
+ owners owner ON owner.id = me.owner
+ WHERE ( source = ? )
+ GROUP BY title
+ ORDER BY title ASC
+ ) me
+ ORDER BY title DESC
+ ) me
+ ORDER BY title
+ ) me JOIN
+ owners owner ON owner.id = me.owner WHERE
+ ( source = ? )
+ ORDER BY title)' ,
+ [ [ source => 'Library' ], [ source => 'Library' ] ],
+);
Copied: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/quotes/quotes.t (from rev 7836, DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/19quotes.t)
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/quotes/quotes.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/quotes/quotes.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,74 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib qw(t/lib);
+use DBIC::SqlMakerTest;
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@
+ ? ( skip_all => 'needs DBD::SQLite for testing' )
+ : ( tests => 7 );
+}
+
+
+use_ok('DBICTest');
+use_ok('DBIC::DebugObj');
+my $schema = DBICTest->init_schema();
+
+#diag('Testing against ' . join(' ', map { $schema->storage->dbh->get_info($_) } qw/17 18/));
+
+$schema->storage->sql_maker->quote_char('`');
+$schema->storage->sql_maker->name_sep('.');
+
+my ($sql, @bind);
+$schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind));
+$schema->storage->debug(1);
+
+my $rs;
+
+$rs = $schema->resultset('CD')->search(
+ { 'me.year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
+ { join => 'artist' });
+eval { $rs->count };
+is_same_sql_bind(
+ $sql, \@bind,
+ "SELECT COUNT( * ) FROM cd `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )", ["'Caterwauler McCrae'", "'2001'"],
+ 'got correct SQL for count query with quoting'
+);
+
+my $order = 'year DESC';
+$rs = $schema->resultset('CD')->search({},
+ { 'order_by' => $order });
+eval { $rs->first };
+like($sql, qr/ORDER BY `\Q${order}\E`/, 'quoted ORDER BY with DESC (should use a scalarref anyway)');
+
+$rs = $schema->resultset('CD')->search({},
+ { 'order_by' => \$order });
+eval { $rs->first };
+like($sql, qr/ORDER BY \Q${order}\E/, 'did not quote ORDER BY with scalarref');
+
+$schema->storage->sql_maker->quote_char([qw/[ ]/]);
+$schema->storage->sql_maker->name_sep('.');
+
+$rs = $schema->resultset('CD')->search(
+ { 'me.year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
+ { join => 'artist' });
+eval { $rs->count };
+is_same_sql_bind(
+ $sql, \@bind,
+ "SELECT COUNT( * ) FROM cd [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )", ["'Caterwauler McCrae'", "'2001'"],
+ 'got correct SQL for count query with bracket quoting'
+);
+
+my %data = (
+ name => 'Bill',
+ order => '12'
+);
+
+$schema->storage->sql_maker->quote_char('`');
+$schema->storage->sql_maker->name_sep('.');
+
+is($schema->storage->sql_maker->update('group', \%data), 'UPDATE `group` SET `name` = ?, `order` = ?', 'quoted table names for UPDATE');
Copied: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/quotes/quotes_newstyle.t (from rev 7836, DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/19quotes_newstyle.t)
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/quotes/quotes_newstyle.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/quotes/quotes_newstyle.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,91 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib qw(t/lib);
+use DBIC::SqlMakerTest;
+
+BEGIN {
+ eval "use DBD::SQLite";
+ plan $@
+ ? ( skip_all => 'needs DBD::SQLite for testing' )
+ : ( tests => 7 );
+}
+
+use_ok('DBICTest');
+use_ok('DBIC::DebugObj');
+
+my $schema = DBICTest->init_schema();
+
+#diag('Testing against ' . join(' ', map { $schema->storage->dbh->get_info($_) } qw/17 18/));
+
+my $dsn = $schema->storage->_dbi_connect_info->[0];
+$schema->connection(
+ $dsn,
+ undef,
+ undef,
+ { AutoCommit => 1 },
+ { quote_char => '`', name_sep => '.' },
+);
+
+my ($sql, @bind);
+$schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind)),
+$schema->storage->debug(1);
+
+my $rs;
+
+$rs = $schema->resultset('CD')->search(
+ { 'me.year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
+ { join => 'artist' });
+eval { $rs->count };
+is_same_sql_bind(
+ $sql, \@bind,
+ "SELECT COUNT( * ) FROM cd `me` JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` ) WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )", ["'Caterwauler McCrae'", "'2001'"],
+ 'got correct SQL for count query with quoting'
+);
+
+my $order = 'year DESC';
+$rs = $schema->resultset('CD')->search({},
+ { 'order_by' => $order });
+eval { $rs->first };
+like($sql, qr/ORDER BY `\Q${order}\E`/, 'quoted ORDER BY with DESC (should use a scalarref anyway)');
+
+$rs = $schema->resultset('CD')->search({},
+ { 'order_by' => \$order });
+eval { $rs->first };
+like($sql, qr/ORDER BY \Q${order}\E/, 'did not quote ORDER BY with scalarref');
+
+$schema->connection(
+ $dsn,
+ undef,
+ undef,
+ { AutoCommit => 1, quote_char => [qw/[ ]/], name_sep => '.' }
+);
+
+$schema->storage->debugobj(DBIC::DebugObj->new(\$sql, \@bind)),
+$schema->storage->debug(1);
+
+$rs = $schema->resultset('CD')->search(
+ { 'me.year' => 2001, 'artist.name' => 'Caterwauler McCrae' },
+ { join => 'artist' });
+eval { $rs->count };
+is_same_sql_bind(
+ $sql, \@bind,
+ "SELECT COUNT( * ) FROM cd [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )", ["'Caterwauler McCrae'", "'2001'"],
+ 'got correct SQL for count query with bracket quoting'
+);
+
+my %data = (
+ name => 'Bill',
+ order => '12'
+);
+
+$schema->connection(
+ $dsn,
+ undef,
+ undef,
+ { AutoCommit => 1, quote_char => '`', name_sep => '.' }
+);
+
+is($schema->storage->sql_maker->update('group', \%data), 'UPDATE `group` SET `name` = ?, `order` = ?', 'quoted table names for UPDATE');
Copied: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/sql_maker/sql_maker.t (from rev 7836, DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/95sql_maker.t)
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/sql_maker/sql_maker.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/sql_maker/sql_maker.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,78 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+
+use lib qw(t/lib);
+use DBIC::SqlMakerTest;
+
+use_ok('DBICTest');
+
+my $schema = DBICTest->init_schema(no_deploy => 1);
+
+my $sql_maker = $schema->storage->sql_maker;
+
+
+{
+ my ($sql, @bind) = $sql_maker->insert(
+ 'lottery',
+ {
+ 'day' => '2008-11-16',
+ 'numbers' => [13, 21, 34, 55, 89]
+ }
+ );
+
+ is_same_sql_bind(
+ $sql, \@bind,
+ q/INSERT INTO lottery (day, numbers) VALUES (?, ?)/,
+ [ ['day' => '2008-11-16'], ['numbers' => [13, 21, 34, 55, 89]] ],
+ 'sql_maker passes arrayrefs in insert'
+ );
+
+
+ ($sql, @bind) = $sql_maker->update(
+ 'lottery',
+ {
+ 'day' => '2008-11-16',
+ 'numbers' => [13, 21, 34, 55, 89]
+ }
+ );
+
+ is_same_sql_bind(
+ $sql, \@bind,
+ q/UPDATE lottery SET day = ?, numbers = ?/,
+ [ ['day' => '2008-11-16'], ['numbers' => [13, 21, 34, 55, 89]] ],
+ 'sql_maker passes arrayrefs in update'
+ );
+}
+
+# make sure the cookbook caveat of { $op, \'...' } no longer applies
+{
+ my ($sql, @bind) = $sql_maker->where({
+ last_attempt => \ '< now() - interval "12 hours"',
+ next_attempt => { '<', \ 'now() - interval "12 hours"' },
+ created => [
+ { '<=', \ '1969' },
+ \ '> 1984',
+ ],
+ });
+ is_same_sql_bind(
+ $sql,
+ \@bind,
+ 'WHERE
+ (created <= 1969 OR created > 1984 )
+ AND last_attempt < now() - interval "12 hours"
+ AND next_attempt < now() - interval "12 hours"
+ ',
+ [],
+ );
+}
+
+# Make sure the carp/croak override in SQLA works (via SQLAHacks)
+my $file = quotemeta (__FILE__);
+throws_ok (sub {
+ $schema->resultset ('Artist')->search ({}, { order_by => { -asc => 'stuff', -desc => 'staff' } } )->as_query;
+}, qr/$file/, 'Exception correctly croak()ed');
+
+done_testing;
Copied: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/sql_maker/sql_maker_quote.t (from rev 7836, DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/95sql_maker_quote.t)
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/sql_maker/sql_maker_quote.t (rev 0)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/sqlahacks/sql_maker/sql_maker_quote.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -0,0 +1,357 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use lib qw(t/lib);
+use DBIC::SqlMakerTest;
+
+use_ok('DBICTest');
+
+my $schema = DBICTest->init_schema();
+
+my $sql_maker = $schema->storage->sql_maker;
+
+$sql_maker->quote_char('`');
+$sql_maker->name_sep('.');
+
+my ($sql, @bind) = $sql_maker->select(
+ [
+ {
+ 'me' => 'cd'
+ },
+ [
+ {
+ 'artist' => 'artist',
+ '-join_type' => ''
+ },
+ {
+ 'artist.artistid' => 'me.artist'
+ }
+ ],
+ [
+ {
+ 'tracks' => 'tracks',
+ '-join_type' => 'left'
+ },
+ {
+ 'tracks.cd' => 'me.cdid'
+ }
+ ],
+ ],
+ [
+ 'me.cdid',
+ { count => 'tracks.cd' },
+ { min => 'me.year', -as => 'me.minyear' },
+ ],
+ {
+ 'artist.name' => 'Caterwauler McCrae',
+ 'me.year' => 2001
+ },
+ [],
+ undef,
+ undef
+);
+
+is_same_sql_bind(
+ $sql, \@bind,
+ q/
+ SELECT `me`.`cdid`, COUNT( `tracks`.`cd` ), MIN( `me`.`year` ) AS `me`.`minyear`
+ FROM `cd` `me`
+ JOIN `artist` `artist` ON ( `artist`.`artistid` = `me`.`artist` )
+ LEFT JOIN `tracks` `tracks` ON ( `tracks`.`cd` = `me`.`cdid` )
+ WHERE ( `artist`.`name` = ? AND `me`.`year` = ? )
+ /,
+ [ ['artist.name' => 'Caterwauler McCrae'], ['me.year' => 2001] ],
+ 'got correct SQL and bind parameters for complex select query with quoting'
+);
+
+
+($sql, @bind) = $sql_maker->select(
+ [
+ {
+ 'me' => 'cd'
+ }
+ ],
+ [
+ 'me.cdid',
+ 'me.artist',
+ 'me.title',
+ 'me.year'
+ ],
+ undef,
+ 'year DESC',
+ undef,
+ undef
+);
+
+is_same_sql_bind(
+ $sql, \@bind,
+ q/SELECT `me`.`cdid`, `me`.`artist`, `me`.`title`, `me`.`year` FROM `cd` `me` ORDER BY `year DESC`/, [],
+ 'scalar ORDER BY okay (single value)'
+);
+
+
+($sql, @bind) = $sql_maker->select(
+ [
+ {
+ 'me' => 'cd'
+ }
+ ],
+ [
+ 'me.cdid',
+ 'me.artist',
+ 'me.title',
+ 'me.year'
+ ],
+ undef,
+ [
+ 'year DESC',
+ 'title ASC'
+ ],
+ undef,
+ undef
+);
+
+is_same_sql_bind(
+ $sql, \@bind,
+ q/SELECT `me`.`cdid`, `me`.`artist`, `me`.`title`, `me`.`year` FROM `cd` `me` ORDER BY `year DESC`, `title ASC`/, [],
+ 'scalar ORDER BY okay (multiple values)'
+);
+
+{
+ ($sql, @bind) = $sql_maker->select(
+ [
+ {
+ 'me' => 'cd'
+ }
+ ],
+ [
+ 'me.cdid',
+ 'me.artist',
+ 'me.title',
+ 'me.year'
+ ],
+ undef,
+ { -desc => 'year' },
+ undef,
+ undef
+ );
+
+ is_same_sql_bind(
+ $sql, \@bind,
+ q/SELECT `me`.`cdid`, `me`.`artist`, `me`.`title`, `me`.`year` FROM `cd` `me` ORDER BY `year` DESC/, [],
+ 'hashref ORDER BY okay (single value)'
+ );
+
+
+ ($sql, @bind) = $sql_maker->select(
+ [
+ {
+ 'me' => 'cd'
+ }
+ ],
+ [
+ 'me.cdid',
+ 'me.artist',
+ 'me.title',
+ 'me.year'
+ ],
+ undef,
+ [
+ { -desc => 'year' },
+ { -asc => 'title' }
+ ],
+ undef,
+ undef
+ );
+
+ is_same_sql_bind(
+ $sql, \@bind,
+ q/SELECT `me`.`cdid`, `me`.`artist`, `me`.`title`, `me`.`year` FROM `cd` `me` ORDER BY `year` DESC, `title` ASC/, [],
+ 'hashref ORDER BY okay (multiple values)'
+ );
+
+}
+
+
+($sql, @bind) = $sql_maker->select(
+ [
+ {
+ 'me' => 'cd'
+ }
+ ],
+ [
+ 'me.cdid',
+ 'me.artist',
+ 'me.title',
+ 'me.year'
+ ],
+ undef,
+ \'year DESC',
+ undef,
+ undef
+);
+
+is_same_sql_bind(
+ $sql, \@bind,
+ q/SELECT `me`.`cdid`, `me`.`artist`, `me`.`title`, `me`.`year` FROM `cd` `me` ORDER BY year DESC/, [],
+ 'did not quote ORDER BY with scalarref (single value)'
+);
+
+
+($sql, @bind) = $sql_maker->select(
+ [
+ {
+ 'me' => 'cd'
+ }
+ ],
+ [
+ 'me.cdid',
+ 'me.artist',
+ 'me.title',
+ 'me.year'
+ ],
+ undef,
+ [
+ \'year DESC',
+ \'title ASC'
+ ],
+ undef,
+ undef
+);
+
+is_same_sql_bind(
+ $sql, \@bind,
+ q/SELECT `me`.`cdid`, `me`.`artist`, `me`.`title`, `me`.`year` FROM `cd` `me` ORDER BY year DESC, title ASC/, [],
+ 'did not quote ORDER BY with scalarref (multiple values)'
+);
+
+
+($sql, @bind) = $sql_maker->select(
+ [ { me => 'cd' } ],
+ [qw/ me.cdid me.artist me.title /],
+ { cdid => \['rlike ?', [cdid => 'X'] ] },
+ { group_by => 'title', having => \['count(me.artist) > ?', [ cnt => 2] ] },
+);
+
+is_same_sql_bind(
+ $sql, \@bind,
+ q/SELECT `me`.`cdid`, `me`.`artist`, `me`.`title` FROM `cd` `me` WHERE ( `cdid` rlike ? ) GROUP BY `title` HAVING count(me.artist) > ?/,
+ [ [ cdid => 'X'], ['cnt' => '2'] ],
+ 'Quoting works with where/having arrayrefsrefs',
+);
+
+
+($sql, @bind) = $sql_maker->select(
+ [ { me => 'cd' } ],
+ [qw/ me.cdid me.artist me.title /],
+ { cdid => \'rlike X' },
+ { group_by => 'title', having => \'count(me.artist) > 2' },
+);
+
+is_same_sql_bind(
+ $sql, \@bind,
+ q/SELECT `me`.`cdid`, `me`.`artist`, `me`.`title` FROM `cd` `me` WHERE ( `cdid` rlike X ) GROUP BY `title` HAVING count(me.artist) > 2/,
+ [],
+ 'Quoting works with where/having scalarrefs',
+);
+
+
+($sql, @bind) = $sql_maker->update(
+ 'group',
+ {
+ 'order' => '12',
+ 'name' => 'Bill'
+ }
+);
+
+is_same_sql_bind(
+ $sql, \@bind,
+ q/UPDATE `group` SET `name` = ?, `order` = ?/, [ ['name' => 'Bill'], ['order' => '12'] ],
+ 'quoted table names for UPDATE'
+);
+
+{
+ ($sql, @bind) = $sql_maker->select(
+ [
+ {
+ 'me' => 'cd'
+ }
+ ],
+ [
+ 'me.*'
+ ],
+ undef,
+ [],
+ undef,
+ undef
+ );
+
+ is_same_sql_bind(
+ $sql, \@bind,
+ q/SELECT `me`.* FROM `cd` `me`/, [],
+ 'select attr with me.* is right'
+ );
+}
+
+
+$sql_maker->quote_char([qw/[ ]/]);
+
+($sql, @bind) = $sql_maker->select(
+ [
+ {
+ 'me' => 'cd'
+ },
+ [
+ {
+ 'artist' => 'artist',
+ '-join_type' => ''
+ },
+ {
+ 'artist.artistid' => 'me.artist'
+ }
+ ]
+ ],
+ [
+ {
+ max => 'rank',
+ -as => 'max_rank',
+ },
+ 'rank',
+ {
+ 'count' => '*',
+ -as => 'cnt',
+ }
+ ],
+ {
+ 'artist.name' => 'Caterwauler McCrae',
+ 'me.year' => 2001
+ },
+ [],
+ undef,
+ undef
+);
+
+is_same_sql_bind(
+ $sql, \@bind,
+ q/SELECT MAX ( [rank] ) AS [max_rank], [rank], COUNT( * ) AS [cnt] FROM [cd] [me] JOIN [artist] [artist] ON ( [artist].[artistid] = [me].[artist] ) WHERE ( [artist].[name] = ? AND [me].[year] = ? )/, [ ['artist.name' => 'Caterwauler McCrae'], ['me.year' => 2001] ],
+ 'got correct SQL and bind parameters for count query with bracket quoting'
+);
+
+
+($sql, @bind) = $sql_maker->update(
+ 'group',
+ {
+ 'order' => '12',
+ 'name' => 'Bill'
+ }
+);
+
+is_same_sql_bind(
+ $sql, \@bind,
+ q/UPDATE [group] SET [name] = ?, [order] = ?/, [ ['name' => 'Bill'], ['order' => '12'] ],
+ 'bracket quoted table names for UPDATE'
+);
+
+done_testing;
Modified: DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/storage/debug.t
===================================================================
--- DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/storage/debug.t 2010-02-10 22:38:24 UTC (rev 8605)
+++ DBIx-Class/0.08/branches/handle_all_storage_methods_in_replicated/t/storage/debug.t 2010-02-10 22:41:54 UTC (rev 8606)
@@ -6,25 +6,19 @@
use DBICTest;
use DBIC::DebugObj;
use DBIC::SqlMakerTest;
+use Path::Class qw/file/;
my $schema = DBICTest->init_schema();
-plan tests => 7;
ok ( $schema->storage->debug(1), 'debug' );
-ok ( defined(
- $schema->storage->debugfh(
- IO::File->new('t/var/sql.log', 'w')
- )
- ),
- 'debugfh'
- );
+$schema->storage->debugfh(file('t/var/sql.log')->openw);
$schema->storage->debugfh->autoflush(1);
my $rs = $schema->resultset('CD')->search({});
$rs->count();
-my $log = new IO::File('t/var/sql.log', 'r') or die($!);
+my $log = file('t/var/sql.log')->openr;
my $line = <$log>;
$log->close();
ok($line =~ /^SELECT COUNT/, 'Log success');
@@ -33,7 +27,7 @@
$ENV{'DBIC_TRACE'} = '=t/var/foo.log';
$rs = $schema->resultset('CD')->search({});
$rs->count();
-$log = new IO::File('t/var/foo.log', 'r') or die($!);
+$log = file('t/var/foo.log')->openr;
$line = <$log>;
$log->close();
ok($line =~ /^SELECT COUNT/, 'Log success');
@@ -57,7 +51,7 @@
my @cds = $schema->resultset('CD')->search( { artist => 1, cdid => { -between => [ 1, 3 ] }, } );
is_same_sql_bind(
$sql, \@bind,
- "SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE ( artist = ? AND (cdid BETWEEN ? AND ?) ): '1', '1', '3'",
+ "SELECT me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track FROM cd me WHERE ( artist = ? AND (cdid BETWEEN ? AND ?) )",
[qw/'1' '1' '3'/],
'got correct SQL with all bind parameters (debugcb)'
);
@@ -70,4 +64,4 @@
);
}
-1;
+done_testing;
More information about the Bast-commits
mailing list